{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module UI.Templates(page, inspector, sessionForm) where
import Happstack.Lite
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html
import Data.Text as Txt
import Internal
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.MVar
import Data.UUID as ID
import Messages
import Happstack.Server.I18N
page :: (Response -> ServerPart Response) -> [Text] -> ([Text] -> Html) -> ServerPart Response
page return' title body' = do
langs <- bestLanguage <$> acceptLanguage
return' $ toResponse $ html $ do
H.head $ do
H.title $ text $ intercalate " — " title
body $ body' langs
inspector :: (Response -> ServerPart Response) -> Text -> Session -> UUID -> ([Text] -> Html) -> ServerPart Response
inspector return' title session uuid body' = do
session' <- liftIO $ readMVar session
let uuid' = ID.toString uuid
let timeout = H.stringValue $ show $ pageLoad $ timeouts session'
page return' [title, pack $ show $ currentURL $ session', "Amphiarao"] $ \langs -> do
header $ do
H.form ! action' ["/", uuid', "/search"] $ do
input ! type_ "search" ! name "q" ! placeholder "Search..."
body' langs
footer $ do
H.form ! action' ["/close/", uuid'] ! A.method "POST" $ do
button ! type_ "submit" $ l langs CloseSession
hr
H.form ! action' ["/", uuid', "/timeout"] ! A.method "POST" $ p $ do
H.label $ do
l langs LoadTimeout
input ! type_ "number" ! name "pageLoad" ! value timeout
text "ms"
where
action' = A.action . H.stringValue . Prelude.concat
sessionForm langs = H.form ! A.method "POST" ! action "/" $ do
input ! type_ "url" ! name "target" ! placeholder "URL to debug"
button ! type_ "submit" $ l langs CreateSession