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)