{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Import
( module Import
) where
import Foundation as Import
import Import.NoFoundation as Import
import qualified Data.ByteString.Char8 as B8
import qualified Data.Aeson as A
type MonadHandlerForm m = (RenderMessage App FormMessage, HandlerSite m ~ App, MonadHandler m)
type Form f = Html -> MForm Handler (FormResult f, Widget)
runInputPostJSONResult
:: (FromJSON a, MonadHandlerForm m)
=> FormInput m a -> m (FormResult a)
runInputPostJSONResult :: forall a (m :: * -> *).
(FromJSON a, MonadHandlerForm m) =>
FormInput m a -> m (FormResult a)
runInputPostJSONResult FormInput m a
form = do
Maybe ByteString
mct <- CI ByteString -> m (Maybe ByteString)
forall (m :: * -> *).
MonadHandler m =>
CI ByteString -> m (Maybe ByteString)
lookupHeader CI ByteString
"content-type"
case (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> ByteString -> ByteString
B8.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';')) Maybe ByteString
mct of
Just ByteString
"application/json" ->
m (Result a)
forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseCheckJsonBody m (Result a) -> (Result a -> m (FormResult a)) -> m (FormResult a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
A.Success a
a -> FormResult a -> m (FormResult a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormResult a -> m (FormResult a))
-> FormResult a -> m (FormResult a)
forall a b. (a -> b) -> a -> b
$ a -> FormResult a
forall a. a -> FormResult a
FormSuccess a
a
A.Error String
e -> FormResult a -> m (FormResult a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormResult a -> m (FormResult a))
-> FormResult a -> m (FormResult a)
forall a b. (a -> b) -> a -> b
$ [Text] -> FormResult a
forall a. [Text] -> FormResult a
FormFailure [[Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack String
[Element Text]
e]
Just ByteString
"application/x-www-form-urlencoded" ->
FormInput m a -> m (FormResult a)
forall (m :: * -> *) a.
MonadHandler m =>
FormInput m a -> m (FormResult a)
runInputPostResult FormInput m a
form
Maybe ByteString
_ -> FormResult a -> m (FormResult a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormResult a
forall a. FormResult a
FormMissing
runInputPostJSON
:: (FromJSON a, MonadHandlerForm m)
=> FormInput m a -> m a
runInputPostJSON :: forall a (m :: * -> *).
(FromJSON a, MonadHandlerForm m) =>
FormInput m a -> m a
runInputPostJSON FormInput m a
form =
FormInput m a -> m (FormResult a)
forall a (m :: * -> *).
(FromJSON a, MonadHandlerForm m) =>
FormInput m a -> m (FormResult a)
runInputPostJSONResult FormInput m a
form m (FormResult a) -> (FormResult a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\case
FormSuccess a
a -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
FormFailure [Text]
e -> [Text] -> m a
forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
invalidArgs [Text]
e
FormResult a
FormMissing -> [Text] -> m a
forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
invalidArgs []
class MkIForm a where
mkIForm :: MonadHandlerForm m => FormInput m a
aFormToMaybeGetSuccess
:: MonadHandler f
=> AForm f a -> f (Maybe a)
aFormToMaybeGetSuccess :: forall (f :: * -> *) a. MonadHandler f => AForm f a -> f (Maybe a)
aFormToMaybeGetSuccess =
((FormResult a, Enctype) -> Maybe a)
-> f (FormResult a, Enctype) -> f (Maybe a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FormResult a -> Maybe a
forall a. FormResult a -> Maybe a
maybeSuccess (FormResult a -> Maybe a)
-> ((FormResult a, Enctype) -> FormResult a)
-> (FormResult a, Enctype)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FormResult a, Enctype) -> FormResult a
forall a b. (a, b) -> a
fst) (f (FormResult a, Enctype) -> f (Maybe a))
-> (AForm f a -> f (FormResult a, Enctype))
-> AForm f a
-> f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Markup -> MForm f (FormResult a)) -> f (FormResult a, Enctype)
forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> m (a, Enctype)
runFormGet ((Markup -> MForm f (FormResult a)) -> f (FormResult a, Enctype))
-> (AForm f a -> Markup -> MForm f (FormResult a))
-> AForm f a
-> f (FormResult a, Enctype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MForm f (FormResult a) -> Markup -> MForm f (FormResult a)
forall a b. a -> b -> a
const (MForm f (FormResult a) -> Markup -> MForm f (FormResult a))
-> (AForm f a -> MForm f (FormResult a))
-> AForm f a
-> Markup
-> MForm f (FormResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
-> FormResult a)
-> RWST
(Maybe (Env, FileEnv), HandlerSite f, [Text])
Enctype
Ints
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
-> MForm f (FormResult a)
forall a b.
(a -> b)
-> RWST
(Maybe (Env, FileEnv), HandlerSite f, [Text]) Enctype Ints f a
-> RWST
(Maybe (Env, FileEnv), HandlerSite f, [Text]) Enctype Ints f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
-> FormResult a
forall a b. (a, b) -> a
fst (RWST
(Maybe (Env, FileEnv), HandlerSite f, [Text])
Enctype
Ints
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
-> MForm f (FormResult a))
-> (AForm f a
-> RWST
(Maybe (Env, FileEnv), HandlerSite f, [Text])
Enctype
Ints
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)]))
-> AForm f a
-> MForm f (FormResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AForm f a
-> RWST
(Maybe (Env, FileEnv), HandlerSite f, [Text])
Enctype
Ints
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
forall (m :: * -> *) site a.
(Monad m, HandlerSite m ~ site) =>
AForm m a
-> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm
aFormToMaybePostSuccess
:: MonadHandlerForm f
=> AForm f a -> f (Maybe a)
aFormToMaybePostSuccess :: forall (f :: * -> *) a.
MonadHandlerForm f =>
AForm f a -> f (Maybe a)
aFormToMaybePostSuccess =
((FormResult a, Enctype) -> Maybe a)
-> f (FormResult a, Enctype) -> f (Maybe a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FormResult a -> Maybe a
forall a. FormResult a -> Maybe a
maybeSuccess (FormResult a -> Maybe a)
-> ((FormResult a, Enctype) -> FormResult a)
-> (FormResult a, Enctype)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FormResult a, Enctype) -> FormResult a
forall a b. (a, b) -> a
fst) (f (FormResult a, Enctype) -> f (Maybe a))
-> (AForm f a -> f (FormResult a, Enctype))
-> AForm f a
-> f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Markup -> MForm f (FormResult a)) -> f (FormResult a, Enctype)
(Markup
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a))
-> f (FormResult a, Enctype)
forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> m (a, Enctype)
runFormPostNoToken ((Markup
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a))
-> f (FormResult a, Enctype))
-> (AForm f a
-> Markup
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a))
-> AForm f a
-> f (FormResult a, Enctype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a)
-> Markup
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a)
forall a b. a -> b -> a
const (RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a)
-> Markup
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a))
-> (AForm f a
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a))
-> AForm f a
-> Markup
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
-> FormResult a)
-> RWST
(Maybe (Env, FileEnv), App, [Text])
Enctype
Ints
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a)
forall a b.
(a -> b)
-> RWST (Maybe (Env, FileEnv), App, [Text]) Enctype Ints f a
-> RWST (Maybe (Env, FileEnv), App, [Text]) Enctype Ints f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
-> FormResult a
forall a b. (a, b) -> a
fst (RWST
(Maybe (Env, FileEnv), App, [Text])
Enctype
Ints
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a))
-> (AForm f a
-> RWST
(Maybe (Env, FileEnv), App, [Text])
Enctype
Ints
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)]))
-> AForm f a
-> RWST
(Maybe (Env, FileEnv), App, [Text]) Enctype Ints f (FormResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AForm f a
-> MForm
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
AForm f a
-> RWST
(Maybe (Env, FileEnv), App, [Text])
Enctype
Ints
f
(FormResult a,
[FieldView (HandlerSite f)] -> [FieldView (HandlerSite f)])
forall (m :: * -> *) site a.
(Monad m, HandlerSite m ~ site) =>
AForm m a
-> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm
maybeSuccess :: FormResult a -> Maybe a
maybeSuccess :: forall a. FormResult a -> Maybe a
maybeSuccess (FormSuccess a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
maybeSuccess FormResult a
_ = Maybe a
forall a. Maybe a
Nothing
named :: Text -> FieldSettings master -> FieldSettings master
named :: forall master. Text -> FieldSettings master -> FieldSettings master
named Text
n FieldSettings master
f =
FieldSettings master
f
{ fsName = Just n
, fsId = Just n
}
attr :: (Text,Text) -> FieldSettings master -> FieldSettings master
attr :: forall master.
(Text, Text) -> FieldSettings master -> FieldSettings master
attr (Text, Text)
n FieldSettings master
f =
FieldSettings master
f
{ fsAttrs = n : fsAttrs f
}
attrs :: [(Text,Text)] -> FieldSettings master -> FieldSettings master
attrs :: forall master.
[(Text, Text)] -> FieldSettings master -> FieldSettings master
attrs [(Text, Text)]
n FieldSettings master
f =
FieldSettings master
f
{ fsAttrs = n ++ fsAttrs f
}
cls :: [Text] -> FieldSettings master -> FieldSettings master
cls :: forall master.
[Text] -> FieldSettings master -> FieldSettings master
cls [Text]
n = [(Text, Text)] -> FieldSettings master -> FieldSettings master
forall master.
[(Text, Text)] -> FieldSettings master -> FieldSettings master
attrs [(Text
"class", [Text] -> Text
forall seq. (Element seq ~ Text, MonoFoldable seq) => seq -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords [Text]
n)]