git.iko.soy/typeable/validationt
on d5f24a9 help sign in
a018271
swap
0 ahead, 39 behind
.travis.yml+92−26
since splitsnapshots
unifiedsplit
@@ -1,38 +1,104 @@
1−sudo: true
1+# This Travis job script has been generated by a script via
2+#
3+# runghc make_travis_yml_2.hs 'validationt.cabal'
4+#
5+# For more information, see https://github.com/hvr/multi-ghc-travis
6+#
2−language: haskell
7+language: c
8+sudo: false
3
9
4git:
10git:
5− depth: 5
11+ submodules: false # whether to recursively clone submodules
6
12
7cache:
13cache:
8 directories:
14 directories:
15+ - $HOME/.cabal/packages
9− - "$HOME/.cabal/store"
16+ - $HOME/.cabal/store
10− - "$HOME/.stack"
11− - "$TRAVIS_BUILD_DIR/.stack-work"
12
17
13−jobs:
18+before_cache:
19+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
20+ # remove files that are regenerated by 'cabal update'
21+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
22+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
24+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
26+
27+ - rm -rfv $HOME/.cabal/packages/head.hackage
28+
29+matrix:
14 include:
30 include:
15− - ghc: 8.10.2
31+ - compiler: "ghc-7.10.3"
16− env: SNAPSHOT="nightly-2020-11-03"
32+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
17− - ghc: 8.8.4
33+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
18− env: SNAPSHOT="lts-16.20"
34+ - compiler: "ghc-8.0.2"
19− - ghc: 8.6.5
35+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
20− env: SNAPSHOT="lts-14.22"
36+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
21− - ghc: 8.4.4
37+ - compiler: "ghc-8.2.2"
22− env: SNAPSHOT="lts-12.26"
38+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
39+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
40+ - compiler: "ghc-8.4.1"
41+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
42+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}
23
43
24−install:
44+before_install:
25− - |
45+ - HC=${CC}
26− # install stack
46+ - HCPKG=${HC/ghc/ghc-pkg}
27− curl -sSL https://get.haskellstack.org/ | sh
47+ - unset CC
48+ - ROOTDIR=$(pwd)
49+ - mkdir -p $HOME/.local/bin
50+ - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"
51+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
52+ - echo $HCNUMVER
28
53
29− # build project with stack
54+install:
30− stack --version
55+ - cabal --version
31− stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --resolver=$SNAPSHOT
56+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
57+ - BENCH=${BENCH---enable-benchmarks}
58+ - TEST=${TEST---enable-tests}
59+ - HADDOCK=${HADDOCK-true}
60+ - INSTALLED=${INSTALLED-true}
61+ - GHCHEAD=${GHCHEAD-false}
62+ - travis_retry cabal update -v
63+ - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
64+ - rm -fv cabal.project cabal.project.local
65+ - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
66+ - "printf 'packages: \".\"\\n' > cabal.project"
67+ - cat cabal.project
68+ - if [ -f "./configure.ac" ]; then
69+ (cd "." && autoreconf -i);
70+ fi
71+ - rm -f cabal.project.freeze
72+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
73+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
74+ - rm -rf .ghc.environment.* "."/dist
75+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
32
76
77+# Here starts the actual work to be performed for the package under test;
78+# any command which exits with a non-zero exit code causes the build to fail.
33script:
79script:
34− - |
80+ # test that source-distributions can be generated
35− stack test --system-ghc
81+ - (cd "." && cabal sdist)
82+ - mv "."/dist/validationt-*.tar.gz ${DISTDIR}/
83+ - cd ${DISTDIR} || false
84+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
85+ - "printf 'packages: validationt-*/*.cabal\\n' > cabal.project"
86+ - cat cabal.project
87+ # this builds all libraries and executables (without tests/benchmarks)
88+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
89+
90+ # Build with installed constraints for packages in global-db
91+ - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi
92+
93+ # build & run tests, build benchmarks
94+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all
95+
96+ # cabal check
97+ - (cd validationt-* && cabal check)
98+
99+ # haddock
100+ - rm -rf ./dist-newstyle
101+ - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi
36
102
37−notifications:
103+# REGENDATA ["validationt.cabal"]
38− email: false
104+# EOF
ChangeLog.md−6
@@ -1,11 +1,5 @@
1# Revision history for validationt
1# Revision history for validationt
2
2
3−## 0.3.0
4−
5−* Added documentation.
6−* Fixed `textErrors` behaviour.
7−* Dropped `transformers-lift` dependency.
8−
9## 0.2.1.0
3## 0.2.1.0
10
4
11* GHC 8.4 support
5* GHC 8.4 support
README.mddeleted−76
@@ -1,76 +0,0 @@
1−![Travis CI Badge](https://img.shields.io/travis/typeable/validationt)
2−
3−# ValidationT
4−
5−A simple data validation library. The main idea is to provide an easy way to
6−validate web form data by aggregating errors for each field.
7−
8−## Usage
9−
10−Suppose you want to validate some data from the user. Say, that the password adheres to some rules.
11−
12−You might do something like this:
13−
14−```haskell
15−validatePassword :: Monad m => String -> ValidationT [String] m ()
16−validatePassword password = do
17− vLength password
18− vAlpha password
19− vNum password
20− where
21− vLength p = when (length p < 8)
22− $ vWarning ["The password should be at least 8 characters long."]
23− vAlpha p = unless (any isAlpha p)
24− $ vWarning ["The password should contain at least one alphabetic character."]
25− vNum p = unless (any isDigit p)
26− $ vWarning ["The password should contain at least one numeric character."]
27−```
28−
29−`ValidationT e m a` essentially just gathers the errors thrown by `vWarning`.
30−
31−```haskell
32−vWarning :: (Monad m, Monoid e) => e -> ValidationT e m ()
33−```
34−
35−`vWarning` `mappend`s the given `e` to the already collected errors. This is why the warnings are contained inside a list.
36−
37−There is also `vError`. The only difference between `vWarning` and `vError` is that `vError` stops further execution (and further collection of errors and warnings).
38−
39−You would use the validation like this:
40−
41−```haskell
42−main :: IO ()
43−main = do
44− password <- getLine
45− result <- runValidationTEither . validatePassword $ password
46− putStrLn $ case result of
47− Left errs -> unlines err
48− Right () -> "You are fine."
49−```
50−
51−You could, of course, do more complicated things like use `vWarningL` and `vErrorL` to add an error to a `mempty` structure, which gets `mappend`ed with other errors.
52−
53−The library comes with a `MonoidMap` `newtype` wrapper around `Map`, which `mappend`s the values themselves on conflict. This can be useful if you have a multiple points of failure and you want to distinguich between them -- validating a username and a password for example:
54−
55−```haskell
56−data Piece
57− = Password
58− | UserName
59− deriving (Eq, Show, Ord)
60−
61−validatePassword :: Monad m => String -> ValidationT (MonoidMap Piece [String]) m ()
62−validatePassword password = do
63− vLength password
64− vAlpha password
65− vNum password
66− where
67− warning = mmSingleton UserName
68− vLength p = when (length p < 8)
69− $ warning ["The password should be at least 8 characters long."]
70− vAlpha p = unless (any isAlpha p)
71− $ warning ["The password should contain at least one alphabetic character."]
72− vNum p = unless (any isDigit p)
73− $ warning ["The password should contain at least one numeric character."]
74−```
75−
76−(`mmSingleton` is a covenience initializer for `MonoidMap`.)
src/Control/Monad/Validation.hs+38−169
@@ -3,75 +3,41 @@
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE TemplateHaskell #-}
4{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE TypeFamilies #-}
6−{-# LANGUAGE UndecidableInstances #-}
7
6
8−module Control.Monad.Validation
7+module Control.Monad.Validation where
9− ( ValidationT(..)
10− , runValidationT
11− , runValidationTEither
12− , handleValidationT
13− , vError
14− , vWarning
15− , vErrorL
16− , vWarningL
17− , vZoom
18− , vZoomL
19− , vPromote
20− , mmSingleton
21− , setMempty
22− , neConcat
23− , textErrors
24− , _MonoidMap
25− , MonoidMap(..)
26− ) where
27
8
28−import Control.Applicative
29import Control.Lens hiding ((.=))
9import Control.Lens hiding ((.=))
30import Control.Monad.Base
10import Control.Monad.Base
31import Control.Monad.Catch
11import Control.Monad.Catch
32import Control.Monad.Except
12import Control.Monad.Except
33−import Control.Monad.Fail
34import Control.Monad.State.Strict
13import Control.Monad.State.Strict
35−import Control.Monad.Trans.Control
14+import Control.Monad.Trans.Lift.Local
36import Data.Aeson
15import Data.Aeson
37import Data.Foldable as F
16import Data.Foldable as F
38−import Data.Functor
39import Data.List as L
17import Data.List as L
40import Data.Map.Strict as M
18import Data.Map.Strict as M
19+import Data.Monoid
41import Data.Text as T
20import Data.Text as T
42import Data.Vector as V
21import Data.Vector as V
43import Test.QuickCheck
22import Test.QuickCheck
44
23
45−#if MIN_VERSION_mtl(2,3,0)
46−import Control.Monad
47−import Control.Monad.Fix
48−#endif
49−
50−-- | Collects all thrown warnings in 'StateT' and errors
24+-- | Collects all throwed "warnings" throwed through StateT and "errors" throwed
51−-- in 'ExceptT' into a single value using 'Monoid'.
25+-- through ExceptT to single value using Monoid
26+-- FIXME: give more instances like HReaderT and MonadBaseControl/MonadMask
52newtype ValidationT e m a = ValidationT
27newtype ValidationT e m a = ValidationT
53 { unValidationT :: ExceptT e (StateT e m) a
28 { unValidationT :: ExceptT e (StateT e m) a
54 } deriving ( Functor, Applicative, Monad, MonadThrow, MonadCatch
29 } deriving ( Functor, Applicative, Monad, MonadThrow, MonadCatch
55− , MonadBase b, Alternative, MonadFix, MonadFail, Contravariant
30+ , MonadBase b )
56− , MonadIO, MonadPlus, MonadBaseControl b, MonadMask )
57
31
58instance MonadTrans (ValidationT e) where
32instance MonadTrans (ValidationT e) where
59 lift = ValidationT . lift . lift
33 lift = ValidationT . lift . lift
60
34
35+instance LiftLocal (ValidationT e) where
36+ liftLocal _ l f = ValidationT . mapExceptT (mapStateT $ l f) . unValidationT
37+
61-- | Map with 'Monoid' instance which 'mappend' its values
38-- | Map with 'Monoid' instance which 'mappend' its values
62−--
63−-- This can be used as the `e` in `ValidationT e m a` to provide different
64−-- sets of errors and warnings for different keys.
65−--
66−-- >>> :{
67−-- mconcat
68−-- [ MonoidMap $ M.fromList [(1, "foo"), (2, "hello, "), (3, "oh no")]
69−-- , MonoidMap $ M.fromList [(1, "bar"), (2, "world")]
70−-- ]
71−-- :}
72−-- MonoidMap (fromList [(1,"foobar"),(2,"hello, world"),(3,"oh no")])
73newtype MonoidMap k v = MonoidMap (Map k v)
39newtype MonoidMap k v = MonoidMap (Map k v)
74− deriving (Eq, Ord, Show, Arbitrary, Foldable)
40+ deriving (Eq, Ord, Show, Arbitrary)
75
41
76makePrisms ''MonoidMap
42makePrisms ''MonoidMap
77
43
@@ -89,7 +55,7 @@ instance (Ord k, Semigroup v) => Semigroup (MonoidMap k v) where
89
55
90instance (Ord k, Monoid v) => Monoid (MonoidMap k v) where
56instance (Ord k, Monoid v) => Monoid (MonoidMap k v) where
91 mempty = MonoidMap M.empty
57 mempty = MonoidMap M.empty
92− mappend = (<>)
58+ mappend = mmAppend
93
59
94instance (ToJSON k, ToJSON v) => ToJSON (MonoidMap k v) where
60instance (ToJSON k, ToJSON v) => ToJSON (MonoidMap k v) where
95 toJSON (MonoidMap m) = toJSON $ L.map toObj $ M.toList m
61 toJSON (MonoidMap m) = toJSON $ L.map toObj $ M.toList m
@@ -99,7 +65,7 @@ instance (ToJSON k, ToJSON v) => ToJSON (MonoidMap k v) where
99 , "value" .= v ]
65 , "value" .= v ]
100
66
101instance (Ord k, FromJSON k, FromJSON v) => FromJSON (MonoidMap k v) where
67instance (Ord k, FromJSON k, FromJSON v) => FromJSON (MonoidMap k v) where
102− parseJSON = withArray "MonoidMap" go
68+ parseJSON v = withArray "MonoidMap" go v
103 where
69 where
104 go arr = do
70 go arr = do
105 keyvals <- traverse fromObj arr
71 keyvals <- traverse fromObj arr
@@ -116,60 +82,35 @@ mmAppend :: (Ord k, Monoid v) => MonoidMap k v -> MonoidMap k v -> MonoidMap k v
116#endif
82#endif
117mmAppend (MonoidMap a) (MonoidMap b) = MonoidMap $ M.unionWith (<>) a b
83mmAppend (MonoidMap a) (MonoidMap b) = MonoidMap $ M.unionWith (<>) a b
118
84
119−-- | Convenient for 'vZoom' as first argument. Will prevent generation
85+-- | Convenient for 'vZoom' as first artument. Will prevent generation
120−-- of map with 'mempty' values.
86+-- of map with 'mempty' values
121mmSingleton :: (Eq v, Monoid v, Ord k) => k -> v -> MonoidMap k v
87mmSingleton :: (Eq v, Monoid v, Ord k) => k -> v -> MonoidMap k v
122−mmSingleton k v
123− | v == mempty = mempty
124− | otherwise = MonoidMap . M.singleton k $ v
88+mmSingleton k = memptyWrap mempty $ MonoidMap . M.singleton k
125
89
126−-- | Sets given value to 'mempty'.
90+-- | Set given value to 'mempty'
127setMempty :: (Monoid s) => ASetter' s a -> a -> s
91setMempty :: (Monoid s) => ASetter' s a -> a -> s
128setMempty setter a = set setter a mempty
92setMempty setter a = set setter a mempty
129
93
130−neConcat :: Foldable f => (a -> a -> a) -> f a -> Maybe a
94+memptyWrap :: (Eq a, Monoid a) => b -> (a -> b) -> a -> b
131−neConcat f a
95+memptyWrap b f a
132− | F.null a = Nothing
96+ | a == mempty = b
133− | otherwise = Just $ F.foldr1 f a
97+ | otherwise = f a
98+
99+-- | If given container is not 'mempty', then use given function to
100+-- append all its elements and return 'Just' result
101+neConcat
102+ :: (Foldable f, Eq (f a), Monoid a, Monoid (f a))
103+ => (a -> a -> a)
104+ -> f a
105+ -> Maybe a
106+neConcat f = memptyWrap Nothing (Just . F.foldl' f mempty)
134
107
135−-- | Returns the strings, concatanated with @", "@ if the list is not empty.
136−--
137−-- Returns Nothing if the list is empty
138−--
139−-- >>> textErrors ["foo", "bar"]
140−-- Just "foo, bar"
141−--
142−-- >>> textErrors ["foo"]
143−-- Just "foo"
144−--
145−-- >>> textErrors []
146−-- Nothing
147textErrors :: [Text] -> Maybe Text
108textErrors :: [Text] -> Maybe Text
148textErrors = neConcat (\a b -> a <> ", " <> b)
109textErrors = neConcat (\a b -> a <> ", " <> b)
149
110
150−-- | Returns 'mempty' instead of error if no warnings have occurred.
111+-- | Returns `mempty` instead of error if no warnings was occured. So, your
112+-- error should have `Eq` instance to detect that any error was occured. Returns
151−-- Returns 'Nothing' as the second element of tuple if computation was
113+-- Nothing for second element of tuple if compuration was interruped by 'vError'
152−-- interrupted by 'vError'.
153−--
154−-- Returns all concatenated errors and warnings and the result if no
155−-- errors have occurred (warnings could have occurred).
156−--
157−-- >>> :{
158−-- runValidationT $ do
159−-- vWarning ["warning1"]
160−-- vError ["error"]
161−-- vWarning ["warning2"]
162−-- return 8
163−-- :}
164−-- (["error","warning1"],Nothing)
165−--
166−-- >>> :{
167−-- runValidationT $ do
168−-- vWarning ["warning1"]
169−-- vWarning ["warning2"]
170−-- return 8
171−-- :}
172−-- (["warning1","warning2"],Just 8)
173runValidationT :: (Monoid e, Monad m) => ValidationT e m a -> m (e, Maybe a)
114runValidationT :: (Monoid e, Monad m) => ValidationT e m a -> m (e, Maybe a)
174runValidationT (ValidationT m) = do
115runValidationT (ValidationT m) = do
175 (res, warnings) <- runStateT (runExceptT m) mempty
116 (res, warnings) <- runStateT (runExceptT m) mempty
@@ -177,25 +118,6 @@ runValidationT (ValidationT m) = do
177 Left err -> (err <> warnings, Nothing)
118 Left err -> (err <> warnings, Nothing)
178 Right a -> (warnings, Just a)
119 Right a -> (warnings, Just a)
179
120
180−-- | Like 'runValidationT' but doesn't return the result
181−-- if any warning has occurred.
182−--
183−-- >>> :{
184−-- runValidationTEither $ do
185−-- vWarning ["warning1"]
186−-- vError ["error"]
187−-- vWarning ["warning2"]
188−-- return 8
189−-- :}
190−-- Left ["error","warning1"]
191−--
192−-- >>> :{
193−-- runValidationTEither $ do
194−-- vWarning ["warning1"]
195−-- vWarning ["warning2"]
196−-- return 8
197−-- :}
198−-- Left ["warning1","warning2"]
199runValidationTEither
121runValidationTEither
200 :: (Monoid e, Eq e, Monad m)
122 :: (Monoid e, Eq e, Monad m)
201 => ValidationT e m a
123 => ValidationT e m a
@@ -206,71 +128,28 @@ runValidationTEither action = do
206 Just a | err == mempty -> Right a
128 Just a | err == mempty -> Right a
207 _ -> Left err
129 _ -> Left err
208
130
209−-- | Like 'runValidationTEither', but takes an error handler instead of
210−-- returning errors and warnings.
211−--
212−-- >>> :{
213−-- handleValidationT (\_ -> return 11) $ do
214−-- vWarning ["warning1"]
215−-- vError ["error"]
216−-- vWarning ["warning2"]
217−-- return 8
218−-- :}
219−-- 11
220−--
221−-- >>> :{
222−-- handleValidationT (\_ -> return 11) $ do
223−-- vWarning ["warning1"]
224−-- vWarning ["warning2"]
225−-- return 8
226−-- :}
227−-- 11
228handleValidationT
131handleValidationT
229 :: (Monoid e, Monad m, Eq e)
132 :: (Monoid e, Monad m, Eq e)
230 => (e -> m a)
133 => (e -> m a)
231 -> ValidationT e m a
134 -> ValidationT e m a
232 -> m a
135 -> m a
233−handleValidationT handler action =
136+handleValidationT handler action = do
234 runValidationTEither action >>= either handler return
137 runValidationTEither action >>= either handler return
235
138
236−-- | Stops further execution and appends the given error.
139+-- | Stops further execution of validation
237vError :: (Monad m) => e -> ValidationT e m a
140vError :: (Monad m) => e -> ValidationT e m a
238vError e = ValidationT $ throwError e
141vError e = ValidationT $ throwError e
239
142
240−-- | Does not stop further execution and appends the given warning.
143+-- | Does not stop further execution, append warning to
241vWarning :: (Monad m, Monoid e) => e -> ValidationT e m ()
144vWarning :: (Monad m, Monoid e) => e -> ValidationT e m ()
242vWarning e = ValidationT $ modify' (<> e)
145vWarning e = ValidationT $ modify' (<> e)
243
146
244−-- | Like 'vError' but allows you to use a setter to insert an error somewhere
245−-- deeper into an empty ('mempty') "e" from "ValidationT e m x", which is then
246−-- combined with all gathered warnings.
247vErrorL :: (Monad m, Monoid e) => ASetter' e a -> a -> ValidationT e m x
147vErrorL :: (Monad m, Monoid e) => ASetter' e a -> a -> ValidationT e m x
248vErrorL l a = vError $ setMempty l a
148vErrorL l a = vError $ setMempty l a
249
149
250−-- | Like 'vWarning' but allows you to use a setter to insert an error somewhere
251−-- deeper into an empty ('mempty') "e" from "ValidationT e m x", which is then
252−-- combined with all gathered warnings.
253vWarningL :: (Monad m, Monoid e) => ASetter' e a -> a -> ValidationT e m ()
150vWarningL :: (Monad m, Monoid e) => ASetter' e a -> a -> ValidationT e m ()
254vWarningL l a = vWarning $ setMempty l a
151vWarningL l a = vWarning $ setMempty l a
255
152
256−-- | Allows you apply a transformation to the "e" in "ValidationT e m x".
257−--
258−-- >>> :{
259−--runValidationT . vZoom (Data.Map.singleton "password errors") $ do
260−-- vWarning ["warning1"]
261−-- vError ["error"]
262−-- vWarning ["warning2"]
263−-- return 8
264−-- :}
265−-- (fromList [("password errors",["error","warning1"])],Nothing)
266−--
267−-- >>> :{
268−-- runValidationT . vZoom (Data.Map.singleton "password errors") $ do
269−-- vWarning ["warning1"]
270−-- vWarning ["warning2"]
271−-- return 8
272−-- :}
273−-- (fromList [("password errors",["warning1","warning2"])],Just 8)
274vZoom
153vZoom
275 :: (Monad m, Monoid a, Monoid b)
154 :: (Monad m, Monoid a, Monoid b)
276 => (a -> b)
155 => (a -> b)
@@ -280,21 +159,11 @@ vZoom up action = do
280 (err, res) <- lift $ runValidationT action
159 (err, res) <- lift $ runValidationT action
281 case res of
160 case res of
282 Nothing -> vError $ up err
161 Nothing -> vError $ up err
283− Just a -> vWarning (up err) $> a
162+ Just a -> vWarning (up err) *> return a
284
163
285−-- | Like 'vZoom' but takes a setter instead of a function.
286vZoomL
164vZoomL
287 :: (Monad m, Monoid a, Monoid b)
165 :: (Monad m, Monoid a, Monoid b)
288 => ASetter' b a
166 => ASetter' b a
289 -> ValidationT a m x
167 -> ValidationT a m x
290 -> ValidationT b m x
168 -> ValidationT b m x
291−vZoomL l = vZoom (setMempty l)
169+vZoomL l action = vZoom (setMempty l) action
292−
293−-- | Turn any warnings the have occurred into errors.
294−vPromote
295− :: (Monad m, Monoid a, Eq a)
296− => ValidationT a m x
297− -> ValidationT a m x
298−vPromote m = do
299− err <- lift $ runValidationTEither m
300− either vError return err
stack.yaml+2−2
@@ -15,7 +15,7 @@
15# resolver:
15# resolver:
16# name: custom-snapshot
16# name: custom-snapshot
17# location: "./custom-snapshot.yaml"
17# location: "./custom-snapshot.yaml"
18−resolver: lts-22.4
18+resolver: lts-8.14
19
19
20# User packages to be built.
20# User packages to be built.
21# Various formats can be used as shown in the example below.
21# Various formats can be used as shown in the example below.
@@ -63,4 +63,4 @@ extra-package-dbs: []
63# extra-lib-dirs: [/path/to/dir]
63# extra-lib-dirs: [/path/to/dir]
64#
64#
65# Allow a newer minor version of GHC than the snapshot specifies
65# Allow a newer minor version of GHC than the snapshot specifies
66−# compiler-check: newer-minor
66+# compiler-check: newer-minor
test/Doc.hsdeleted−6
@@ -1,6 +0,0 @@
1−module Main (main) where
2−
3−import Test.DocTest
4−
5−main :: IO ()
6−main = doctest [ "-XOverloadedStrings", "-isrc", "src" ]
validationt.cabal+13−36
@@ -2,11 +2,9 @@
2-- documentation, see http://haskell.org/cabal/users-guide/
2-- documentation, see http://haskell.org/cabal/users-guide/
3
3
4name: validationt
4name: validationt
5−version: 0.3.0
5+version: 0.2.1.0
6−synopsis: Straightforward validation monad
6+synopsis: Straightforward validation monad.
7−description:
7+description: Convenient solution for validating web forms and APIs.
8− A simple data validation library. The main idea is to provide an easy way to validate web form data by aggregating errors for each field.
9− .
10homepage: https://github.com/typeable/validationt
8homepage: https://github.com/typeable/validationt
11license: BSD3
9license: BSD3
12license-file: LICENSE
10license-file: LICENSE
@@ -16,12 +14,11 @@ maintainer: makeit@typeable.io
16category: Control
14category: Control
17build-type: Simple
15build-type: Simple
18extra-source-files: ChangeLog.md
16extra-source-files: ChangeLog.md
19− , README.md
20cabal-version: >=1.10
17cabal-version: >=1.10
21−tested-with: GHC == 8.4.4
18+tested-with: GHC == 7.10.3
22− , GHC == 8.6.5
19+ , GHC == 8.0.2
23− , GHC == 8.8.4
20+ , GHC == 8.2.2
24− , GHC == 8.10.2
21+ , GHC == 8.4.1
25
22
26source-repository head
23source-repository head
27 type: git
24 type: git
@@ -29,38 +26,18 @@ source-repository head
29
26
30library
27library
31 exposed-modules: Control.Monad.Validation
28 exposed-modules: Control.Monad.Validation
32− build-depends: base >=4.10 && < 5
29+ build-depends: base >=4.8 && < 5
33− , aeson >=1.0
30+ , aeson >= 1.0
34 , containers
31 , containers
35− , exceptions >=0.9
32+ , exceptions
36 , lens
33 , lens
37 , monad-control
34 , monad-control
38− , mtl <2.3 || >2.3
35+ , mtl
39− , QuickCheck >=2.8.2
36+ , QuickCheck
40 , text
37 , text
41 , transformers
38 , transformers
42 , transformers-base
39 , transformers-base
40+ , transformers-lift
43 , vector
41 , vector
44 hs-source-dirs: src
42 hs-source-dirs: src
45 default-language: Haskell2010
43 default-language: Haskell2010
46− ghc-options: -fwarn-unused-binds
47− -Wall
48− -Wincomplete-uni-patterns
49− -Wincomplete-record-updates
50− -Wpartial-fields
51− -Werror=missing-home-modules
52− -Wmissing-home-modules
53− -Widentities
54− -Wredundant-constraints
55− -Wmissing-export-lists
56−
57−test-suite doctest
58− default-language: Haskell2010
59− type: exitcode-stdio-1.0
60− hs-source-dirs: test
61− ghc-options: -Wall
62− main-is: Doc.hs
63− build-depends:
64− base >= 4.10.0.0
65− , doctest >= 0.11.4
66− , validationt