{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Yesod.Form.Input
( FormInput (..)
, runInputGet
, runInputGetResult
, runInputPost
, runInputPostResult
, ireq
, iopt
) where
import Yesod.Form.Types
import Data.Text (Text)
import Control.Applicative (Applicative (..))
import Yesod.Core
import Control.Monad (liftM, (<=<))
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Control.Arrow ((***))
type DText = [Text] -> [Text]
newtype FormInput m a = FormInput { FormInput m a
-> HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
unFormInput :: HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a) }
instance Monad m => Functor (FormInput m) where
fmap :: (a -> b) -> FormInput m a -> FormInput m b
fmap a -> b
a (FormInput HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
f) = (HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText b))
-> FormInput m b
forall (m :: * -> *) a.
(HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a
FormInput ((HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText b))
-> FormInput m b)
-> (HandlerSite m
-> [Text] -> Env -> FileEnv -> m (Either DText b))
-> FormInput m b
forall a b. (a -> b) -> a -> b
$ \HandlerSite m
c [Text]
d Env
e FileEnv
e' -> (Either DText a -> Either DText b)
-> m (Either DText a) -> m (Either DText b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((DText -> Either DText b)
-> (a -> Either DText b) -> Either DText a -> Either DText b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either DText -> Either DText b
forall a b. a -> Either a b
Left (b -> Either DText b
forall a b. b -> Either a b
Right (b -> Either DText b) -> (a -> b) -> a -> Either DText b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
a)) (m (Either DText a) -> m (Either DText b))
-> m (Either DText a) -> m (Either DText b)
forall a b. (a -> b) -> a -> b
$ HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
f HandlerSite m
c [Text]
d Env
e FileEnv
e'
instance Monad m => Control.Applicative.Applicative (FormInput m) where
pure :: a -> FormInput m a
pure = (HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a
forall (m :: * -> *) a.
(HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a
FormInput ((HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a)
-> (a
-> HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> a
-> FormInput m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Env -> FileEnv -> m (Either DText a))
-> HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
forall a b. a -> b -> a
const (([Text] -> Env -> FileEnv -> m (Either DText a))
-> HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> (a -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> a
-> HandlerSite m
-> [Text]
-> Env
-> FileEnv
-> m (Either DText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> FileEnv -> m (Either DText a))
-> [Text] -> Env -> FileEnv -> m (Either DText a)
forall a b. a -> b -> a
const ((Env -> FileEnv -> m (Either DText a))
-> [Text] -> Env -> FileEnv -> m (Either DText a))
-> (a -> Env -> FileEnv -> m (Either DText a))
-> a
-> [Text]
-> Env
-> FileEnv
-> m (Either DText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileEnv -> m (Either DText a))
-> Env -> FileEnv -> m (Either DText a)
forall a b. a -> b -> a
const ((FileEnv -> m (Either DText a))
-> Env -> FileEnv -> m (Either DText a))
-> (a -> FileEnv -> m (Either DText a))
-> a
-> Env
-> FileEnv
-> m (Either DText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either DText a) -> FileEnv -> m (Either DText a)
forall a b. a -> b -> a
const (m (Either DText a) -> FileEnv -> m (Either DText a))
-> (a -> m (Either DText a)) -> a -> FileEnv -> m (Either DText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either DText a -> m (Either DText a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DText a -> m (Either DText a))
-> (a -> Either DText a) -> a -> m (Either DText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either DText a
forall a b. b -> Either a b
Right
(FormInput HandlerSite m
-> [Text] -> Env -> FileEnv -> m (Either DText (a -> b))
f) <*> :: FormInput m (a -> b) -> FormInput m a -> FormInput m b
<*> (FormInput HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
x) = (HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText b))
-> FormInput m b
forall (m :: * -> *) a.
(HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a
FormInput ((HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText b))
-> FormInput m b)
-> (HandlerSite m
-> [Text] -> Env -> FileEnv -> m (Either DText b))
-> FormInput m b
forall a b. (a -> b) -> a -> b
$ \HandlerSite m
c [Text]
d Env
e FileEnv
e' -> do
Either DText (a -> b)
res1 <- HandlerSite m
-> [Text] -> Env -> FileEnv -> m (Either DText (a -> b))
f HandlerSite m
c [Text]
d Env
e FileEnv
e'
Either DText a
res2 <- HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
x HandlerSite m
c [Text]
d Env
e FileEnv
e'
Either DText b -> m (Either DText b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DText b -> m (Either DText b))
-> Either DText b -> m (Either DText b)
forall a b. (a -> b) -> a -> b
$ case (Either DText (a -> b)
res1, Either DText a
res2) of
(Left DText
a, Left DText
b) -> DText -> Either DText b
forall a b. a -> Either a b
Left (DText -> Either DText b) -> DText -> Either DText b
forall a b. (a -> b) -> a -> b
$ DText
a DText -> DText -> DText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DText
b
(Left DText
a, Either DText a
_) -> DText -> Either DText b
forall a b. a -> Either a b
Left DText
a
(Either DText (a -> b)
_, Left DText
b) -> DText -> Either DText b
forall a b. a -> Either a b
Left DText
b
(Right a -> b
a, Right a
b) -> b -> Either DText b
forall a b. b -> Either a b
Right (b -> Either DText b) -> b -> Either DText b
forall a b. (a -> b) -> a -> b
$ a -> b
a a
b
ireq :: (Monad m, RenderMessage (HandlerSite m) FormMessage)
=> Field m a
-> Text
-> FormInput m a
ireq :: Field m a -> Text -> FormInput m a
ireq Field m a
field Text
name = (HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a
forall (m :: * -> *) a.
(HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a
FormInput ((HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a)
-> (HandlerSite m
-> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a
forall a b. (a -> b) -> a -> b
$ \HandlerSite m
m [Text]
l Env
env FileEnv
fenv -> do
let filteredEnv :: [Text]
filteredEnv = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Env -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Env
env
filteredFEnv :: [FileInfo]
filteredFEnv = [FileInfo] -> Maybe [FileInfo] -> [FileInfo]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [FileInfo] -> [FileInfo]) -> Maybe [FileInfo] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$ Text -> FileEnv -> Maybe [FileInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name FileEnv
fenv
Either (SomeMessage (HandlerSite m)) (Maybe a)
emx <- Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse Field m a
field [Text]
filteredEnv [FileInfo]
filteredFEnv
Either DText a -> m (Either DText a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DText a -> m (Either DText a))
-> Either DText a -> m (Either DText a)
forall a b. (a -> b) -> a -> b
$ case Either (SomeMessage (HandlerSite m)) (Maybe a)
emx of
Left (SomeMessage msg
e) -> DText -> Either DText a
forall a b. a -> Either a b
Left (DText -> Either DText a) -> DText -> Either DText a
forall a b. (a -> b) -> a -> b
$ (:) (Text -> DText) -> Text -> DText
forall a b. (a -> b) -> a -> b
$ HandlerSite m -> [Text] -> msg -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage HandlerSite m
m [Text]
l msg
e
Right Maybe a
Nothing -> DText -> Either DText a
forall a b. a -> Either a b
Left (DText -> Either DText a) -> DText -> Either DText a
forall a b. (a -> b) -> a -> b
$ (:) (Text -> DText) -> Text -> DText
forall a b. (a -> b) -> a -> b
$ HandlerSite m -> [Text] -> FormMessage -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage HandlerSite m
m [Text]
l (FormMessage -> Text) -> FormMessage -> Text
forall a b. (a -> b) -> a -> b
$ Text -> FormMessage
MsgInputNotFound Text
name
Right (Just a
a) -> a -> Either DText a
forall a b. b -> Either a b
Right a
a
iopt :: Monad m => Field m a -> Text -> FormInput m (Maybe a)
iopt :: Field m a -> Text -> FormInput m (Maybe a)
iopt Field m a
field Text
name = (HandlerSite m
-> [Text] -> Env -> FileEnv -> m (Either DText (Maybe a)))
-> FormInput m (Maybe a)
forall (m :: * -> *) a.
(HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a))
-> FormInput m a
FormInput ((HandlerSite m
-> [Text] -> Env -> FileEnv -> m (Either DText (Maybe a)))
-> FormInput m (Maybe a))
-> (HandlerSite m
-> [Text] -> Env -> FileEnv -> m (Either DText (Maybe a)))
-> FormInput m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \HandlerSite m
m [Text]
l Env
env FileEnv
fenv -> do
let filteredEnv :: [Text]
filteredEnv = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Env -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Env
env
filteredFEnv :: [FileInfo]
filteredFEnv = [FileInfo] -> Maybe [FileInfo] -> [FileInfo]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [FileInfo] -> [FileInfo]) -> Maybe [FileInfo] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$ Text -> FileEnv -> Maybe [FileInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name FileEnv
fenv
Either (SomeMessage (HandlerSite m)) (Maybe a)
emx <- Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse Field m a
field [Text]
filteredEnv [FileInfo]
filteredFEnv
Either DText (Maybe a) -> m (Either DText (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DText (Maybe a) -> m (Either DText (Maybe a)))
-> Either DText (Maybe a) -> m (Either DText (Maybe a))
forall a b. (a -> b) -> a -> b
$ case Either (SomeMessage (HandlerSite m)) (Maybe a)
emx of
Left (SomeMessage msg
e) -> DText -> Either DText (Maybe a)
forall a b. a -> Either a b
Left (DText -> Either DText (Maybe a))
-> DText -> Either DText (Maybe a)
forall a b. (a -> b) -> a -> b
$ (:) (Text -> DText) -> Text -> DText
forall a b. (a -> b) -> a -> b
$ HandlerSite m -> [Text] -> msg -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage HandlerSite m
m [Text]
l msg
e
Right Maybe a
x -> Maybe a -> Either DText (Maybe a)
forall a b. b -> Either a b
Right Maybe a
x
runInputGet :: MonadHandler m => FormInput m a -> m a
runInputGet :: FormInput m a -> m a
runInputGet = ([Text] -> m a) -> (a -> m a) -> Either [Text] a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Text] -> m a
forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
invalidArgs a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] a -> m a)
-> (FormInput m a -> m (Either [Text] a)) -> FormInput m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FormInput m a -> m (Either [Text] a)
forall (m :: * -> *) a.
MonadHandler m =>
FormInput m a -> m (Either [Text] a)
runInputGetHelper
runInputGetResult :: MonadHandler m => FormInput m a -> m (FormResult a)
runInputGetResult :: FormInput m a -> m (FormResult a)
runInputGetResult = (Either [Text] a -> FormResult a)
-> m (Either [Text] a) -> m (FormResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Text] -> FormResult a)
-> (a -> FormResult a) -> Either [Text] a -> FormResult a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Text] -> FormResult a
forall a. [Text] -> FormResult a
FormFailure a -> FormResult a
forall a. a -> FormResult a
FormSuccess) (m (Either [Text] a) -> m (FormResult a))
-> (FormInput m a -> m (Either [Text] a))
-> FormInput m a
-> m (FormResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormInput m a -> m (Either [Text] a)
forall (m :: * -> *) a.
MonadHandler m =>
FormInput m a -> m (Either [Text] a)
runInputGetHelper
runInputGetHelper :: MonadHandler m => FormInput m a -> m (Either [Text] a)
runInputGetHelper :: FormInput m a -> m (Either [Text] a)
runInputGetHelper (FormInput HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
f) = do
Env
env <- (YesodRequest -> Env) -> m YesodRequest -> m Env
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([(Text, Text)] -> Env
forall a. [(Text, a)] -> Map Text [a]
toMap ([(Text, Text)] -> Env)
-> (YesodRequest -> [(Text, Text)]) -> YesodRequest -> Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YesodRequest -> [(Text, Text)]
reqGetParams) m YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
HandlerSite m
m <- m (HandlerSite m)
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
[Text]
l <- m [Text]
forall (m :: * -> *). MonadHandler m => m [Text]
languages
Either DText a
emx <- HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
f HandlerSite m
m [Text]
l Env
env FileEnv
forall k a. Map k a
Map.empty
Either [Text] a -> m (Either [Text] a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] a -> m (Either [Text] a))
-> Either [Text] a -> m (Either [Text] a)
forall a b. (a -> b) -> a -> b
$ (DText -> Either [Text] a)
-> (a -> Either [Text] a) -> Either DText a -> Either [Text] a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Text] -> Either [Text] a
forall a b. a -> Either a b
Left ([Text] -> Either [Text] a)
-> (DText -> [Text]) -> DText -> Either [Text] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DText -> DText
forall a b. (a -> b) -> a -> b
$ [])) a -> Either [Text] a
forall a b. b -> Either a b
Right Either DText a
emx
toMap :: [(Text, a)] -> Map.Map Text [a]
toMap :: [(Text, a)] -> Map Text [a]
toMap = ([a] -> [a] -> [a]) -> [Map Text [a]] -> Map Text [a]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([Map Text [a]] -> Map Text [a])
-> ([(Text, a)] -> [Map Text [a]]) -> [(Text, a)] -> Map Text [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, a) -> Map Text [a]) -> [(Text, a)] -> [Map Text [a]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, a
y) -> Text -> [a] -> Map Text [a]
forall k a. k -> a -> Map k a
Map.singleton Text
x [a
y])
runInputPost :: MonadHandler m => FormInput m a -> m a
runInputPost :: FormInput m a -> m a
runInputPost = ([Text] -> m a) -> (a -> m a) -> Either [Text] a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Text] -> m a
forall (m :: * -> *) a. MonadHandler m => [Text] -> m a
invalidArgs a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] a -> m a)
-> (FormInput m a -> m (Either [Text] a)) -> FormInput m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FormInput m a -> m (Either [Text] a)
forall (m :: * -> *) a.
MonadHandler m =>
FormInput m a -> m (Either [Text] a)
runInputPostHelper
runInputPostResult :: MonadHandler m => FormInput m a -> m (FormResult a)
runInputPostResult :: FormInput m a -> m (FormResult a)
runInputPostResult = (Either [Text] a -> FormResult a)
-> m (Either [Text] a) -> m (FormResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Text] -> FormResult a)
-> (a -> FormResult a) -> Either [Text] a -> FormResult a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Text] -> FormResult a
forall a. [Text] -> FormResult a
FormFailure a -> FormResult a
forall a. a -> FormResult a
FormSuccess) (m (Either [Text] a) -> m (FormResult a))
-> (FormInput m a -> m (Either [Text] a))
-> FormInput m a
-> m (FormResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormInput m a -> m (Either [Text] a)
forall (m :: * -> *) a.
MonadHandler m =>
FormInput m a -> m (Either [Text] a)
runInputPostHelper
runInputPostHelper :: MonadHandler m => FormInput m a -> m (Either [Text] a)
runInputPostHelper :: FormInput m a -> m (Either [Text] a)
runInputPostHelper (FormInput HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
f) = do
(Env
env, FileEnv
fenv) <- (RequestBodyContents -> (Env, FileEnv))
-> m RequestBodyContents -> m (Env, FileEnv)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([(Text, Text)] -> Env
forall a. [(Text, a)] -> Map Text [a]
toMap ([(Text, Text)] -> Env)
-> ([(Text, FileInfo)] -> FileEnv)
-> RequestBodyContents
-> (Env, FileEnv)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [(Text, FileInfo)] -> FileEnv
forall a. [(Text, a)] -> Map Text [a]
toMap) m RequestBodyContents
forall (m :: * -> *). MonadHandler m => m RequestBodyContents
runRequestBody
HandlerSite m
m <- m (HandlerSite m)
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
[Text]
l <- m [Text]
forall (m :: * -> *). MonadHandler m => m [Text]
languages
(Either DText a -> Either [Text] a)
-> m (Either DText a) -> m (Either [Text] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DText -> Either [Text] a)
-> (a -> Either [Text] a) -> Either DText a -> Either [Text] a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Text] -> Either [Text] a
forall a b. a -> Either a b
Left ([Text] -> Either [Text] a)
-> (DText -> [Text]) -> DText -> Either [Text] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DText -> DText
forall a b. (a -> b) -> a -> b
$ [])) a -> Either [Text] a
forall a b. b -> Either a b
Right) (m (Either DText a) -> m (Either [Text] a))
-> m (Either DText a) -> m (Either [Text] a)
forall a b. (a -> b) -> a -> b
$ HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
f HandlerSite m
m [Text]
l Env
env FileEnv
fenv