module Text.Digestive.Form
( Formlet
, Form
, SomeForm (..)
, (.:)
, text
, string
, stringRead
, choice
, choice'
, choiceWith
, choiceWith'
, groupedChoice
, groupedChoice'
, groupedChoiceWith
, groupedChoiceWith'
, bool
, file
, optionalText
, optionalString
, optionalStringRead
, check
, checkM
, validate
, validateM
, monadic
, listOf
) where
import Control.Monad (liftM)
import Data.List (findIndex)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Digestive.Form.Internal
import Text.Digestive.Form.Internal.Field
import Text.Digestive.Form.List
import Text.Digestive.Ref
import Text.Digestive.Types
import Text.Digestive.Util
type Formlet v m a = Maybe a -> Form v m a
text :: Formlet v m Text
text def = Pure $ Text $ fromMaybe "" def
string :: Monad m => Formlet v m String
string = fmap T.unpack . text . fmap T.pack
stringRead :: (Monad m, Read a, Show a) => v -> Formlet v m a
stringRead err = transform (readTransform err) . string . fmap show
choice :: (Eq a, Monad m) => [(a, v)] -> Formlet v m a
choice items def = choiceWith (zip makeRefs items) def
choice' :: Monad m => [(a, v)] -> Maybe Int -> Form v m a
choice' items def = choiceWith' (zip makeRefs items) def
choiceWith :: (Eq a, Monad m) => [(Text, (a, v))] -> Formlet v m a
choiceWith items def = choiceWith' items def'
where
def' = def >>= (\d -> findIndex ((== d) . fst . snd) items)
choiceWith' :: Monad m => [(Text, (a, v))] -> Maybe Int -> Form v m a
choiceWith' items def = fmap fst $ Pure $ Choice [("", items)] def'
where
def' = fromMaybe 0 def
groupedChoice :: (Eq a, Monad m) => [(Text, [(a, v)])] -> Formlet v m a
groupedChoice items def =
groupedChoiceWith (mkGroupedRefs items makeRefs) def
groupedChoice' :: Monad m => [(Text, [(a, v)])] -> Maybe Int -> Form v m a
groupedChoice' items def =
groupedChoiceWith' (mkGroupedRefs items makeRefs) def
mkGroupedRefs :: [(Text, [a])]
-> [Text]
-> [(Text, [(Text, a)])]
mkGroupedRefs [] _ = []
mkGroupedRefs (g:gs) is = cur : mkGroupedRefs gs b
where
(a,b) = splitAt (length $ snd g) is
cur = (fst g, zip a (snd g))
groupedChoiceWith :: (Eq a, Monad m)
=> [(Text, [(Text, (a, v))])]
-> Formlet v m a
groupedChoiceWith items def = groupedChoiceWith' items def'
where
def' = def >>= (\d -> findIndex ((== d) . fst . snd) $
concat $ map snd items)
groupedChoiceWith' :: Monad m
=> [(Text, [(Text, (a, v))])]
-> Maybe Int
-> Form v m a
groupedChoiceWith' items def = fmap fst $ Pure $ Choice items def'
where
def' = fromMaybe 0 def
bool :: Formlet v m Bool
bool = Pure . Bool . fromMaybe False
file :: Form v m (Maybe FilePath)
file = Pure File
check :: Monad m
=> v
-> (a -> Bool)
-> Form v m a
-> Form v m a
check err = checkM err . (return .)
checkM :: Monad m => v -> (a -> m Bool) -> Form v m a -> Form v m a
checkM err predicate form = validateM f form
where
f x = do
r <- predicate x
return $ if r then return x else Error err
validate :: Monad m => (a -> Result v b) -> Form v m a -> Form v m b
validate = validateM . (return .)
validateM :: Monad m => (a -> m (Result v b)) -> Form v m a -> Form v m b
validateM = transform
optionalText :: Monad m => Maybe Text -> Form v m (Maybe Text)
optionalText def = validate optional (text def)
where
optional t
| T.null t = return Nothing
| otherwise = return $ Just t
optionalString :: Monad m => Maybe String -> Form v m (Maybe String)
optionalString = fmap (fmap T.unpack) . optionalText . fmap T.pack
optionalStringRead :: (Monad m, Read a, Show a)
=> v -> Maybe a -> Form v m (Maybe a)
optionalStringRead err = transform readTransform' . optionalString . fmap show
where
readTransform' (Just s) = liftM (fmap Just) $ readTransform err s
readTransform' Nothing = return (return Nothing)
readTransform :: (Monad m, Read a) => v -> String -> m (Result v a)
readTransform err = return . maybe (Error err) return . readMaybe
listOf :: Monad m
=> Formlet v m a
-> Formlet v m [a]
listOf single def =
List (fmap single defList) (indicesRef .: listIndices ixs)
where
ixs = case def of
Nothing -> [0]
Just xs -> [0 .. length xs 1]
defList = DefaultList Nothing $ maybe [] (map Just) def
listIndices :: Monad m => [Int] -> Form v m [Int]
listIndices = fmap parseIndices . text . Just . unparseIndices