module Text.Digestive.Forms
( FormInput (..)
, inputString
, inputRead
, inputBool
, inputChoice
, inputFile
) where
import Control.Applicative ((<$>))
import Control.Monad (mplus)
import Data.Monoid (Monoid, mconcat)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T (pack)
import Text.Digestive.Common
import Text.Digestive.Types
import Text.Digestive.Result
import Text.Digestive.Transform
class FormInput i f | i -> f where
getInputString :: i -> Maybe String
getInputText :: i -> Maybe Text
getInputText = fmap T.pack . getInputString
getInputFile :: i -> Maybe f
inputString :: (Monad m, Functor m, FormInput i f)
=> (FormId -> Maybe String -> v)
-> Maybe String
-> Form m i e v String
inputString = input toView toResult
where
toView _ inp defaultInput = (getInputString =<< inp) `mplus` defaultInput
toResult = Ok . fromMaybe "" . (getInputString =<<)
inputRead :: (Monad m, Functor m, FormInput i f, Read a, Show a)
=> (FormId -> Maybe String -> v)
-> e
-> Maybe a
-> Form m i e v a
inputRead cons' error' def = inputString cons' (fmap show def)
`transform` transformRead error'
inputBool :: (Monad m, Functor m, FormInput i f)
=> (FormId -> Bool -> v)
-> Bool
-> Form m i e v Bool
inputBool = input toView toResult
where
toView isInput inp def = if isInput then readBool (getInputString =<< inp)
else def
toResult inp = Ok $ readBool (getInputString =<< inp)
readBool (Just x) = not $ null x
readBool Nothing = False
inputChoice :: (Monad m, Functor m, FormInput i f, Monoid v, Eq a)
=> (FormId -> String -> Bool -> a -> v)
-> a
-> [a]
-> Form m i e v a
inputChoice toView defaultInput choices = Form $ do
inputKey <- fromMaybe "" . (getInputString =<<) <$> 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
inputFile :: (Monad m, Functor m, FormInput i f)
=> (FormId -> v)
-> Form m i e v (Maybe f)
inputFile viewCons = input toView toResult viewCons' ()
where
toView _ _ _ = ()
toResult inp = Ok $ getInputFile =<< inp
viewCons' id' () = viewCons id'