~alcinnz/amphiarao

ref: d4c10f895dce29c0eb5b6209fb228abc731e7b5a amphiarao/src/Internal/Load.hs -rw-r--r-- 988 bytes
d4c10f89 — Adrian Cochrane Allow loading webpage, commit missing files. 3 years ago
                                                                                
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
module Internal.Load(load, parseAbsoluteURI) where

import Internal

import Control.Concurrent.MVar
import System.Timeout (timeout)
import Control.Monad.IO.Class

import Data.Aeson
import Data.Text (Text, pack)
import GHC.Generics

import Data.Maybe (fromMaybe)

import Network.URI as URI
import Network.URI.Fetch as URI

mime = words "text/html text/xml application/xml application/xhtml+xml text/plain"

load :: Internal.Session -> URI -> IO ()
load session uri = modifyMVar_ session $ \session' -> maybeTimeout session' uri $ do
    (redirected, _, _) <- fetchURL' (loader session') mime uri
    return $ session' { currentURL = redirected}

maybeTimeout :: Session' -> URI -> IO Session' -> IO Session'
maybeTimeout session uri act | currentURL session /= uri, Just delay <- pageLoad $ timeouts session =
    -- WebDriver deals in terms of milliseconds, I think?, Haskell deals in terms of microseconds.
    fromMaybe session <$> timeout (delay * 1000) act
maybeTimeout _ _ act = act