{-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
module Text.HTML.Form.WebApp.Ginger(template, template', resolveSource, list') where
import Text.HTML.Form
import Text.HTML.Form.Query (renderQueryString')
import FileEmbedLzma
import Data.FileEmbed
import System.FilePath
import Text.Ginger.Parse (parseGingerFile, SourcePos)
import Text.Ginger.Run (runGinger, makeContextHtml, Run)
import Text.Ginger.GVal as V (GVal(..), toGVal, ToGVal, orderedDict, (~>),
fromFunction, Function)
import Text.Ginger.Html (Html, htmlSource, unsafeRawHtml)
import Control.Monad.Writer.Lazy (Writer)
import Data.Text as Txt
import Data.Text.Encoding as Txt
import Data.Text.Lazy as Txt (toStrict)
import Data.ByteString.Char8 as B8
import Network.URI (uriToString, escapeURIString, isUnescapedInURIComponent, nullURI)
import Text.XML (Document(..), Element(..), Prologue(..), Node, def, renderText)
import Data.List (nub)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Map as M
import Text.HTML.Form.Validate (inputErrorMessage')
import Text.HTML.Form.Query (applyQuery)
import Text.HTML.Form.I18n (stringsJSON)
type Query = [(ByteString, Maybe ByteString)]
template :: Monad m => String -> Form -> Int -> Input -> Query ->
m (Maybe (Either Query Text))
template :: forall (m :: * -> *).
Monad m =>
FilePath
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template FilePath
name Form
form Int
ix Input
input Query
query =
FilePath
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
FilePath
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' FilePath
name Form
form Int
ix Input
input Query
query ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> Text -> GVal (Run SourcePos (Writer Html) Html)
forall a b. a -> b -> a
const (GVal (Run SourcePos (Writer Html) Html)
-> Text -> GVal (Run SourcePos (Writer Html) Html))
-> GVal (Run SourcePos (Writer Html) Html)
-> Text
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
template' :: Monad m => String -> Form -> Int -> Input -> Query ->
(Text -> GVal (Run SourcePos (Writer Html) Html)) ->
m (Maybe (Either Query Text))
template' :: forall (m :: * -> *).
Monad m =>
FilePath
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' FilePath
name Form
form Int
ix Input
input Query
query Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt'
| Just (Right Template SourcePos
tpl) <- IncludeResolver Maybe
-> FilePath -> Maybe (Either ParserError (Template SourcePos))
forall (m :: * -> *).
Monad m =>
IncludeResolver m
-> FilePath -> m (Either ParserError (Template SourcePos))
parseGingerFile IncludeResolver Maybe
resolveSource FilePath
name =
Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> m (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Either Query Text -> Maybe (Either Query Text)
forall a. a -> Maybe a
Just (Either Query Text -> Maybe (Either Query Text))
-> Either Query Text -> Maybe (Either Query Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either Query Text
forall a b. b -> Either a b
Right (Text -> Either Query Text) -> Text -> Either Query Text
forall a b. (a -> b) -> a -> b
$ Html -> Text
htmlSource (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$
(GingerContext SourcePos (Writer Html) Html
-> Template SourcePos -> Html)
-> Template SourcePos
-> GingerContext SourcePos (Writer Html) Html
-> Html
forall a b c. (a -> b -> c) -> b -> a -> c
flip GingerContext SourcePos (Writer Html) Html
-> Template SourcePos -> Html
forall p h.
(ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p,
Monoid h) =>
GingerContext p (Writer h) h -> Template p -> h
runGinger Template SourcePos
tpl (GingerContext SourcePos (Writer Html) Html -> Html)
-> GingerContext SourcePos (Writer Html) Html -> Html
forall a b. (a -> b) -> a -> b
$ (Text -> GVal (Run SourcePos (Writer Html) Html))
-> GingerContext SourcePos (Writer Html) Html
forall p.
(Text -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
makeContextHtml Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt
| Just (Left ParserError
err) <- IncludeResolver Maybe
-> FilePath -> Maybe (Either ParserError (Template SourcePos))
forall (m :: * -> *).
Monad m =>
IncludeResolver m
-> FilePath -> m (Either ParserError (Template SourcePos))
parseGingerFile IncludeResolver Maybe
resolveSource FilePath
name =
Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> m (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Either Query Text -> Maybe (Either Query Text)
forall a. a -> Maybe a
Just (Either Query Text -> Maybe (Either Query Text))
-> Either Query Text -> Maybe (Either Query Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either Query Text
forall a b. b -> Either a b
Right (Text -> Either Query Text) -> Text -> Either Query Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParserError -> FilePath
forall a. Show a => a -> FilePath
show ParserError
err
| Bool
otherwise = Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> m (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> m (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Either Query Text -> Maybe (Either Query Text)
forall a. a -> Maybe a
Just (Either Query Text -> Maybe (Either Query Text))
-> Either Query Text -> Maybe (Either Query Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either Query Text
forall a b. b -> Either a b
Right Text
"Unexpected error!"
where
ctxt :: Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt :: Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt Text
"Q" = Query -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). Monad m => Query -> GVal m
query2gval Query
query
ctxt Text
"form" = Form -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). Form -> GVal m
form2gval Form
form
ctxt Text
"inputs" = [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [GVal m] -> GVal m
list' ([GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html))
-> [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ ((Int, Input) -> GVal (Run SourcePos (Writer Html) Html))
-> [(Int, Input)] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\(Int, Input)
x -> FilePath
-> (Int, Input) -> Query -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). FilePath -> (Int, Input) -> Query -> GVal m
input2gval FilePath
language (Int, Input)
x Query
query) ([(Int, Input)] -> [GVal (Run SourcePos (Writer Html) Html)])
-> [(Int, Input)] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> a -> b
$
[Int] -> [Input] -> [(Int, Input)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Int
0..] ([Input] -> [(Int, Input)]) -> [Input] -> [(Int, Input)]
forall a b. (a -> b) -> a -> b
$ Form -> [Input]
inputs Form
form
ctxt Text
"input" = FilePath
-> (Int, Input) -> Query -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). FilePath -> (Int, Input) -> Query -> GVal m
input2gval FilePath
language (Int
ix, Input
input) Query
query
ctxt Text
"xURI" = Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). Function m -> GVal m
fromFunction Function (Run SourcePos (Writer Html) Html)
forall {m :: * -> *} {a} {m :: * -> *} {m :: * -> *}.
Monad m =>
[(a, GVal m)] -> m (GVal m)
xURI
ctxt Text
"_" = Value -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Value -> GVal (Run SourcePos (Writer Html) Html))
-> Value -> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ FilePath -> Value
stringsJSON FilePath
language
ctxt Text
x = Text -> GVal (Run SourcePos (Writer Html) Html)
ctxt' Text
x
xURI :: [(a, GVal m)] -> m (GVal m)
xURI [(a
_, GVal m
uri)] = let uri' :: FilePath
uri' = Text -> FilePath
Txt.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ GVal m -> Text
forall (m :: * -> *). GVal m -> Text
asText GVal m
uri in
GVal m -> m (GVal m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return(GVal m -> m (GVal m)) -> GVal m -> m (GVal m)
forall a b. (a -> b) -> a -> b
$Text -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal(Text -> GVal m) -> Text -> GVal m
forall a b. (a -> b) -> a -> b
$FilePath -> Text
Txt.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
escapeURIString Char -> Bool
isUnescapedInURIComponent FilePath
uri'
xURI [(a, GVal m)]
_ = GVal m -> m (GVal m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal m -> m (GVal m)) -> GVal m -> m (GVal m)
forall a b. (a -> b) -> a -> b
$ () -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
language :: FilePath
language = Form -> FilePath
lang Form
form
resolveSource :: FilePath -> Maybe (Maybe [Char])
resolveSource :: IncludeResolver Maybe
resolveSource (Char
'/':FilePath
path) = IncludeResolver Maybe
resolveSource FilePath
path
resolveSource FilePath
path = Maybe FilePath -> Maybe (Maybe FilePath)
forall a. a -> Maybe a
Just (Maybe FilePath -> Maybe (Maybe FilePath))
-> Maybe FilePath -> Maybe (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (ByteString -> FilePath) -> Maybe ByteString -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FilePath
utf8 (Maybe ByteString -> Maybe FilePath)
-> Maybe ByteString -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$
(FilePath -> [(FilePath, ByteString)] -> Maybe ByteString)
-> [(FilePath, ByteString)] -> FilePath -> Maybe ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [(FilePath, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup $(makeRelativeToProject "tpl" >>= embedRecursiveDir) (FilePath -> Maybe ByteString) -> FilePath -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath
normalise (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Char
'/'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
path
query2gval :: Monad m => Query -> GVal m
query2gval :: forall (m :: * -> *). Monad m => Query -> GVal m
query2gval Query
qs =
([Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [(ByteString -> Text
Txt.decodeUtf8 ByteString
k, ([ByteString] -> GVal m
forall (m :: * -> *) a. ToGVal m a => [a] -> GVal m
list1 [ByteString]
vs){ asFunction = Just $ gElem vs })
| (ByteString
k, [ByteString]
vs) <- Query -> [(ByteString, [ByteString])]
forall k v. Eq k => [(k, Maybe v)] -> [(k, [v])]
groupSort Query
qs]) {
asText = Txt.pack q,
asHtml = unsafeRawHtml $ Txt.pack q
}
where
q :: FilePath
q = Char
'?'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:[(FilePath, FilePath)] -> FilePath
renderQueryString' [(ByteString -> FilePath
utf8 ByteString
k, ByteString -> FilePath
utf8 (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
v) | (ByteString
k, Maybe ByteString
v) <- Query
qs]
gElem :: Monad m => [ByteString] -> Function m
gElem :: forall (m :: * -> *). Monad m => [ByteString] -> Function m
gElem [ByteString]
xs [(Maybe Text
_, GVal m
x)] | Just ByteString
x' <- GVal m -> Maybe ByteString
forall (m :: * -> *). GVal m -> Maybe ByteString
asBytes GVal m
x = GVal m -> m (GVal m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return(GVal m -> m (GVal m)) -> GVal m -> m (GVal m)
forall a b. (a -> b) -> a -> b
$Bool -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal(Bool -> GVal m) -> Bool -> GVal m
forall a b. (a -> b) -> a -> b
$ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Prelude.elem ByteString
x' [ByteString]
xs
gElem [ByteString]
_ [(Maybe Text, GVal m)]
_ = GVal m -> m (GVal m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal m -> m (GVal m)) -> GVal m -> m (GVal m)
forall a b. (a -> b) -> a -> b
$ () -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
form2gval :: Form -> GVal m
form2gval :: forall (m :: * -> *). Form -> GVal m
form2gval Form
form = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
Text
"action" Text -> FilePath -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id (Form -> URI
action Form
form) FilePath
"",
Text
"enctype" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
enctype Form
form,
Text
"method" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
method Form
form,
Text
"validate" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Bool
validate Form
form,
Text
"target" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
target Form
form,
Text
"charset" Text -> [Text] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> [Text]
acceptCharset Form
form,
Text
"autocomplete"Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>Form -> Bool
autocomplete Form
form,
Text
"name" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
formName Form
form,
Text
"rel" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Form -> Text
rel Form
form
]
input2gval :: String -> (Int, Input) -> Query -> GVal m
input2gval :: forall (m :: * -> *). FilePath -> (Int, Input) -> Query -> GVal m
input2gval FilePath
language (Int
ix, Input
input) Query
query = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
Text
"index" Text -> Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Int
ix,
Text
"label" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
label Input
input,
Text
"error" Text -> FilePath -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> FilePath -> Input -> FilePath
inputErrorMessage' FilePath
language (Input -> [(FilePath, FilePath)] -> Input
applyQuery Input
input
[(ByteString -> FilePath
B8.unpack ByteString
k, ByteString -> FilePath
B8.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
v) | (ByteString
k, Maybe ByteString
v) <- Query
query]),
Text
"description" Text -> Html -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Node -> Html
html (Input -> Node
description Input
input),
Text
"inputType" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
inputType Input
input,
Text
"dirName" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
dirname Input
input,
Text
"name" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
inputName Input
input,
Text
"value" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> if Input -> Text
inputType Input
input Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Text
"radio", Text
"checkbox"]
then Input -> Text
value Input
input
else Text -> [Text] -> Text
Txt.intercalate Text
", " [ByteString -> Text
Txt.decodeUtf8 ByteString
v | (ByteString
k, Just ByteString
v) <- Query
query,
Text -> ByteString
Txt.encodeUtf8 (Input -> Text
inputName Input
input) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
k],
Text
"autocomplete"Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
inputAutocomplete Input
input,
Text
"autofocus" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
autofocus Input
input,
Text
"checked" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Input -> Text
inputType Input
input Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Text
"radio", Text
"checkbox"] Bool -> Bool -> Bool
&&
if Input -> Text
value Input
inputText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
then Maybe (Maybe ByteString) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Maybe ByteString) -> Bool)
-> Maybe (Maybe ByteString) -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Query -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup (Text -> ByteString
Txt.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Input -> Text
inputName Input
input) Query
query
else (Text -> ByteString
Txt.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Input -> Text
inputName Input
input,
ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Txt.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Input -> Text
value Input
input) (ByteString, Maybe ByteString) -> Query -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` Query
query),
Text
"disabled" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
disabled Input
input,
Text
"readonly" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
readonly Input
input,
Text
"multiple" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
multiple Input
input,
(Text
"form", [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
Text
"action" Text -> Maybe FilePath -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> ((URI -> FilePath -> FilePath) -> FilePath -> URI -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id) FilePath
"" (URI -> FilePath) -> Maybe URI -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Input -> Maybe URI
formAction Input
input),
Text
"enctype" Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Text
formEnctype Input
input,
Text
"method" Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Text
formMethod Input
input,
Text
"validate"Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
formValidate Input
input,
Text
"target" Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Text
formTarget Input
input
]),
Text
"inputmode" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
inputMode Input
input,
(Text
"list", [GVal m] -> GVal m
forall (m :: * -> *). [GVal m] -> GVal m
list' ([GVal m] -> GVal m) -> [GVal m] -> GVal m
forall a b. (a -> b) -> a -> b
$ (OptionGroup -> GVal m) -> [OptionGroup] -> [GVal m]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ([ByteString] -> OptionGroup -> GVal m
forall (m :: * -> *). [ByteString] -> OptionGroup -> GVal m
optgroup2gval [ByteString
v |
(ByteString
k, Just ByteString
v) <- Query
query, ByteString -> Text
Txt.decodeUtf8 ByteString
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Input -> Text
inputName Input
input])
([OptionGroup] -> [GVal m]) -> [OptionGroup] -> [GVal m]
forall a b. (a -> b) -> a -> b
$ Input -> [OptionGroup]
list Input
input),
Text
"min" Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Text, Maybe Text) -> Maybe Text
forall a b. (a, b) -> a
fst (Input -> (Maybe Text, Maybe Text)
range Input
input),
Text
"max" Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Text, Maybe Text) -> Maybe Text
forall a b. (a, b) -> b
snd (Input -> (Maybe Text, Maybe Text)
range Input
input),
Text
"step" Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Text
step Input
input,
Text
"minlength" Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> a
fst (Input -> (Maybe Int, Maybe Int)
lengthRange Input
input),
Text
"maxLength" Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (Input -> (Maybe Int, Maybe Int)
lengthRange Input
input),
Text
"required" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Bool
required Input
input,
Text
"placeholder" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
placeholder Input
input,
Text
"title" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Text
title Input
input,
Text
"size" Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Int
size Input
input,
Text
"accept" Text -> [Text] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> FileSelector -> [Text]
fileAccept (Input -> FileSelector
fileData Input
input),
Text
"capture" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> FileSelector -> Text
fileCapture (Input -> FileSelector
fileData Input
input),
Text
"alt" Text -> Maybe Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> ImageData -> Maybe Text
imgAlt (Input -> ImageData
imageData Input
input),
Text
"width" Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> a
fst (ImageData -> (Maybe Int, Maybe Int)
imgSize (ImageData -> (Maybe Int, Maybe Int))
-> ImageData -> (Maybe Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Input -> ImageData
imageData Input
input),
Text
"height" Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Maybe Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd (ImageData -> (Maybe Int, Maybe Int)
imgSize (ImageData -> (Maybe Int, Maybe Int))
-> ImageData -> (Maybe Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Input -> ImageData
imageData Input
input),
Text
"src" Text -> FilePath -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id (URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe URI
nullURI (Maybe URI -> URI) -> Maybe URI -> URI
forall a b. (a -> b) -> a -> b
$ ImageData -> Maybe URI
imgSrc (ImageData -> Maybe URI) -> ImageData -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Input -> ImageData
imageData Input
input) FilePath
"",
Text
"autocorrect" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> TextArea -> Bool
autocorrect (Input -> TextArea
textArea Input
input),
Text
"cols" Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Input -> Maybe Int
size Input
input,
Text
"rows" Text -> Maybe Int -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> TextArea -> Maybe Int
rows (Input -> TextArea
textArea Input
input),
Text
"spellcheck" Text -> Maybe Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> TextArea -> Maybe Bool
spellcheck (Input -> TextArea
textArea Input
input),
Text
"textwrap" Text -> Maybe Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> TextArea -> Maybe Bool
textwrap (Input -> TextArea
textArea Input
input)
]
html :: Node -> Html
html :: Node -> Html
html Node
node = Text -> Html
unsafeRawHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Text
Txt.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> Text
renderText RenderSettings
forall a. Default a => a
def (
Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) (Name -> Map Name Text -> [Node] -> Element
Element Name
"div" Map Name Text
forall k a. Map k a
M.empty [Node
node]) []
)
optgroup2gval :: [ByteString] -> OptionGroup -> GVal m
optgroup2gval :: forall (m :: * -> *). [ByteString] -> OptionGroup -> GVal m
optgroup2gval [ByteString]
query OptionGroup
optgroup = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
Text
"label" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> OptionGroup -> Text
optsLabel OptionGroup
optgroup,
Text
"disabled" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> OptionGroup -> Bool
optsDisabled OptionGroup
optgroup,
(Text
"opts", [GVal m] -> GVal m
forall (m :: * -> *). [GVal m] -> GVal m
list' ([GVal m] -> GVal m) -> [GVal m] -> GVal m
forall a b. (a -> b) -> a -> b
$ (Option -> GVal m) -> [Option] -> [GVal m]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ([ByteString] -> Option -> GVal m
forall (m :: * -> *). [ByteString] -> Option -> GVal m
opt2gval [ByteString]
query) ([Option] -> [GVal m]) -> [Option] -> [GVal m]
forall a b. (a -> b) -> a -> b
$ OptionGroup -> [Option]
subopts OptionGroup
optgroup)
]
opt2gval :: [ByteString] -> Option -> GVal m
opt2gval :: forall (m :: * -> *). [ByteString] -> Option -> GVal m
opt2gval [ByteString]
query Option
opt = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
Text
"label" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Option -> Text
optLabel Option
opt,
Text
"value" Text -> Text -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Option -> Text
optValue Option
opt,
Text
"selected" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Option -> Text
optValue Option
opt Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ByteString -> Text
Txt.decodeUtf8 [ByteString]
query),
Text
"disabled" Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Option -> Bool
optDisabled Option
opt
]
list1 :: ToGVal m a => [a] -> GVal m
list1 :: forall (m :: * -> *) a. ToGVal m a => [a] -> GVal m
list1 vs :: [a]
vs@(a
v:[a]
_) = (a -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal a
v) {
asList = Just $ Prelude.map toGVal vs,
V.length = Just $ Prelude.length vs
}
list1 [] = (Bool -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
True) { asList = Just [], V.length = Just 0 }
list' :: [GVal m] -> GVal m
list' :: forall (m :: * -> *). [GVal m] -> GVal m
list' = [GVal m] -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal
groupSort :: Eq k => [(k, Maybe v)] -> [(k, [v])]
groupSort :: forall k v. Eq k => [(k, Maybe v)] -> [(k, [v])]
groupSort [(k, Maybe v)]
q = [(k
k, [v
v | (k
k', Just v
v) <- [(k, Maybe v)]
q, k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k']) | k
k <- [k] -> [k]
forall a. Eq a => [a] -> [a]
nub ([k] -> [k]) -> [k] -> [k]
forall a b. (a -> b) -> a -> b
$ ((k, Maybe v) -> k) -> [(k, Maybe v)] -> [k]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (k, Maybe v) -> k
forall a b. (a, b) -> a
fst [(k, Maybe v)]
q]
utf8 :: ByteString -> String
utf8 :: ByteString -> FilePath
utf8 = Text -> FilePath
Txt.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Txt.decodeUtf8