{-# LANGUAGE OverloadedStrings #-}
module Text.HTML.Form.WebApp (renderPage, Form(..), Query) where
import Data.ByteString as BS
import Data.ByteString.Char8 as B8
import Data.Text as Txt
import Data.Text.Encoding as Txt
import Data.List as L
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Network.URI (unEscapeString)
import System.IO (readFile')
import System.FilePath ((</>), normalise)
import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist,
doesDirectoryExist, listDirectory, getHomeDirectory)
import Text.HTML.Form (Form(..), Input(..))
import Text.HTML.Form.WebApp.Ginger (template, template', resolveSource, list')
import Text.HTML.Form.Query (renderQueryString, renderQuery', applyQuery')
import Text.HTML.Form.Validate (isFormValid')
import Text.HTML.Form.WebApp.Ginger.Hourglass (timeData, modifyTime', timeParseOrNow,
gSeqTo, gPad2)
import Text.HTML.Form.WebApp.Ginger.TZ (tzdata, continents)
import Text.Ginger.GVal as V (GVal(..), ToGVal(..), orderedDict, (~>), fromFunction, list)
import Text.Ginger.Html (html)
import Data.Hourglass (Elapsed(..), Seconds(..), timeGetElapsed, localTimeToGlobal)
import Text.HTML.Form.Colours (tailwindColours)
type Query = [(ByteString, Maybe ByteString)]
renderPage :: Form -> [Text] -> Query -> IO (Maybe (Either Query Text))
renderPage :: Form -> [Text] -> Query -> IO (Maybe (Either Query Text))
renderPage Form
form (Text
n:[Text]
path) Query
query
| Just Int
ix <- [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> [Char] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Txt.unpack Text
n, Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Input] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length (Form -> [Input]
inputs Form
form) =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix (Form -> [Input]
inputs Form
form [Input] -> Int -> Input
forall a. HasCallStack => [a] -> Int -> a
!! Int
ix) [Text]
path Query
query
renderPage Form
form [] Query
_ = Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> IO (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> IO (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
$ [Text] -> Text
Txt.concat [
Text
"<a href='/0/?", [Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Form -> [Char]
renderQueryString Form
form, Text
"'>Start!</a>"]
renderPage Form
_ [Text]
_ Query
_ = Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Query Text)
forall a. Maybe a
Nothing
isCalType :: Text -> Bool
isCalType :: Text -> Bool
isCalType = (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
L.elem [Text
"date", Text
"datetime-local", Text
"datetime", Text
"month", Text
"time", Text
"week"]
renderInput :: Form -> Int -> Input -> [Text] -> [(ByteString, Maybe ByteString)] ->
IO (Maybe (Either Query Text))
renderInput :: Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
""] Query
qs = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
ty, inputName :: Input -> Text
inputName = Text
name } [Text
"year", Text
p] Query
qs
| Text -> Bool
isCalType Text
ty,
Just [Char]
t <- Text -> [Char] -> Maybe [Char]
modifyTime' ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"year/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Txt.unpack Text
p) ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get Text
name Query
qs = do
LocalTime DateTime
t' <- [Char] -> IO (LocalTime DateTime)
timeParseOrNow [Char]
t
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"cal/year-numpad.html" Form
form Int
ix Input
input (Text -> Text -> Query -> Query
set Text
name ([Char] -> Text
Txt.pack [Char]
t) Query
qs) ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
\Text
prop -> case Text
prop of
Text
"T" -> LocalTime DateTime -> GVal (Run SourcePos (Writer Html) Html)
forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
t'
Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
ty, inputName :: Input -> Text
inputName = Text
name } [Text
"zone", Text
p] Query
qs
| Text -> Bool
isCalType Text
ty = do
LocalTime DateTime
t <- [Char] -> IO (LocalTime DateTime)
timeParseOrNow ([Char] -> IO (LocalTime DateTime))
-> [Char] -> IO (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get Text
name Query
qs
let Elapsed (Seconds Int64
t') = DateTime -> Elapsed
forall t. Timeable t => t -> Elapsed
timeGetElapsed (DateTime -> Elapsed) -> DateTime -> Elapsed
forall a b. (a -> b) -> a -> b
$ LocalTime DateTime -> DateTime
forall t. Time t => LocalTime t -> t
localTimeToGlobal LocalTime DateTime
t
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"cal/timezone.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
prop -> case Text
prop of
Text
"T" -> LocalTime DateTime -> GVal (Run SourcePos (Writer Html) Html)
forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
t
Text
"zones" -> Int64 -> [Char] -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). Int64 -> [Char] -> GVal m
tzdata Int64
t' ([Char] -> GVal (Run SourcePos (Writer Html) Html))
-> [Char] -> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Txt.unpack Text
p
Text
"continents" -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). GVal m
continents
Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
form Int
ix input :: Input
input@Input { multiple :: Input -> Bool
multiple = Bool
True } [Text
p] Query
qs
| Char
'=':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p,
(Text -> ByteString
utf8 (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
$ [Char] -> ByteString
utf8' [Char]
v') (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
qs =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Query -> Query
unset (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString [Char]
v') Query
qs
| Char
'=':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
(Text -> ByteString
utf8 (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
$ [Char] -> ByteString
utf8' ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString [Char]
v')(ByteString, Maybe ByteString) -> Query -> Query
forall a. a -> [a] -> [a]
:Query
qs
renderInput Form
form Int
ix Input
input [Text
p] Query
qs
| Char
'=':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString [Char]
v') Query
qs
| Char
':':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input)
([Char] -> Text
Txt.pack (Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
v')) Query
qs
| [Char]
"-" <- Text -> [Char]
Txt.unpack Text
p, v' :: [Char]
v'@(Char
_:[Char]
_) <- Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input)
([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
Prelude.init [Char]
v') Query
qs
| [Char]
"-" <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] Query
qs
| Char
'+':[Char]
x' <- Text -> [Char]
Txt.unpack Text
p, Just Double
x <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x' :: Maybe Double,
Just Double
y <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Double) -> [Char] -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char]) -> Double -> [Char]
forall a b. (a -> b) -> a -> b
$ Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y) Query
qs
| Char
'+':[Char]
x' <- Text -> [Char]
Txt.unpack Text
p, Just Double
_ <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x' :: Maybe Double =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack [Char]
x') Query
qs
renderInput Form
form Int
ix Input
input [Text
x, Text
p] Query
qs
| Char
'=':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unEscapeString [Char]
v') Query
qs
| Char
':':[Char]
v' <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input)
([Char] -> Text
Txt.pack (Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
v')) Query
qs
| [Char]
"-" <- Text -> [Char]
Txt.unpack Text
p, v' :: [Char]
v'@(Char
_:[Char]
_) <- Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input)
([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
Prelude.init [Char]
v') Query
qs
| [Char]
"-" <- Text -> [Char]
Txt.unpack Text
p = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] Query
qs
| Char
'+':[Char]
z' <- Text -> [Char]
Txt.unpack Text
p, Just Double
z <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
z' :: Maybe Double,
Just Double
y <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Double) -> [Char] -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get (Input -> Text
inputName Input
input) Query
qs =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char]) -> Double -> [Char]
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y) Query
qs
| Char
'+':[Char]
x' <- Text -> [Char]
Txt.unpack Text
p, Just Double
_ <- [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
x' :: Maybe Double =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
x] (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) ([Char] -> Text
Txt.pack [Char]
x') Query
qs
renderInput Form
form Int
ix input :: Input
input@Input {inputType :: Input -> Text
inputType=Text
"checkbox", inputName :: Input -> Text
inputName=Text
k', value :: Input -> Text
value=Text
v'} [] Query
qs
| (Text -> ByteString
utf8 Text
k', ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
utf8 Text
v') (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
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"checkbox.html" Form
form Int
ix Input
input (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
unset Text
k' Text
v' Query
qs
| Text
v' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"", (Text -> ByteString
utf8 Text
k', Maybe ByteString
forall a. Maybe a
Nothing) (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
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"checkbox.html" Form
form Int
ix Input
input [
(ByteString, Maybe ByteString)
q | q :: (ByteString, Maybe ByteString)
q@(ByteString
k, Maybe ByteString
v) <- Query
qs, Bool -> Bool
not (ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> ByteString
utf8 Text
k' Bool -> Bool -> Bool
&& Maybe ByteString
v Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ByteString
forall a. Maybe a
Nothing)]
| Bool
otherwise =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"checkbox.html" Form
form Int
ix Input
input (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ (Text -> ByteString
utf8 Text
k', ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
utf8 Text
v')(ByteString, Maybe ByteString) -> Query -> Query
forall a. a -> [a] -> [a]
:Query
qs
renderInput Form
form Int
ix input :: Input
input@Input {inputType :: Input -> Text
inputType=Text
"radio", inputName :: Input -> Text
inputName=Text
k', value :: Input -> Text
value=Text
v'} [] Query
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"checkbox.html" Form
form Int
ix Input
input (Query -> IO (Maybe (Either Query Text)))
-> Query -> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set Text
k' Text
v' Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"<select>" } [] Query
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"select.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"submit" } [] Query
qs =
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"submit.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
Text
"isFormValid" -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Bool -> GVal (Run SourcePos (Writer Html) Html))
-> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ Input -> Bool
formValidate Input
input Bool -> Bool -> Bool
&&
Form -> Bool
isFormValid' (Form -> [([Char], [Char])] -> Form
applyQuery' Form
form ([([Char], [Char])] -> Form) -> [([Char], [Char])] -> Form
forall a b. (a -> b) -> a -> b
$ Query -> [([Char], [Char])]
strQuery Query
qs)
Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
_ Int
_ input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"submit" } [Text
"_"] Query
qs =
Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> IO (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> IO (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
$ Query -> Either Query Text
forall a b. a -> Either a b
Left (Query -> Either Query Text) -> Query -> Either Query Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) (Input -> Text
value Input
input) Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"image" } [] Query
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"image-button.html" Form
form Int
ix Input
input Query
qs
renderInput Form
_ Int
_ input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"image" } [Text
"_"] Query
qs =
Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> IO (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> IO (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
$ Query -> Either Query Text
forall a b. a -> Either a b
Left (Query -> Either Query Text) -> Query -> Either Query Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Query -> Query
set (Input -> Text
inputName Input
input) (Input -> Text
value Input
input) Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"reset" } [] Query
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"reset.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"reset" } [Text
"_"] Query
_ =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"reset.html" Form
form Int
ix Input
input
[([Char] -> ByteString
utf8' [Char]
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
utf8' [Char]
v) | ([Char]
k, [Char]
v) <- Form -> [([Char], [Char])]
renderQuery' Form
form]
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType=Text
"file" } [Text]
path Query
qs = do
[Char]
home <- IO [Char]
getHomeDirectory
let filepath :: [Char]
filepath = [Char] -> [Char]
normalise ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl [Char] -> [Char] -> [Char]
(</>) [Char]
home ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
L.map Text -> [Char]
Txt.unpack [Text]
path
[[Char]]
subfiles <- [Char] -> IO [[Char]]
listDirectory [Char]
filepath
([[Char]]
dirs, [[Char]]
files) <- ([Char] -> IO Bool) -> [[Char]] -> IO ([[Char]], [[Char]])
forall (f :: * -> *) a.
Monad f =>
(a -> f Bool) -> [a] -> f ([a], [a])
partitionM ([Char] -> [Char] -> IO Bool
doesDirectoryExist' [Char]
filepath) [[Char]]
subfiles
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"files.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
Text
"path" -> ([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
$([[Char]] -> GVal (Run SourcePos (Writer Html) Html))
-> [[[Char]]] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
L.map [[Char]] -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [[Char]] -> GVal m
buildBreadcrumb([[[Char]]] -> [GVal (Run SourcePos (Writer Html) Html)])
-> [[[Char]]] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> a -> b
$[[Char]] -> [[[Char]]]
forall a. [a] -> [[a]]
L.inits([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$(Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
L.map Text -> [Char]
Txt.unpack [Text]
path) {
asText = Txt.pack filepath,
asHtml = html $ Txt.pack filepath
}
Text
"files" -> [[Char]] -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal [[Char]]
files
Text
"dirs" -> [[Char]] -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal [[Char]]
dirs
Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
where
buildBreadcrumb :: [String] -> GVal m
buildBreadcrumb :: forall (m :: * -> *). [[Char]] -> GVal m
buildBreadcrumb [] = Bool -> GVal m
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
False
buildBreadcrumb [[Char]]
path' = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [
Text
"name" Text -> [Char] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
L.last [[Char]]
path',
Text
"link" Text -> [Char] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> (Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char]
"/" [[Char]]
path')
]
doesDirectoryExist' :: [Char] -> [Char] -> IO Bool
doesDirectoryExist' [Char]
parent [Char]
file = [Char] -> IO Bool
doesDirectoryExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
parent [Char] -> [Char] -> [Char]
</> [Char]
file
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"tel" } [] Query
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"tel.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"number" } [] Query
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"number.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"range" } [] Query
qs =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
"number.html" Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
ty, inputName :: Input -> Text
inputName = Text
n } [Text
op] Query
qs
| Text
"week" <- Text
ty, Text
"+date" <- Text
op = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
"+date7"] Query
qs
| Text
"week" <- Text
ty, Text
"-date" <- Text
op = Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
"-date7"] Query
qs
| Text -> Bool
isCalType Text
ty, Just [Char]
v <- Text -> [Char] -> Maybe [Char]
modifyTime' Text
op ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get Text
n Query
qs = do
LocalTime DateTime
v' <- [Char] -> IO (LocalTime DateTime)
timeParseOrNow [Char]
v
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"gregorian.html" Form
form Int
ix Input
input (Text -> Text -> Query -> Query
set Text
n ([Char] -> Text
Txt.pack [Char]
v) Query
qs) ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$
\Text
x -> case Text
x of
Text
"T" -> LocalTime DateTime -> GVal (Run SourcePos (Writer Html) Html)
forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
v'
Text
"seqTo" -> 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)
-> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
(GVal (Run SourcePos (Writer Html) Html))
forall a.
a
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
(GVal (Run SourcePos (Writer Html) Html)))
-> ([(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html)
forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gSeqTo
Text
"pad2" -> 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)
-> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
(GVal (Run SourcePos (Writer Html) Html))
forall a.
a
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
(GVal (Run SourcePos (Writer Html) Html)))
-> ([(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html)
forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gPad2
Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
| Text -> Bool
isCalType Text
ty = Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Query Text)
forall a. Maybe a
Nothing
renderInput Form
f Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
ty, inputName :: Input -> Text
inputName = Text
n } [] Query
qs | Text -> Bool
isCalType Text
ty = do
LocalTime DateTime
v' <- [Char] -> IO (LocalTime DateTime)
timeParseOrNow ([Char] -> IO (LocalTime DateTime))
-> [Char] -> IO (LocalTime DateTime)
forall a b. (a -> b) -> a -> b
$ Text -> Query -> [Char]
get Text
n Query
qs
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"gregorian.html" Form
f Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
Text
"T" -> LocalTime DateTime -> GVal (Run SourcePos (Writer Html) Html)
forall (a :: * -> *). LocalTime DateTime -> GVal a
timeData LocalTime DateTime
v'
Text
"seqTo" -> 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)
-> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
(GVal (Run SourcePos (Writer Html) Html))
forall a.
a
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
(GVal (Run SourcePos (Writer Html) Html)))
-> ([(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html)
forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gSeqTo
Text
"pad2" -> 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)
-> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
-> GVal (Run SourcePos (Writer Html) Html)
forall a b. (a -> b) -> a -> b
$ GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
(GVal (Run SourcePos (Writer Html) Html))
forall a.
a
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run SourcePos (Writer Html) Html)
-> ExceptT
(RuntimeError SourcePos)
(StateT
(RunState SourcePos (Writer Html) Html)
(ReaderT
(GingerContext SourcePos (Writer Html) Html) (Writer Html)))
(GVal (Run SourcePos (Writer Html) Html)))
-> ([(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html))
-> Function (Run SourcePos (Writer Html) Html)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Text, GVal (Run SourcePos (Writer Html) Html))]
-> GVal (Run SourcePos (Writer Html) Html)
forall a (m :: * -> *). [(a, GVal m)] -> GVal m
gPad2
Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"color" } [] Query
qs =
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"color.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
Text
"colours" -> [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [GVal m] -> GVal m
V.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
$ (([Char], [(Int, [Char])])
-> GVal (Run SourcePos (Writer Html) Html))
-> [([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
L.map ([Char], [(Int, [Char])])
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a1 b a2.
(ToGVal m a1, ToGVal m b, Eq a2, Num a2) =>
(a1, [(a2, b)]) -> GVal m
colourGVal ([([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)])
-> [([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], [(Int, [Char])])]
tailwindColours ([Char] -> [([Char], [(Int, [Char])])])
-> [Char] -> [([Char], [(Int, [Char])])]
forall a b. (a -> b) -> a -> b
$ Form -> [Char]
lang Form
form
Text
"shades" -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
False
Text
"subfolder" -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
False
Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
renderInput Form
form Int
ix input :: Input
input@Input { inputType :: Input -> Text
inputType = Text
"color" } [Text
c, Text
""] Query
qs =
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form
-> Int
-> Input
-> Query
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> m (Maybe (Either Query Text))
template' [Char]
"color.html" Form
form Int
ix Input
input Query
qs ((Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text)))
-> (Text -> GVal (Run SourcePos (Writer Html) Html))
-> IO (Maybe (Either Query Text))
forall a b. (a -> b) -> a -> b
$ \Text
x -> case Text
x of
Text
"colours" -> [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [GVal m] -> GVal m
V.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
$ (([Char], [(Int, [Char])])
-> GVal (Run SourcePos (Writer Html) Html))
-> [([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
L.map ([Char], [(Int, [Char])])
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a1 b a2.
(ToGVal m a1, ToGVal m b, Eq a2, Num a2) =>
(a1, [(a2, b)]) -> GVal m
colourGVal ([([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)])
-> [([Char], [(Int, [Char])])]
-> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> a -> b
$ [Char] -> [([Char], [(Int, [Char])])]
tailwindColours [Char]
l
Text
"shades" -> case Text -> [Char]
Txt.unpack Text
c [Char] -> [([Char], [(Int, [Char])])] -> Maybe [(Int, [Char])]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [Char] -> [([Char], [(Int, [Char])])]
tailwindColours [Char]
l of
Just [(Int, [Char])]
shades -> [GVal (Run SourcePos (Writer Html) Html)]
-> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *). [GVal m] -> GVal m
V.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, [Char]) -> GVal (Run SourcePos (Writer Html) Html))
-> [(Int, [Char])] -> [GVal (Run SourcePos (Writer Html) Html)]
forall a b. (a -> b) -> [a] -> [b]
L.map (Int, [Char]) -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a1 a2.
(ToGVal m a1, ToGVal m a2) =>
(a1, a2) -> GVal m
shadeGVal [(Int, [Char])]
shades
Maybe [(Int, [Char])]
Nothing -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
False
Text
"subfolder" -> Bool -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Bool
True
Text
_ -> () -> GVal (Run SourcePos (Writer Html) Html)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal ()
where l :: [Char]
l = Form -> [Char]
lang Form
form
renderInput Form
form Int
ix Input
input [Text
keyboard] Query
qs =
Form
-> Int
-> Input
-> [Text]
-> Query
-> IO (Maybe (Either Query Text))
renderInput Form
form Int
ix Input
input [Text
keyboard, Text
""] Query
qs
renderInput Form
form Int
ix Input
input [Text
keyboard, Text
""] Query
qs | Just (Just [Char]
_) <- [Char] -> Maybe (Maybe [Char])
resolveSource [Char]
path =
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
path Form
form Int
ix Input
input Query
qs
where path :: [Char]
path = [Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Txt.unpack Text
keyboard [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html"
renderInput Form
form Int
ix Input
input [Text
keyboard, Text
""] Query
qs = do
[Char]
configpath <- XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig [Char]
"bureaucromancy"
Bool
exists <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
configpath [Char] -> [Char] -> [Char]
</> [Char]
"keyboard"
[Char]
namespace <- if Bool
exists then [Char] -> IO [Char]
readFile' ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
configpath [Char] -> [Char] -> [Char]
</> [Char]
"keyboard"
else [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"latin1"
let path :: [Char]
path = [Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
namespace [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Txt.unpack Text
keyboard [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html"
let path2 :: [Char]
path2 = [Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
namespace [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html"
let keyboard' :: [Char]
keyboard'
| Just (Just [Char]
_) <- [Char] -> Maybe (Maybe [Char])
resolveSource [Char]
path = [Char]
path
| Just (Just [Char]
_) <- [Char] -> Maybe (Maybe [Char])
resolveSource [Char]
path2 = [Char]
path2
| Bool
otherwise = [Char]
"keyboards/latin1.html"
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template [Char]
keyboard' Form
form Int
ix Input
input Query
qs
renderInput Form
form Int
ix Input
input [] Query
qs = do
[Char]
path <- XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig [Char]
"bureaucromancy"
Bool
exists <- [Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char]
path [Char] -> [Char] -> [Char]
</> [Char]
"keyboard"
[Char]
keyboard <- if Bool
exists then [Char] -> IO [Char]
readFile' ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
path [Char] -> [Char] -> [Char]
</> [Char]
"keyboard"
else [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"latin1"
let keyboard' :: [Char]
keyboard'
| Just (Just [Char]
_) <- [Char] -> Maybe (Maybe [Char])
resolveSource ([Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
keyboard [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html")
= [Char]
keyboard
| Bool
otherwise = [Char]
"latin1"
[Char]
-> Form -> Int -> Input -> Query -> IO (Maybe (Either Query Text))
forall (m :: * -> *).
Monad m =>
[Char]
-> Form -> Int -> Input -> Query -> m (Maybe (Either Query Text))
template ([Char]
"keyboards/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
keyboard' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".html") Form
form Int
ix Input
input Query
qs
renderInput Form
_ Int
_ Input
input [Text]
_ Query
_ =
Maybe (Either Query Text) -> IO (Maybe (Either Query Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Query Text) -> IO (Maybe (Either Query Text)))
-> Maybe (Either Query Text) -> IO (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
$ [Text] -> Text
Txt.concat [Text
"Unknown input type: ", Input -> Text
inputType Input
input]
colourGVal :: (ToGVal m a1, ToGVal m b, Eq a2, Num a2) => (a1, [(a2, b)]) -> GVal m
colourGVal :: forall (m :: * -> *) a1 b a2.
(ToGVal m a1, ToGVal m b, Eq a2, Num a2) =>
(a1, [(a2, b)]) -> GVal m
colourGVal (a1
key, [(a2, b)]
hues) = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [Text
"label"Text -> a1 -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>a1
key, Text
"value"Text -> Maybe b -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>a2 -> [(a2, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a2
500 [(a2, b)]
hues]
shadeGVal :: (ToGVal m a1, ToGVal m a2) => (a1, a2) -> GVal m
shadeGVal :: forall (m :: * -> *) a1 a2.
(ToGVal m a1, ToGVal m a2) =>
(a1, a2) -> GVal m
shadeGVal (a1
key, a2
val) = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
orderedDict [Text
"label"Text -> a1 -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>a1
key, Text
"value"Text -> a2 -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~>a2
val]
utf8 :: Text -> ByteString
utf8 :: Text -> ByteString
utf8 = Text -> ByteString
Txt.encodeUtf8
utf8' :: String -> ByteString
utf8' :: [Char] -> ByteString
utf8' = Text -> ByteString
utf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Txt.pack
set :: Text -> Text -> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
set :: Text -> Text -> Query -> Query
set Text
"" Text
_ Query
qs = Query
qs
set Text
k' Text
v' Query
qs = (Text -> ByteString
utf8 Text
k', ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
utf8 Text
v')(ByteString, Maybe ByteString) -> Query -> Query
forall a. a -> [a] -> [a]
:[(ByteString, Maybe ByteString)
q | q :: (ByteString, Maybe ByteString)
q@(ByteString
k, Maybe ByteString
_) <- Query
qs, ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> ByteString
utf8 Text
k']
unset :: Text -> Text -> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
unset :: Text -> Text -> Query -> Query
unset Text
k' Text
v' Query
qs = [(ByteString, Maybe ByteString)
q | q :: (ByteString, Maybe ByteString)
q@(ByteString
k, Maybe ByteString
v) <- Query
qs, Bool -> Bool
not (ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> ByteString
utf8 Text
k' Bool -> Bool -> Bool
&& Maybe ByteString
v Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
utf8 Text
v'))]
get :: Text -> [(ByteString, Maybe ByteString)] -> String
get :: Text -> Query -> [Char]
get Text
k' Query
qs
| Just (Just ByteString
ret) <- Text -> ByteString
utf8 Text
k' ByteString -> Query -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` Query
qs =
Text -> [Char]
Txt.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Txt.decodeUtf8 ByteString
ret
| Bool
otherwise = [Char]
""
strQuery :: [(ByteString, Maybe ByteString)] -> [(String, String)]
strQuery :: Query -> [([Char], [Char])]
strQuery Query
qs = [(ByteString -> [Char]
B8.unpack ByteString
k, ByteString -> [Char]
B8.unpack (ByteString -> [Char]) -> ByteString -> [Char]
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]
partitionM :: Monad f => (a -> f Bool) -> [a] -> f ([a], [a])
partitionM :: forall (f :: * -> *) a.
Monad f =>
(a -> f Bool) -> [a] -> f ([a], [a])
partitionM a -> f Bool
_ [] = ([a], [a]) -> f ([a], [a])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
partitionM a -> f Bool
f (a
x:[a]
xs) = do
Bool
res <- a -> f Bool
f a
x
([a]
as,[a]
bs) <- (a -> f Bool) -> [a] -> f ([a], [a])
forall (f :: * -> *) a.
Monad f =>
(a -> f Bool) -> [a] -> f ([a], [a])
partitionM a -> f Bool
f [a]
xs
([a], [a]) -> f ([a], [a])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a
x | Bool
res][a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
as, [a
x | Bool -> Bool
not Bool
res][a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
bs)