Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fixed a nasty checkM bug

  • Loading branch information...
commit cbb87f0ab48b64b84172d26c927b7f26fcbd72ab 1 parent 8dccab7
authored August 30, 2009
29  Text/Formlets.hs
@@ -114,14 +114,31 @@ check (Form frm) f = Form $ fmap checker frm
114 114
 checkM :: (Monad m) => Form xml m a -> (a -> m (Failing b)) -> Form xml m b
115 115
 checkM (Form frm) f = Form $ \env -> checker f (frm env)
116 116
  where checker f frm = do currentState <- get
117  
-                          frm'         <- frm
118  
-                          return $ fmapFst3 (transform f. liftM (flip evalState currentState)) frm'
119  
-       transform f source = source >>= \x -> case x of 
120  
-                              FR.Success x      -> liftM return (convert f x)
121  
-                              FR.NotAvailable x -> return . return $ FR.NotAvailable x
122  
-                              FR.Failure x      -> return . return $ FR.Failure x
  117
+                          (validator, xml, ct) <- frm
  118
+                          let validator' = transform f validator currentState
  119
+                          return (validator', xml, ct)
  120
+                          --return x
  121
+
  122
+       transform :: Monad m => (a -> m (Failing b)) -> m (Validator a) -> FormState -> m (Validator b)
  123
+       transform f source st = x' (x f) source
  124
+        where x   :: Monad m => (a -> m (Failing b)) -> a -> m (Validator b)
  125
+              x f = fmap (liftM (return . FR.fromE)) f
  126
+              x'  :: Monad m => (a -> m (Validator b)) -> m (Validator a) -> m (Validator b)
  127
+              x' f a = do a' <- a
  128
+                          let (a'', st') = runState a' st
  129
+                          val <- combine f a''
  130
+                          return (changeState st' val)
  131
+              changeState :: st -> State st a -> State st a
  132
+              changeState st' mComp = do result <- mComp
  133
+                                         put st'
  134
+                                         return result
123 135
        convert :: Monad m => (a -> m (Failing b)) -> (a -> m (FR.FormResult b))
124 136
        convert f = fmap (liftM FR.fromE) f
  137
+       combine :: Monad m => (a -> m (Validator b)) -> FR.FormResult a -> m (Validator b)
  138
+       combine f x = case x of
  139
+         (FR.Success x)      -> f x
  140
+         (FR.NotAvailable x) -> return . return $ FR.NotAvailable x
  141
+         (FR.Failure x)      -> return . return $ FR.Failure x
125 142
 
126 143
 instance (Functor m, Monad m) => Functor (Form xml m) where
127 144
   fmap f (Form a) = Form $ \env -> (fmap . fmapFst3 . liftM . liftM . fmap) f (a env)
2  formlets.cabal
@@ -16,7 +16,7 @@ Author:          Jeremy Yallop / Chris Eidhof
16 16
 Homepage:        http://github.com/chriseidhof/formlets/tree/master
17 17
 Maintainer:      Chris Eidhof <ce+hackage@tupil.com>
18 18
 Build-Type:      Simple
19  
-Cabal-Version: >= 1.2
  19
+Cabal-Version: >= 1.6
20 20
 Extra-Source-Files: README
21 21
 
22 22
 Library

0 notes on commit cbb87f0

Please sign in to comment.
Something went wrong with that request. Please try again.