digestive-functors 0.1.0.2 → 0.2.0.0

raw patch · 6 files changed

+85/−69 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• digestive-functors.cabal +32/−27
• src/Text/Digestive/Cli.hs +6/−6
• src/Text/Digestive/Common.hs +4/−4
• src/Text/Digestive/Forms.hs +13/−6
• src/Text/Digestive/Transform.hs +13/−13
• src/Text/Digestive/Types.hs +17/−13

@@ -1,34 +1,39 @@-Name:                digestive-functors-Version:             0.1.0.2-Synopsis:            A general way to consume input using applicative functors+Name:     digestive-functors+Version:  0.2.0.0+Synopsis: A general way to consume input using applicative functors+ Description:         Digestive functors is a library to generate and process     HTML forms.  You can find an introduction here:      <http://github.com/jaspervdj/digestive-functors/blob/master/digestive-functors/README.lhs> -Homepage:            http://github.com/jaspervdj/digestive-functors-License:             BSD3-License-file:        LICENSE-Author:              Jasper Van der Jeugt-Maintainer:          jaspervdj@gmail.com-Category:            Web-Build-type:          Simple-Cabal-version:       >=1.6-+Homepage:      http://github.com/jaspervdj/digestive-functors+License:       BSD3+License-file:  LICENSE+Author:        Jasper Van der Jeugt+Maintainer:    jaspervdj@gmail.com+Category:      Web+Build-type:    Simple+Cabal-version: >= 1.6  Library-  Hs-source-dirs:      src-  Exposed-modules:     Text.Digestive.Validate,-                       Text.Digestive.Common,-                       Text.Digestive.Types,-                       Text.Digestive.Transform,-                       Text.Digestive.Forms,-                       Text.Digestive.Forms.Html,-                       Text.Digestive.Result,-                       Text.Digestive.Cli,-                       Text.Digestive-  Build-depends:       base >= 4 && < 5,-                       mtl >= 2.0.0.0 && < 3,-                       containers >= 0.3,-                       bytestring >= 0.9,-                       text >= 0.10+  Hs-source-dirs: src+  Ghc-options:    -Wall++  Exposed-modules:     +    Text.Digestive.Validate,+    Text.Digestive.Common,+    Text.Digestive.Types,+    Text.Digestive.Transform,+    Text.Digestive.Forms,+    Text.Digestive.Forms.Html,+    Text.Digestive.Result,+    Text.Digestive.Cli,+    Text.Digestive++  Build-depends:+    base       >= 4       && < 5,+    bytestring >= 0.9,+    containers >= 0.3,+    mtl        >= 2.0.0.0 && < 3,+    text       >= 0.10

@@ -10,8 +10,8 @@     , runPrompt     ) where -import Data.Monoid (Monoid, mappend, mempty) import Control.Applicative ((<$>))+import Data.Monoid (Monoid, mappend, mempty)  import Text.Digestive.Result import Text.Digestive.Types@@ -69,7 +69,7 @@         result = case inp of             Just x  -> Ok x             Nothing -> Error [(range, "No input")]-    return (View v, result)+    return (View v, return result)  -- | Convert a prompt for a single item into a prompt for multiple items --@@ -78,7 +78,7 @@            -> Prompt [a] -- ^ Resulting multiple input prompt promptList descr prmpt = Form $ do     id'     <- getFormId-    (v, r1) <- unForm $ inputList numPrompt (const prmpt) Nothing+    (v, rs) <- unForm $ inputList numPrompt (const prmpt) Nothing     range   <- getFormRange     -- The monoid for the view will look like this: [vstart, v, vend]     -- 'vstart' and 'vend' delimit the beginning and end of the inputs that@@ -93,11 +93,11 @@           where             item = FieldItemMultiStart id' descr $ retainErrors range errs         vend _ = PromptView [FieldItemMultiEnd]-    return (View vstart `mappend` v `mappend` View vend, r1)+    return (View vstart `mappend` v `mappend` View vend, rs)   where     numPrompt _ = Form $ do-                    inp <- getFormInput-                    return (mempty, readN inp)+        inp <- getFormInput+        return (mempty, return (readN inp))     readN (Just x) = Ok (read x)     readN Nothing = Error [] 

