~alcinnz/rhapsode

ref: 2e03314fc8a2d6bdb9c828bc9f6170f225ec8986 rhapsode/src/Input.hs -rw-r--r-- 2.7 KiB
2e03314f — Adrian Cochrane Merge branch 'main' of git.adrian.geek.nz:/srv/git/rhapsode into main 2 years ago
                                                                                
c900dfa4 Adrian Cochrane
a3dc72fe Adrian Cochrane
945a755a Adrian Cochrane
65356894 Adrian Cochrane
c900dfa4 Adrian Cochrane
e41dd031 Adrian Cochrane
d6a13c9b Adrian Cochrane
c900dfa4 Adrian Cochrane
a3dc72fe Adrian Cochrane
c900dfa4 Adrian Cochrane
e41dd031 Adrian Cochrane
65356894 Adrian Cochrane
a3dc72fe Adrian Cochrane
c900dfa4 Adrian Cochrane
481a1088 Adrian Cochrane
b2147925 Adrian Cochrane
c900dfa4 Adrian Cochrane
075aa68d Adrian Cochrane
e41dd031 Adrian Cochrane
2e1b1a76 Adrian Cochrane
a3dc72fe Adrian Cochrane
b2147925 Adrian Cochrane
a3dc72fe Adrian Cochrane
06d8ec36 Adrian Cochrane
4777781c Adrian Cochrane
945a755a Adrian Cochrane
0a65b2c1 Adrian Cochrane
4777781c Adrian Cochrane
a3dc72fe Adrian Cochrane
989a5032 Adrian Cochrane
a3dc72fe Adrian Cochrane
4777781c Adrian Cochrane
65356894 Adrian Cochrane
4777781c Adrian Cochrane
65356894 Adrian Cochrane
075aa68d Adrian Cochrane
226826fe Adrian Cochrane
32909aaa Adrian Cochrane
226826fe Adrian Cochrane
32909aaa Adrian Cochrane
226826fe Adrian Cochrane
60f1ac45 Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
module Input(fetchDocument, readStrict) where

import           Data.Text.Lazy (fromStrict)
import qualified Data.Text as Txt
import qualified Data.Text.IO as Txt
import           Data.Text.Encoding
import qualified Data.Text.Lazy as LTxt
import qualified Data.ByteString.Lazy as B
import qualified Text.XML as XML
import           Network.URI
import           Network.URI.Fetch
import           Network.URI.Fetch.XML (fetchDocument)
import           Network.URI.Charset
import qualified Data.Map as M
import qualified Data.Set as Set
import           Data.List (intercalate)
import           Data.Time.Clock

-- For alternative styles
import qualified Data.CSS.Syntax.Tokens as CSSTok
import Data.CSS.Syntax.StyleSheet
import Data.CSS.Preprocessor.Conditions (conditionalStyles)

import System.IO
import System.IO.Temp
import System.Directory
import System.FilePath ((</>))
import Data.FileEmbed

-- For C API
import Types
import Data.Maybe (fromMaybe)
import Foreign.StablePtr
import Foreign.C.String

--------
---- C API
--------
foreign export ccall c_newSession :: IO (StablePtr Session)
foreign export ccall c_freeSession :: StablePtr Session -> IO ()

c_newSession = do
    sess <- newSession
    newStablePtr $ sess {aboutPages = map lazify $(embedDir $ buildDirFile "about")}
  where lazify (a, b) = (a, B.fromStrict b)
c_freeSession = freeStablePtr


foreign export ccall c_fetchURL :: StablePtr Session -> CString -> StablePtr (Page RhapsodeCSS) -> CString -> IO (StablePtr (Page RhapsodeCSS))

c_fetchURL c_session c_mimes c_referer c_uri = do
    session <- deRefStablePtr c_session
    mimes <- peekCString c_mimes
    referer <- deRefStablePtr c_referer
    uri <- peekCString c_uri
    let uri' = nullURI `fromMaybe` parseURIReference uri `relativeTo` pageURL referer
    doc <- fetchDocument session referer uri'
    newStablePtr doc

foreign export ccall c_enableLogging :: StablePtr Session -> IO (StablePtr Session)

c_enableLogging c_session = do
    ret <- deRefStablePtr c_session >>= enableLogging
    freeStablePtr c_session
    newStablePtr ret

foreign export ccall c_writeLog :: CString -> StablePtr Session -> IO ()

c_writeLog c_path c_session = do
    path <- peekCString c_path
    withFile path AppendMode (\logfile -> deRefStablePtr c_session >>= writeLog logfile)

foreign export ccall c_lastVisited :: CString -> IO CString
c_lastVisited def = do
    path <- (</> "history.gmni") <$> getXdgDirectory XdgData "rhapsode"
    exists <- doesFileExist path
    if not exists then return def else do
        file <- readFile path
        case map words $ lines file of
            (_:url:_):_ -> newCString url
            _ -> return def