{-# 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 <- forall (m :: * -> *).
MonadHandler m =>
CI ByteString -> m (Maybe ByteString)
lookupHeader CI ByteString
"content-type"
case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> ByteString -> ByteString
B8.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
';')) Maybe ByteString
mct of
Just ByteString
"application/json" ->
forall (m :: * -> *) a.
(MonadHandler m, FromJSON a) =>
m (Result a)
parseCheckJsonBody forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
A.Success a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> FormResult a
FormSuccess a
a
A.Error String
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [Text] -> FormResult a
FormFailure [forall seq. IsSequence seq => [Element seq] -> seq
pack String
e]
Just ByteString
"application/x-www-form-urlencoded" ->
forall (m :: * -> *) a.
MonadHandler m =>
FormInput m a -> m (FormResult a)
runInputPostResult FormInput m a
form
Maybe ByteString
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 =
forall a (m :: * -> *).
(FromJSON a, MonadHandlerForm m) =>
FormInput m a -> m (FormResult a)
runInputPostJSONResult FormInput m a
form forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\case
FormSuccess a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
FormFailure [Text]
e -> forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
invalidArgs [Text]
e
FormResult a
FormMissing -> 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 =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. FormResult a -> Maybe a
maybeSuccess forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> a
fst) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> m (a, Enctype)
runFormGet forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. FormResult a -> Maybe a
maybeSuccess forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> a
fst) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> m (a, Enctype)
runFormPostNoToken forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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) = forall a. a -> Maybe a
Just a
a
maybeSuccess FormResult 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 :: Maybe Text
fsName = forall a. a -> Maybe a
Just Text
n
, fsId :: Maybe Text
fsId = forall a. a -> Maybe a
Just Text
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 :: [(Text, Text)]
fsAttrs = (Text, Text)
n forall a. a -> [a] -> [a]
: forall master. FieldSettings master -> [(Text, Text)]
fsAttrs FieldSettings master
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 :: [(Text, Text)]
fsAttrs = [(Text, Text)]
n forall m. Monoid m => m -> m -> m
++ forall master. FieldSettings master -> [(Text, Text)]
fsAttrs FieldSettings master
f
}
cls :: [Text] -> FieldSettings master -> FieldSettings master
cls :: forall master.
[Text] -> FieldSettings master -> FieldSettings master
cls [Text]
n = forall master.
[(Text, Text)] -> FieldSettings master -> FieldSettings master
attrs [(Text
"class", forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords [Text]
n)]