module Internal.Load(load, load', back, next, 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
---
load :: Internal.Session -> URI -> IO ()
load session uri = do
modifyMVar_ session $ return . inner
load' session uri
where
inner session'@Session {backStack = backStack', currentURL = currentURL' } =
session' { backStack = currentURL' : backStack' }
back :: Internal.Session -> IO ()
back session = do
uri <- modifyMVar session $ return . inner
load' session uri
where
inner session'@Session { backStack = b:bs, currentURL = n, nextStack = ns } =
(session' { backStack = bs, nextStack = n:ns }, b)
next :: Internal.Session -> IO ()
next session = do
uri <- modifyMVar session $ return . inner
load' session uri
where
inner session'@Session { backStack = bs, currentURL = b, nextStack = n:ns } =
(session' { backStack = b:bs, nextStack = ns }, n)