--------------------------------------------------------------------------------
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Internal embedding of form fields with associated functions.
module Text.Digestive.Form.Internal.Field
( Field (..)
, SomeField (..)
, evalField
, fieldMapView
) where
--------------------------------------------------------------------------------
import Control.Arrow (second)
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Text (Text)
--------------------------------------------------------------------------------
import Text.Digestive.Types
--------------------------------------------------------------------------------
-- | A single input field. This usually maps to a single HTML @@ element.
data Field v a where
Singleton :: a -> Field v a
Text :: Text -> Field v Text
-- A list of identifier, value, view. Then we have the default index in
-- the list. The return value has the actual value as well as the index in
-- the list.
Choice :: [(Text, [(Text, (a, v))])] -> Int -> Field v (a, Int)
Bool :: Bool -> Field v Bool
File :: Field v (Maybe FilePath)
--------------------------------------------------------------------------------
instance Show (Field v a) where
show (Singleton _) = "Singleton _"
show (Text t) = "Text " ++ show t
show (Choice _ _) = "Choice _ _"
show (Bool b) = "Bool " ++ show b
show (File) = "File"
--------------------------------------------------------------------------------
-- | Value agnostic "Field"
data SomeField v = forall a. SomeField (Field v a)
--------------------------------------------------------------------------------
-- | Evaluate a field to retrieve a value, using the given method and
-- a list of input.
evalField :: Method -- ^ Get/Post
-> [FormInput] -- ^ Given input
-> Field v a -- ^ Field
-> a -- ^ Result
evalField _ _ (Singleton x) = x
evalField _ (TextInput x : _) (Text _) = x
evalField _ _ (Text x) = x
evalField _ (TextInput x : _) (Choice ls' y) =
let ls = concat (map snd ls') in
fromMaybe (fst (snd (ls !! y)), y) $ do
-- Expects input in the form of "foo.bar.2". This is not needed for
--