{-# LANGUAGE OverloadedStrings #-}
module Types(CArray, Page(..), Application(..)) where
import System.Directory (getCurrentDirectory) -- default referer URI
import SpeechStyle (SpeechStyle)
import Data.CSS.Preprocessor.Conditions (ConditionalStyles, conditionalStyles)
import Data.CSS.Preprocessor.Text (TextStyle)
import Text.XML
import qualified Data.Map.Strict as M
import Network.URI
import Network.URI.Fetch (Application(..))
-- For the in-memory history log
import Data.Trie.Text (Trie)
import qualified Data.Text as Txt
import qualified Data.Trie.Text as Trie
import Control.Concurrent.MVar
import System.Directory
import System.FilePath ((</>))
import Control.Parallel (par)
import Foreign.Ptr
import Foreign.StablePtr
type CArray a = Ptr a
data Page = Page {
url :: URI,
css :: ConditionalStyles (TextStyle SpeechStyle),
html :: Document,
pageTitle :: String,
pageMIME :: String,
apps :: [Application],
backStack :: [(String, URI)],
forwardStack :: [(String, URI)],
-- Probably don't need an MVar here, but let's be safe!
visitedURLs :: MVar (Trie ())
}
foreign export ccall c_initialReferer :: IO (StablePtr Page)
loadVisited :: IO (MVar (Trie ()))
loadVisited = do
dir <- getXdgDirectory XdgData "rhapsode"
let path = dir </> "history.gmni"
exists <- doesFileExist path
if exists then do
file <- Prelude.readFile path
let hist = Trie.fromList [(Txt.pack uri, ()) | _:uri:_ <- map words $ lines file]
hist `par` newMVar hist
else newMVar Trie.empty
c_initialReferer = do
cwd <- getCurrentDirectory
hist <- loadVisited
newStablePtr $ Page {
-- Default to URIs being relative to CWD.
url = URI {uriScheme = "file:", uriPath = cwd,
uriAuthority = Nothing, uriQuery = "", uriFragment = ""},
-- Blank values:
css = conditionalStyles nullURI "temp",
html = Document {
documentPrologue = Prologue [] Nothing [],
documentRoot = Element "temp" M.empty [],
documentEpilogue = []
},
pageTitle = "", pageMIME = "", apps = [],
backStack = [], forwardStack = [], visitedURLs = hist
}
foreign export ccall c_freePage :: StablePtr Page -> IO ()
c_freePage = freeStablePtr