@@ -22,25 +22,25 @@     id' <- getFormId     let view' = toView isInput inp defaultInput         result' = toResult inp-    return (View (const $ createView id' view'), result')+    return (View (const $ createView id' view'), return result')  label :: Monad m       => (FormId -> v)       -> Form m i e v () label f = Form $ do     id' <- getFormId-    return (View (const $ f id'), Ok ())+    return (View (const $ f id'), return (Ok ()))  errors :: Monad m        => ([e] -> v)        -> Form m i e v () errors f = Form $ do     range <- getFormRange-    return (View (f . retainErrors range), Ok ())+    return (View (f . retainErrors range), return (Ok ()))  childErrors :: Monad m             => ([e] -> v)             -> Form m i e v () childErrors f = Form $ do     range <- getFormRange-    return (View (f . retainChildErrors range), Ok ())+    return (View (f . retainChildErrors range), return (Ok ()))

@@ -13,8 +13,9 @@     ) where  import Control.Applicative ((<$>))-import Control.Monad (mplus)+import Control.Monad (liftM, mplus) import Control.Monad.State (put, get)+import Control.Monad.Trans (lift) import Data.Monoid (Monoid, mappend, mconcat) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) @@ -105,7 +106,7 @@         inp = fromMaybe defaultInput $ lookup inputKey $ zip (ids id') choices         -- Apply the toView' function to all choices         view' = mconcat $ zipWith (toView' id' inp) (ids id') choices-    return (View (const view'), Ok inp)+    return (View (const view'), return (Ok inp))   where     ids id' = map (((show id' ++ "-") ++) . show) [1 .. length choices]     toView' id' inp key x = toView id' key (inp == x) x@@ -130,7 +131,7 @@                else defaults         -- Apply the toView' function to all choices         view' = mconcat $ zipWith (toView' id' inps) (ids id') choices-    return (View (const view'), Ok inps)+    return (View (const view'), return (Ok inps))   where     ids id' = map (((show id' ++ "-") ++) . show) [1 .. length choices]     toView' id' inps key x = toView id' key (x `elem` inps) x@@ -173,9 +174,13 @@           -> Formlet m i e v [a]  -- ^ The dynamic list formlet inputList countField single defaults = Form $ do     let defCount = maybe 1 length defaults-    (countView,countRes) <- unForm $ countField (Just defCount)+    (countView, mcountRes) <- unForm $ countField (Just defCount)++    -- We need to evaluate the count+    countRes <- lift $ lift mcountRes     let countFromForm = getResult countRes-        count = fromMaybe defCount countFromForm+        count = fromMaybe defCount (getResult countRes)+         fs = replicate count single         forms = zipWith ($) fs $ maybe (maybe [Nothing] (map Just) defaults)                                        (flip replicate Nothing)@@ -183,8 +188,10 @@     down 2     list <- mapM (incAfter . unForm) forms     up 2+     return ( countView `mappend` (mconcat $ map fst list)-           , combineResults [] [] $ map snd list)+           , liftM (combineResults [] []) . sequence $ map snd list+           )   where     incAfter k = do         res <- k

