packages feed

digestive-functors 0.4.1.2 → 0.5.0.0

raw patch · 10 files changed

+307/−67 lines, 10 files

Files

digestive-functors.cabal view
@@ -1,5 +1,5 @@ Name:     digestive-functors-Version:  0.4.1.2+Version:  0.5.0.0 Synopsis: A practical formlet library  Description:
src/Text/Digestive.hs view
@@ -1,3 +1,4 @@+-------------------------------------------------------------------------------- -- | Tutorial: -- <http://github.com/jaspervdj/digestive-functors/blob/master/examples/tutorial.lhs> module Text.Digestive@@ -8,6 +9,8 @@     , module Text.Digestive.View     ) where ++-------------------------------------------------------------------------------- import           Text.Digestive.Form import           Text.Digestive.Form.Encoding import           Text.Digestive.Ref
src/Text/Digestive/Field.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE ExistentialQuantification, GADTs, OverloadedStrings #-}+--------------------------------------------------------------------------------+{-# LANGUAGE BangPatterns              #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE OverloadedStrings         #-} module Text.Digestive.Field     ( Field (..)     , SomeField (..)@@ -6,23 +10,31 @@     , fieldMapView     ) where -import Control.Arrow (second)-import Data.Maybe (fromMaybe, listToMaybe) -import Data.Text (Text)-import qualified Data.Text as T+--------------------------------------------------------------------------------+import           Control.Arrow        (second)+import           Data.Maybe           (fromMaybe, listToMaybe)+import           Data.Text            (Text) -import Text.Digestive.Types-import Text.Digestive.Util +--------------------------------------------------------------------------------+import           Text.Digestive.Types+++-------------------------------------------------------------------------------- -- | A single input field. This usually maps to a single HTML @<input>@ element. data Field v a where     Singleton :: a -> Field v a     Text      :: Text -> Field v Text-    Choice    :: [(a, v)] -> Int -> Field v (a, Int)+    -- | 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, (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@@ -30,8 +42,12 @@     show (Bool b)      = "Bool " ++ show b     show (File)        = "File" ++-------------------------------------------------------------------------------- data SomeField v = forall a. SomeField (Field v a) ++-------------------------------------------------------------------------------- evalField :: Method       -- ^ Get/Post           -> [FormInput]  -- ^ Given input           -> Field v a    -- ^ Field@@ -40,21 +56,34 @@ evalField _    (TextInput x : _) (Text _)      = x evalField _    _                 (Text x)      = x evalField _    (TextInput x : _) (Choice ls y) =-    fromMaybe (fst (ls !! y), y) $ do-        -- Expects input in the form of @foo.bar.2@-        t <- listToMaybe $ reverse $ toPath x-        i <- readMaybe $ T.unpack t-        return $ (fst (ls !! i), i)-evalField _    _                 (Choice ls x) = (fst (ls !! x), x)+    fromMaybe (fst (snd (ls !! y)), y) $ do+        -- Expects input in the form of "foo.bar.2". This is not needed for+        -- <select> fields, but we need it for labels for radio buttons.+        t      <- listToMaybe $ reverse $ toPath x+        (c, i) <- lookupIdx t ls+        return (fst c, i)+evalField _    _                 (Choice ls x) = (fst (snd (ls !! x)), x) evalField Get  _                 (Bool x)      = x evalField Post (TextInput x : _) (Bool _)      = x == "on" evalField Post _                 (Bool _)      = False evalField Post (FileInput x : _) File          = Just x evalField _    _                 File          = Nothing ++-------------------------------------------------------------------------------- fieldMapView :: (v -> w) -> Field v a -> Field w a fieldMapView _ (Singleton x)   = Singleton x fieldMapView _ (Text x)        = Text x-fieldMapView f (Choice xs i)   = Choice (map (second f) xs) i+fieldMapView f (Choice xs i)   = Choice (map (second (second f)) xs) i fieldMapView _ (Bool x)        = Bool x fieldMapView _ File            = File+++--------------------------------------------------------------------------------+lookupIdx :: Eq k => k -> [(k, v)] -> Maybe (v, Int)+lookupIdx key = go 0+  where+    go _  []        = Nothing+    go !i ((k, v) : xs)+        | key == k  = Just (v, i)+        | otherwise = go (i + 1) xs
src/Text/Digestive/Form.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE ExistentialQuantification, GADTs, OverloadedStrings, Rank2Types #-}+--------------------------------------------------------------------------------+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE Rank2Types                #-} module Text.Digestive.Form     ( Formlet     , Form@@ -11,6 +15,8 @@     , stringRead     , choice     , choice'+    , choiceWith+    , choiceWith'     , bool     , file @@ -29,44 +35,84 @@     , monadic     ) where -import Control.Monad (liftM)-import Data.List (findIndex)-import Data.Maybe (fromMaybe) -import Data.Text (Text)-import qualified Data.Text as T+--------------------------------------------------------------------------------+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.Field-import Text.Digestive.Form.Internal-import Text.Digestive.Types-import Text.Digestive.Util +--------------------------------------------------------------------------------+import           Text.Digestive.Field+import           Text.Digestive.Form.Internal+import           Text.Digestive.Ref+import           Text.Digestive.Types+import           Text.Digestive.Util+++-------------------------------------------------------------------------------- type Formlet m v a = Maybe a -> Form m v a ++-------------------------------------------------------------------------------- text :: Formlet v m Text text def = Pure Nothing $ 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 = choice' items $-    maybe Nothing (\d -> findIndex ((== d) . fst) items) def+choice items def = choiceWith (zip makeRefs items) def ++-------------------------------------------------------------------------------- -- | Sometimes there is no good 'Eq' instance for 'choice'. In this case, you -- can use this function, which takes an index in the list as default. choice' :: Monad m => [(a, v)] -> Maybe Int -> Form v m a-choice' items def = fmap fst $ Pure Nothing $ Choice items $ fromMaybe 0 def+choice' items def = choiceWith' (zip makeRefs items) def ++--------------------------------------------------------------------------------+-- | Allows you to assign your own values: these values will be used in the+-- resulting HTML instead of the default @[0 ..]@. This fixes some race+-- conditions that might otherwise appear, e.g. if new choice items are added to+-- some database while a user views and submits the form...+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)+++--------------------------------------------------------------------------------+-- | A version of 'choiceWith' for when you have no good 'Eq' instance.+choiceWith' :: Monad m => [(Text, (a, v))] -> Maybe Int -> Form v m a+choiceWith' items def = fmap fst $ Pure Nothing $ Choice items def'+  where+    def' = fromMaybe 0 def+++-------------------------------------------------------------------------------- bool :: Formlet v m Bool bool = Pure Nothing . Bool . fromMaybe False ++-------------------------------------------------------------------------------- file :: Form v m (Maybe FilePath) file = Pure Nothing File ++-------------------------------------------------------------------------------- -- | Validate the results of a form with a simple predicate -- -- Example:@@ -79,6 +125,8 @@       -> Form v m a   -- ^ Resulting form check err = checkM err . (return .) ++-------------------------------------------------------------------------------- -- | Version of 'check' which allows monadic validations checkM :: Monad m => v -> (a -> m Bool) -> Form v m a -> Form v m a checkM err predicate form = validateM f form@@ -87,6 +135,8 @@         r <- predicate x         return $ if r then return x else Error err ++-------------------------------------------------------------------------------- -- | This is an extension of 'check' that can be used to apply transformations -- that optionally fail --@@ -102,10 +152,14 @@ validate :: Monad m => (a -> Result v b) -> Form v m a -> Form v m b validate = validateM . (return .) ++-------------------------------------------------------------------------------- -- | Version of 'validate' which allows monadic validations 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@@ -113,9 +167,13 @@         | 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@@ -123,5 +181,7 @@     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
src/Text/Digestive/Form/Encoding.hs view
@@ -1,3 +1,4 @@+-------------------------------------------------------------------------------- {-# LANGUAGE GADTs #-} module Text.Digestive.Form.Encoding     ( FormEncType (..)@@ -5,23 +6,33 @@     , formTreeEncType     ) where -import Control.Monad (liftM)-import Control.Monad.Identity (Identity)-import Data.Maybe (mapMaybe)-import Data.Monoid (Monoid (..), mconcat) -import Text.Digestive.Field-import Text.Digestive.Form.Internal+--------------------------------------------------------------------------------+import           Control.Monad                (liftM)+import           Control.Monad.Identity       (Identity)+import           Data.Maybe                   (mapMaybe)+import           Data.Monoid                  (Monoid(..), mconcat) ++--------------------------------------------------------------------------------+import           Text.Digestive.Field+import           Text.Digestive.Form.Internal+++-------------------------------------------------------------------------------- data FormEncType     = UrlEncoded     | MultiPart     deriving (Eq) ++-------------------------------------------------------------------------------- instance Show FormEncType where     show UrlEncoded = "application/x-www-form-urlencoded"     show MultiPart  = "multipart/form-data" ++-------------------------------------------------------------------------------- -- Monoid instance for encoding types: prefer UrlEncoded, but fallback to -- MultiPart when needed instance Monoid FormEncType where@@ -29,19 +40,27 @@     mappend UrlEncoded x = x     mappend MultiPart  _ = MultiPart ++-------------------------------------------------------------------------------- fieldEncType :: Field v a -> FormEncType fieldEncType File = MultiPart fieldEncType _    = UrlEncoded ++-------------------------------------------------------------------------------- fieldList :: FormTree Identity v m a -> [SomeField v] fieldList = mapMaybe toField' . fieldList' . SomeForm   where     fieldList' (SomeForm f) = SomeForm f : concatMap fieldList' (children f)     toField' (SomeForm f)   = toField f ++-------------------------------------------------------------------------------- formEncType :: Monad m => Form v m a -> m FormEncType formEncType form = liftM formTreeEncType $ toFormTree form ++-------------------------------------------------------------------------------- formTreeEncType :: FormTree Identity v m a -> FormEncType formTreeEncType = mconcat . map fieldEncType' . fieldList   where
src/Text/Digestive/Form/Internal.hs view
@@ -1,7 +1,11 @@+-------------------------------------------------------------------------------- -- | This module mostly meant for internal usage, and might change between minor -- releases.-{-# LANGUAGE ExistentialQuantification, FlexibleInstances,-        GADTs, OverloadedStrings, Rank2Types #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE Rank2Types                #-} module Text.Digestive.Form.Internal     ( Form     , FormTree (..)@@ -20,18 +24,26 @@     , formMapView     ) where -import Control.Applicative (Applicative (..))-import Control.Monad (liftM, liftM2, (>=>))-import Control.Monad.Identity (Identity (..))-import Data.Maybe (maybeToList)-import Data.Monoid (Monoid) -import Data.Text (Text)-import qualified Data.Text as T+--------------------------------------------------------------------------------+import           Control.Applicative    (Applicative(..))+import           Control.Monad          (liftM, liftM2, (>=>))+import           Control.Monad.Identity (Identity(..))+import           Data.Maybe             (maybeToList)+import           Data.Monoid            (Monoid) -import Text.Digestive.Types-import Text.Digestive.Field +--------------------------------------------------------------------------------+import           Data.Text              (Text)+import qualified Data.Text              as T+++--------------------------------------------------------------------------------+import           Text.Digestive.Field+import           Text.Digestive.Types+++-------------------------------------------------------------------------------- -- | Base type for a form. -- -- The three type parameters are:@@ -48,6 +60,8 @@ -- type Form v m a = FormTree m v m a ++-------------------------------------------------------------------------------- data FormTree t v m a where     Pure    :: Ref -> Field v a -> FormTree t v m a     App     :: Ref@@ -59,23 +73,37 @@      Monadic :: t (FormTree t v m a) -> FormTree t v m a ++-------------------------------------------------------------------------------- instance Monad m => Functor (FormTree t v m) where     fmap = transform . (return .) . (return .) ++-------------------------------------------------------------------------------- instance (Monad m, Monoid v) => Applicative (FormTree t v m) where     pure x  = Pure Nothing (Singleton x)     x <*> y = App Nothing x y ++-------------------------------------------------------------------------------- instance Show (FormTree Identity v m a) where     show = unlines . showForm ++-------------------------------------------------------------------------------- data SomeForm v m = forall a. SomeForm (FormTree Identity v m a) ++-------------------------------------------------------------------------------- instance Show (SomeForm v m) where     show (SomeForm f) = show f ++-------------------------------------------------------------------------------- type Ref = Maybe Text ++-------------------------------------------------------------------------------- showForm :: FormTree Identity v m a -> [String] showForm form = case form of     (Pure r x)  -> ["Pure (" ++ show r ++ ") (" ++ show x ++ ")"]@@ -89,43 +117,59 @@   where     indent = ("  " ++) ++-------------------------------------------------------------------------------- transform :: Monad m           => (a -> m (Result v b)) -> FormTree t v m a -> FormTree t v m b transform f (Map g x) = flip Map x $ \y -> bindResult (g y) f transform f x         = Map f x ++-------------------------------------------------------------------------------- monadic :: m (Form v m a) -> Form v m a monadic = Monadic ++-------------------------------------------------------------------------------- toFormTree :: Monad m => Form v m a -> m (FormTree Identity v m a) toFormTree (Pure r x)  = return $ Pure r x toFormTree (App r x y) = liftM2 (App r) (toFormTree x) (toFormTree y) toFormTree (Map f x)   = liftM (Map f) (toFormTree x) toFormTree (Monadic x) = x >>= toFormTree >>= return . Monadic . Identity ++-------------------------------------------------------------------------------- children :: FormTree Identity v m a -> [SomeForm v m] children (Pure _ _)    = [] children (App _ x y)   = [SomeForm x, SomeForm y] children (Map _ x)     = children x children (Monadic x)   = children $ runIdentity x ++-------------------------------------------------------------------------------- setRef :: Monad t => Ref -> FormTree t v m a -> FormTree t v m a setRef r (Pure _ x)  = Pure r x setRef r (App _ x y) = App r x y setRef r (Map f x)   = Map f (setRef r x) setRef r (Monadic x) = Monadic $ liftM (setRef r) x ++-------------------------------------------------------------------------------- -- | Operator to set a name for a subform. (.:) :: Monad m => Text -> Form v m a -> Form v m a (.:) = setRef . Just infixr 5 .: ++-------------------------------------------------------------------------------- getRef :: FormTree Identity v m a -> Ref getRef (Pure r _)  = r getRef (App r _ _) = r getRef (Map _ x)   = getRef x getRef (Monadic x) = getRef $ runIdentity x ++-------------------------------------------------------------------------------- lookupForm :: Path -> FormTree Identity v m a -> [SomeForm v m] lookupForm path = go path . SomeForm   where@@ -139,12 +183,16 @@             | otherwise          -> []         Nothing                  -> children form >>= go (r : rs) ++-------------------------------------------------------------------------------- toField :: FormTree Identity v m a -> Maybe (SomeField v) toField (Pure _ x)  = Just (SomeField x) toField (Map _ x)   = toField x toField (Monadic x) = toField (runIdentity x) toField _           = Nothing ++-------------------------------------------------------------------------------- queryField :: Path            -> FormTree Identity v m a            -> (forall b. Field v b -> c)@@ -157,10 +205,14 @@   where     ref = T.unpack $ fromPath path ++-------------------------------------------------------------------------------- ann :: Path -> Result v a -> Result [(Path, v)] a ann _    (Success x) = Success x ann path (Error x)   = Error [(path, x)] ++-------------------------------------------------------------------------------- eval :: Monad m => Method -> Env m -> FormTree Identity v m a      -> m (Result [(Path, v)] a, [(Path, FormInput)]) eval = eval' []@@ -195,6 +247,8 @@   where     path = context ++ maybeToList (getRef form) ++-------------------------------------------------------------------------------- formMapView :: Monad m             => (v -> w) -> FormTree Identity v m a -> FormTree Identity w m a formMapView f (Pure r x)  = Pure r $ (fieldMapView f) x@@ -202,6 +256,8 @@ formMapView f (Map g x)   = Map (g >=> return . resultMapError f) (formMapView f x) formMapView f (Monadic x) = formMapView f $ runIdentity x ++-------------------------------------------------------------------------------- -- | Utility: bind for 'Result' inside another monad bindResult :: Monad m            => m (Result v a) -> (a -> m (Result v b)) -> m (Result v b)
src/Text/Digestive/Ref.hs view
@@ -28,4 +28,4 @@ -------------------------------------------------------------------------------- -- | Create an infinite list of refs. makeRefs :: [Text]-makeRefs = ["df-" `T.append` T.pack (show i) | i <- [0 :: Int ..]]+makeRefs = map (T.pack . show) [0 :: Int ..]
src/Text/Digestive/Types.hs view
@@ -1,3 +1,4 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Text.Digestive.Types     ( Result (..)@@ -10,12 +11,18 @@     , Env     ) where -import Control.Applicative (Applicative (..))-import Data.Monoid (Monoid, mappend) -import Data.Text (Text)-import qualified Data.Text as T+--------------------------------------------------------------------------------+import           Control.Applicative (Applicative(..))+import           Data.Monoid         (Monoid, mappend) ++--------------------------------------------------------------------------------+import           Data.Text           (Text)+import qualified Data.Text           as T+++-------------------------------------------------------------------------------- -- | A mostly internally used type for representing Success/Error, with a -- special applicative instance data Result v a@@ -23,10 +30,14 @@     | Error v     deriving (Show) ++-------------------------------------------------------------------------------- instance Functor (Result v) where     fmap f (Success x) = Success (f x)     fmap _ (Error x)   = Error x ++-------------------------------------------------------------------------------- instance Monoid v => Applicative (Result v) where     pure x                  = Success x     Error x   <*> Error y   = Error $ mappend x y@@ -34,37 +45,53 @@     Success _ <*> Error y   = Error y     Success x <*> Success y = Success (x y) ++-------------------------------------------------------------------------------- instance Monad (Result v) where     return x          = Success x     (Error x)   >>= _ = Error x     (Success x) >>= f = f x ++-------------------------------------------------------------------------------- -- | Map over the error type of a 'Result' resultMapError :: (v -> w) -> Result v a -> Result w a resultMapError f (Error x)   = Error (f x) resultMapError _ (Success x) = Success x ++-------------------------------------------------------------------------------- -- | Describes a path to a subform type Path = [Text] ++-------------------------------------------------------------------------------- -- | Create a 'Path' from some text toPath :: Text -> Path toPath = filter (not . T.null) . T.split (== '.') ++-------------------------------------------------------------------------------- -- | Serialize a 'Path' to 'Text' fromPath :: Path -> Text fromPath = T.intercalate "." ++-------------------------------------------------------------------------------- -- | The HTTP methods data Method = Get | Post     deriving (Eq, Ord, Show) ++-------------------------------------------------------------------------------- -- | The different input types sent by the browser data FormInput     = TextInput Text     | FileInput FilePath     deriving (Show) ++-------------------------------------------------------------------------------- -- | An environment (e.g. a server) from which we can read input parameters. A -- single key might be associated with multiple text values (multi-select). type Env m = Path -> m [FormInput]
src/Text/Digestive/Util.hs view
@@ -1,7 +1,10 @@+-------------------------------------------------------------------------------- module Text.Digestive.Util     ( readMaybe     ) where ++-------------------------------------------------------------------------------- -- | 'read' in the 'Maybe' monad. readMaybe :: Read a => String -> Maybe a readMaybe str = case readsPrec 1 str of
src/Text/Digestive/View.hs view
@@ -1,5 +1,8 @@-{-# LANGUAGE ExistentialQuantification, GADTs, OverloadedStrings,-        ScopedTypeVariables #-}+--------------------------------------------------------------------------------+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE ScopedTypeVariables       #-} module Text.Digestive.View     ( View (..) @@ -30,18 +33,23 @@     , childErrors     ) where -import Control.Arrow (second)-import Control.Monad.Identity (Identity)-import Data.List (isPrefixOf) -import Data.Text (Text)-import qualified Data.Text as T+--------------------------------------------------------------------------------+import           Control.Arrow                (second)+import           Control.Monad.Identity       (Identity)+import           Data.List                    (isPrefixOf)+import           Data.Text                    (Text)+import qualified Data.Text                    as T -import Text.Digestive.Field-import Text.Digestive.Form.Encoding-import Text.Digestive.Form.Internal-import Text.Digestive.Types +--------------------------------------------------------------------------------+import           Text.Digestive.Field+import           Text.Digestive.Form.Encoding+import           Text.Digestive.Form.Internal+import           Text.Digestive.Types+++-------------------------------------------------------------------------------- data View v = forall a m. Monad m => View     { viewName    :: Text     , viewContext :: Path@@ -51,20 +59,28 @@     , viewMethod  :: Method     } ++-------------------------------------------------------------------------------- instance Functor View where     fmap f (View name ctx form input errs method) = View         name ctx (formMapView f form) input (map (second f) errs) method ++-------------------------------------------------------------------------------- instance Show v => Show (View v) where     show (View name ctx form input errs method) =         "View " ++ show name ++ " " ++ show ctx ++ " " ++ show form ++ " " ++         show input ++ " " ++ show errs ++ " " ++ show method ++-------------------------------------------------------------------------------- getForm :: Monad m => Text -> Form v m a -> m (View v) getForm name form = do     form' <- toFormTree form     return $ View name [] form' [] [] Get ++-------------------------------------------------------------------------------- postForm :: Monad m => Text -> Form v m a -> Env m -> m (View v, Maybe a) postForm name form env = do     form' <- toFormTree form@@ -74,12 +90,16 @@   where     env' = env . (name :) ++-------------------------------------------------------------------------------- subView :: Text -> View v -> View v subView ref (View name ctx form input errs method) =     View name (ctx ++ path) form input errs method   where     path = toPath ref ++-------------------------------------------------------------------------------- -- | Returns all immediate subviews of a view subViews :: View v -> [View v] subViews view@(View _ _ form _ _ _) =@@ -89,26 +109,38 @@         Nothing -> [r | c <- children f, r <- go c]         Just r  -> [r] ++-------------------------------------------------------------------------------- -- | Determine an absolute 'Path' for a field in the form absolutePath :: Text -> View v -> Path absolutePath ref view@(View name _ _ _ _ _) = name : viewPath ref view ++-------------------------------------------------------------------------------- -- | Determine an absolute path and call 'fromPath' on it. Useful if you're -- writing a view library... absoluteRef :: Text -> View v -> Text absoluteRef ref view = fromPath $ absolutePath ref view ++-------------------------------------------------------------------------------- -- | Internal version of 'absolutePath' which does not take the form name into -- account viewPath :: Text -> View v -> Path viewPath ref (View _ ctx _ _ _ _) = ctx ++ toPath ref ++-------------------------------------------------------------------------------- viewEncType :: View v -> FormEncType viewEncType (View _ _ form _ _ _) = formTreeEncType form ++-------------------------------------------------------------------------------- lookupInput :: Path -> [(Path, FormInput)] -> [FormInput] lookupInput path = map snd . filter ((== path) . fst) ++-------------------------------------------------------------------------------- fieldInputText :: forall v. Text -> View v -> Text fieldInputText ref view@(View _ _ form input _ method) =     queryField path form eval'@@ -122,21 +154,26 @@         f      -> error $ T.unpack ref ++ ": expected (Text _), " ++             "but got: (" ++ show f ++ ")" -fieldInputChoice :: forall v. Text -> View v -> ([v], Int)++--------------------------------------------------------------------------------+-- | Returns a list of (identifier, view, selected?)+fieldInputChoice :: forall v. Text -> View v -> [(Text, v, Bool)] fieldInputChoice ref view@(View _ _ form input _ method) =     queryField path form eval'   where     path       = viewPath ref view     givenInput = lookupInput path input -    eval' :: Field v b -> ([v], Int)+    eval' :: Field v b -> [(Text, v, Bool)]     eval' field = case field of-        Choice xs i ->-            let idx = snd $ evalField method givenInput (Choice xs i)-            in (map snd xs, idx)+        Choice xs didx ->+            let idx = snd $ evalField method givenInput (Choice xs didx)+            in map (\(i, (k, (_, v))) -> (k, v, i == idx)) $ zip [0 ..] xs         f           -> error $ T.unpack ref ++ ": expected (Choice _ _), " ++             "but got: (" ++ show f ++ ")" ++-------------------------------------------------------------------------------- fieldInputBool :: forall v. Text -> View v -> Bool fieldInputBool ref view@(View _ _ form input _ method) =     queryField path form eval'@@ -150,6 +187,8 @@         f      -> error $ T.unpack ref ++ ": expected (Bool _), " ++             "but got: (" ++ show f ++ ")" ++-------------------------------------------------------------------------------- fieldInputFile :: forall v. Text -> View v -> Maybe FilePath fieldInputFile ref view@(View _ _ form input _ method) =     queryField path form eval'@@ -163,10 +202,14 @@         f    -> error $ T.unpack ref ++ ": expected (File), " ++             "but got: (" ++ show f ++ ")" ++-------------------------------------------------------------------------------- errors :: Text -> View v -> [v] errors ref view = map snd $ filter ((== viewPath ref view) . fst) $     viewErrors view ++-------------------------------------------------------------------------------- childErrors :: Text -> View v -> [v] childErrors ref view = map snd $     filter ((viewPath ref view `isPrefixOf`) . fst) $ viewErrors view