    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE FlexibleContexts #-}
    -- | Provides for getting input from either GET or POST params without
    -- generating HTML forms. For more information, see:
    -- <http://www.yesodweb.com/book/forms#forms_kinds_of_forms>.
    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]

    -- | Type for a form which parses a value of type @a@ with the base monad @m@
    -- (usually your @Handler@). Can compose this using its @Applicative@ instance.
    newtype FormInput m a = FormInput { forall (m :: * -> *) a.
    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 :: forall a b. (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 :: forall a. 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 a. a -> m 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) <*> :: forall a b. 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
            res1 <- HandlerSite m
    -> [Text] -> Env -> FileEnv -> m (Either DText (a -> b))
    f HandlerSite m
    c [Text]
    d Env
    e FileEnv
    e'
            res2 <- x c d e e'
            return $ case (res1, 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

    -- | Promote a @Field@ into a @FormInput@, requiring that the value be present
    -- and valid.
    ireq :: (Monad m, RenderMessage (HandlerSite m) FormMessage)
         => Field m a
         -> Text -- ^ name of the field
         -> FormInput m a
    ireq :: forall (m :: * -> *) a.
    (Monad m, RenderMessage (HandlerSite m) FormMessage) =>
    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
          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
          return $ case 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

    -- | Promote a @Field@ into a @FormInput@, with its presence being optional. If
    -- the value is present but does not parse correctly, the form will still fail.
    iopt :: Monad m => Field m a -> Text -> FormInput m (Maybe a)
    iopt :: forall (m :: * -> *) a.
    Monad m =>
    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
          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
          return $ case 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

    -- | Run a @FormInput@ on the GET parameters (i.e., query string). If parsing
    -- fails, calls 'invalidArgs'.
    runInputGet :: MonadHandler m => FormInput m a -> m a
    runInputGet :: forall (m :: * -> *) a. MonadHandler m => 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 a. 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

    -- | Run a @FormInput@ on the GET parameters (i.e., query string). Does /not/
    -- throw exceptions on failure.
    --
    -- Since 1.4.1
    runInputGetResult :: MonadHandler m => FormInput m a -> m (FormResult a)
    runInputGetResult :: forall (m :: * -> *) a.
    MonadHandler m =>
    FormInput m a -> m (FormResult a)
    runInputGetResult = (Either [Text] a -> FormResult a)
    -> m (Either [Text] a) -> m (FormResult a)
    forall a b. (a -> b) -> m a -> m b
    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 :: forall (m :: * -> *) a.
    MonadHandler m =>
    FormInput m a -> m (Either [Text] a)
    runInputGetHelper (FormInput HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
    f) = do
        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
        m <- getYesod
        l <- languages
        emx <- f m l env Map.empty
        return $ either (Left . ($ [])) Right emx

    toMap :: [(Text, a)] -> Map.Map Text [a]
    toMap :: forall a. [(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])

    -- | Run a @FormInput@ on the POST parameters (i.e., request body). If parsing
    -- fails, calls 'invalidArgs'.
    runInputPost :: MonadHandler m => FormInput m a -> m a
    runInputPost :: forall (m :: * -> *) a. MonadHandler m => 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 a. 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

    -- | Run a @FormInput@ on the POST parameters (i.e., request body). Does /not/
    -- throw exceptions on failure.
    runInputPostResult :: MonadHandler m => FormInput m a -> m (FormResult a)
    runInputPostResult :: forall (m :: * -> *) a.
    MonadHandler m =>
    FormInput m a -> m (FormResult a)
    runInputPostResult = (Either [Text] a -> FormResult a)
    -> m (Either [Text] a) -> m (FormResult a)
    forall a b. (a -> b) -> m a -> m b
    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 :: forall (m :: * -> *) a.
    MonadHandler m =>
    FormInput m a -> m (Either [Text] a)
    runInputPostHelper (FormInput HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a)
    f) = do
        (env, 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 b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    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
        m <- getYesod
        l <- languages
        fmap (either (Left . ($ [])) Right) $ f m l env fenv