@@ -12,7 +12,6 @@  import Prelude hiding ((.), id) -import Control.Monad.Trans (lift) import Control.Monad ((<=<)) import Control.Category (Category, (.), id) import Control.Arrow (Arrow, arr, first)@@ -40,19 +39,20 @@ -- transform :: Monad m => Form m i e v a -> Transformer m e a b -> Form m i e v b transform form transformer = Form $ do-    (v1, r1) <- unForm form+    (v, r) <- unForm form     range <- getFormRange-    case r1 of-        -- We already have an error, cannot continue-        Error e -> return (v1, Error e)-        -- Apply transformer-        Ok x -> do-            r2 <- lift $ lift $ unTransformer transformer x-            return $ case r2 of-                -- Attach the range information to the errors-                Left e -> (v1, Error $ map ((,) range) e)-                -- All fine-                Right y -> (v1, Ok y)+    return (v, r >>= transform' range)+  where+    -- We already have an error, cannot continue+    transform' _     (Error e) = return (Error e)+    -- Apply transformer+    transform' range (Ok x)    = do+        ex <- unTransformer transformer x+        return $ case ex of+            -- Attach the range information to the errors+            Left e   -> Error $ map ((,) range) e+            -- All fine+            Right x' -> Ok x'  -- | Apply a transformer to a formlet --

@@ -26,7 +26,7 @@  import Data.Monoid (Monoid (..)) import Control.Arrow (first)-import Control.Monad (liftM2, mplus)+import Control.Monad (liftM, liftM2, mplus) import Control.Monad.Reader (ReaderT, ask, runReaderT) import Control.Monad.State (StateT, get, put, evalStateT) import Control.Monad.Trans (lift)@@ -101,7 +101,9 @@  -- | A form represents a number of composed fields ---newtype Form m i e v a = Form {unForm :: FormState m i (View e v, Result e a)}+newtype Form m i e v a = Form+    { unForm :: FormState m i (View e v, m (Result e a))+    }  -- | A function for generating forms with an optional default value. --@@ -110,10 +112,10 @@ instance Monad m => Functor (Form m i e v) where     fmap f form = Form $ do         (view', result) <- unForm form-        return (view', fmap f result)+        return (view', liftM (fmap f) result)  instance (Monad m, Monoid v) => Applicative (Form m i e v) where-    pure x = Form $ return (mempty, return x)+    pure x = Form $ return (mempty, return (return x))     f1 <*> f2 = Form $ do         -- Assuming f1 already has a valid ID         ((v1,r1), (v2,r2)) <- bracketState $ do@@ -121,7 +123,7 @@             incState             res2 <- unForm f2             return (res1, res2)-        return (v1 `mappend` v2, r1 <*> r2)+        return (v1 `mappend` v2, liftM2 (<*>) r1 r2)  bracketState :: Monad m => FormState m i a -> FormState m i a bracketState k = do@@ -141,7 +143,7 @@ view :: Monad m      => v                -- ^ View to insert      -> Form m i e v ()  -- ^ Resulting form-view view' = Form $ return (View (const view'), Ok ())+view view' = Form $ return (View (const view'), return (Ok ()))  -- | Append a unit form to the left. This is useful for adding labels or error -- fields@@ -183,10 +185,10 @@ -- | Run a form -- runForm :: Monad m-        => Form m i e v a            -- ^ Form to run-        -> String                    -- ^ Identifier for the form-        -> Environment m i           -- ^ Input environment-        -> m (View e v, Result e a)  -- ^ Result+        => Form m i e v a                -- ^ Form to run+        -> String                        -- ^ Identifier for the form+        -> Environment m i               -- ^ Input environment+        -> m (View e v, m (Result e a))  -- ^ Result runForm form id' env = evalStateT (runReaderT (unForm form) env) $     unitRange $ zeroId id' @@ -198,9 +200,11 @@            -> Environment m i  -- ^ Input environment            -> m (Either v a)   -- ^ Result eitherForm form id' env = do-    (view', result) <- runForm form id' env-    return $ case result of Error e  -> Left $ unView view' e-                            Ok x     -> Right x+    (view', mresult) <- runForm form id' env+    result <- mresult+    return $ case result of+        Error e  -> Left $ unView view' e+        Ok x     -> Right x  -- | Just evaluate the form to a view. This usually maps to a GET request in the -- browser.