{-# 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.Monad (unless) 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' -> ([Text] -> Html) -> ServerPart Response inspector return' title session' body' = do let timeout = H.stringValue $ show $ pageLoad $ timeouts session' page return' [title, pack $ show $ currentURL $ session', "Amphiarao"] $ \langs -> do header $ do unless (Prelude.null $ backStack session') $ postButton "/nav/back" (l' langs Back') "🡸" unless (Prelude.null $ nextStack session') $ postButton "/nav/next" (l' langs Next') "🡺" postButton "/nav/reload" (l' langs Reload') "↻" hr H.form ! action' ["/", uuid', "/search"] ! alt (l' langs Search') $ do input ! type_ "search" ! name "q" ! placeholder (l' langs Search') body' langs footer $ do H.form ! action' ["/close/", uuid'] ! A.method "POST" ! alt (l' langs CloseSession') $ do button ! type_ "submit" $ l langs CloseSession hr H.form ! action' ["/", uuid', "/timeout"] ! A.method "POST" ! alt (l' langs LoadTimeout') $ p $ do H.label $ do l langs LoadTimeout input ! type_ "number" ! name "pageLoad" ! value timeout text "ms" where uuid' = ID.toString $ uuid_ session' action' = A.action . H.stringValue . Prelude.concat postButton target title' label = H.form ! action' ["/", uuid', target] ! alt title' ! A.method "POST" $ do button ! type_ "submit" ! A.title title' $ label sessionForm langs = H.form ! A.method "POST" ! action "/" ! alt (l' langs CreateSession') $ do input ! type_ "url" ! name "target" ! placeholder "URL to debug" button ! type_ "submit" $ l langs CreateSession