module Text.Digestive.Common
( input
, inputString
, inputRead
, inputBool
, inputChoice
, label
, errors
, childErrors
) where
import Control.Applicative ((<$>))
import Control.Monad (mplus)
import Data.Monoid (Monoid, mconcat)
import Data.Maybe (fromMaybe)
import Text.Digestive.Types
import Text.Digestive.Result
import Text.Digestive.Transform
input :: (Monad m, Functor m)
=> (Bool -> Maybe String -> d -> s)
-> (Maybe String -> FormRange -> Result e a)
-> (FormId -> s -> v)
-> d
-> Form m String e v a
input toView toResult createView defaultInput = Form $ do
isInput <- isFormInput
inp <- getFormInput
id' <- getFormId
range <- getFormRange
let view' = toView isInput inp defaultInput
result' = toResult inp range
return (View (const $ createView id' view'), result')
inputString :: (Monad m, Functor m)
=> (FormId -> Maybe String -> v)
-> Maybe String
-> Form m String e v String
inputString = input toView toResult
where
toView = const mplus
toResult = const . Ok . fromMaybe ""
inputRead :: (Monad m, Functor m, Read a, Show a)
=> (FormId -> Maybe String -> v)
-> e
-> Maybe a
-> Form m String e v a
inputRead cons' error' def = inputString cons' (fmap show def)
`transform` transformRead error'
inputBool :: (Monad m, Functor m)
=> (FormId -> Bool -> v)
-> Bool
-> Form m String e v Bool
inputBool = input toView toResult
where
toView isInput inp def = if isInput then readBool inp else def
toResult inp _ = Ok $ readBool inp
readBool (Just x) = not (null x)
readBool Nothing = False
inputChoice :: (Monad m, Functor m, Monoid v, Eq a)
=> (FormId -> String -> Bool -> a -> v)
-> a
-> [a]
-> Form m String e v a
inputChoice toView defaultInput choices = Form $ do
inputKey <- fromMaybe "" <$> getFormInput
id' <- getFormId
let
inp = fromMaybe defaultInput $ lookup inputKey $ zip (ids id') choices
view' = mconcat $ zipWith (toView' id' inp) (ids id') choices
return (View (const view'), Ok inp)
where
ids id' = map (((show id' ++ "-") ++) . show) [1 .. length choices]
toView' id' inp key x = toView id' key (inp == x) x
label :: Monad m
=> (FormId -> v)
-> Form m i e v ()
label f = Form $ do
id' <- getFormId
return (View (const $ f id'), Ok ())
errors :: Monad m
=> ([e] -> v)
-> Form m i e v ()
errors f = Form $ do
range <- getFormRange
return (View (f . retainErrors range), Ok ())
childErrors :: Monad m
=> ([e] -> v)
-> Form m i e v ()
childErrors f = Form $ do
range <- getFormRange
return (View (f . retainChildErrors range), Ok ())