Skip to content

Commit d7b1f71

Browse files
mbuszkambuszka
committed
Validator type alias + update UrlEncoded
1 parent d5d037c commit d7b1f71

File tree

3 files changed

+75
-57
lines changed

3 files changed

+75
-57
lines changed

‎src/Data/Validator.purs

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
module Data.Validator
2+
( Validator(..)
3+
, Errors(..)
4+
, fail
5+
6+
-- Export until updated to 0.12
7+
, RowApply(..)
8+
, type (+)
9+
) where
10+
11+
import Prelude
12+
13+
import Data.Array (singleton)
14+
import Data.Variant(Variant)
15+
import Polyform.Validation(Validation, V(..))
16+
17+
type RowApply (f :: # Type -> # Type) (a :: # Type) = f a
18+
infixr 0 type RowApply as +
19+
20+
type Errors e = Array (Variant e)
21+
type Validator m e a = Validation m (Errors e) a
22+
23+
fail :: forall e a. Variant e -> V (Errors e) a
24+
fail e = Invalid $ singleton e

‎src/Validators/Json.purs

Lines changed: 22 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,9 @@
11
module Validators.Json
22
( JsError
3-
, JsErr
43
, JsValidation
5-
, Err
64
, array
75
, arrayOf
86
, elem
9-
, fail
107
, field
118
, int
129
, object
@@ -17,7 +14,7 @@ module Validators.Json
1714
import Prelude
1815

1916
import Data.Argonaut (Json, foldJson, toArray, toNumber, toObject, toString)
20-
import Data.Array (fromFoldable, singleton, (!!))
17+
import Data.Array ((!!))
2118
import Data.Bifunctor (lmap)
2219
import Data.Int (fromNumber)
2320
import Data.List (List(..), (:))
@@ -26,23 +23,12 @@ import Data.Monoid (class Monoid, mempty)
2623
import Data.StrMap (StrMap, lookup)
2724
import Data.Symbol (SProxy(..))
2825
import Data.Traversable (sequence, traverse)
29-
import Data.Variant(Variant, inj, prj)
30-
import Polyform.Validation (V(..), Validation, hoistFnMV, hoistFnV, runValidation)
26+
import Data.Validator(Errors, Validator, fail)
27+
import Data.Variant(inj, prj)
28+
import Polyform.Validation (V, hoistFnMV, hoistFnV, runValidation)
3129

32-
type RowApply (f :: # Type -> # Type) (a :: # Type) = f a
33-
34-
infixr 0 type RowApply as +
35-
36-
37-
type JsErr r = (jsError :: JsError | r)
38-
39-
newtype JsError = JsErr { path :: List String, msg :: String }
40-
41-
instance showJsError :: Show JsError where
42-
show (JsErr e) = "(Error at" <> show (fromFoldable e.path) <> " " <> e.msg <> ")"
43-
44-
type Err e = Array (Variant (JsErr e))
45-
type JsValidation m e a = Validation m (Err e) Json a
30+
type JsError r = (jsError :: { path :: List String, msg :: String } | r)
31+
type JsValidation m e a = Validator m (JsError e) Json a
4632

4733
jsType :: Json -> String
4834
jsType = foldJson
@@ -55,40 +41,40 @@ jsType = foldJson
5541

5642
_jsErr = SProxy :: SProxy "jsError"
5743

58-
fail :: forall e a. String -> V (Err e) a
59-
fail msg = Invalid $ singleton $ inj _jsErr $ JsErr { path: Nil, msg: msg }
44+
failure :: forall e a. String -> V (Errors (JsError e)) a
45+
failure msg = fail $ inj _jsErr { path: Nil, msg: msg }
6046

61-
extendPath :: String -> JsError -> JsError
62-
extendPath p (JsErr e) = JsErr { path: p:e.path, msg: e.msg }
47+
extendPath :: String -> { path :: List String, msg :: String } -> { path :: List String, msg :: String }
48+
extendPath p e = { path: p:e.path, msg: e.msg }
6349

64-
extend :: forall e. String -> Err e -> Err e
65-
extend s e =
66-
map (\e -> case prj _jsErr e of
67-
Just e -> inj _jsErr $ extendPath s e
68-
Nothing -> e) e
50+
extend :: forall e. String -> Errors (JsError e) -> Errors (JsError e)
51+
extend s errs =
52+
map (\err -> case prj _jsErr err of
53+
Just jsErr -> inj _jsErr $ extendPath s jsErr
54+
Nothing -> err) errs
6955

7056
int :: forall m e. Monad m => JsValidation m e Int
7157
int = hoistFnV $ \v ->
7258
case toNumber v >>= fromNumber of
73-
Nothing -> fail (jsType v <> " is not an int")
59+
Nothing -> failure (jsType v <> " is not an int")
7460
Just n -> pure n
7561

76-
object :: forall m e. Monad m => Validation m (Err e) Json (StrMap Json)
62+
object :: forall m e. Monad m => Validator m (JsError e) Json (StrMap Json)
7763
object = hoistFnV $ \v ->
7864
case toObject v of
79-
Nothing -> fail (jsType v <> " is not an object")
65+
Nothing -> failure (jsType v <> " is not an object")
8066
Just o -> pure o
8167

8268
string :: forall m e. Monad m => JsValidation m e String
8369
string = hoistFnV $ \v ->
8470
case toString v of
85-
Nothing -> fail (jsType v <> " is not a string")
71+
Nothing -> failure (jsType v <> " is not a string")
8672
Just s -> pure s
8773

8874
field :: forall m e a. Monad m => String -> JsValidation m e a -> JsValidation m e a
8975
field f nested = object >>> hoistFnMV (\v ->
9076
case lookup f v of
91-
Nothing -> pure $ fail ("no field " <> show f <> " in object " <> show v)
77+
Nothing -> pure $ failure ("no field " <> show f <> " in object " <> show v)
9278
Just json -> do
9379
res <- runValidation nested json
9480
pure $ lmap (extend f) res)
@@ -108,13 +94,13 @@ optionalField f nested = object >>> hoistFnMV (\v ->
10894
array :: forall m e. Monad m => JsValidation m e (Array Json)
10995
array = hoistFnV $ \v ->
11096
case toArray v of
111-
Nothing -> fail (jsType v <> " is not an array")
97+
Nothing -> failure (jsType v <> " is not an array")
11298
Just a -> pure a
11399

114100
elem :: forall m e a. Monad m => Int -> JsValidation m e a -> JsValidation m e a
115101
elem i v = array >>> hoistFnMV (\arr ->
116102
case arr !! i of
117-
Nothing -> pure $ fail ("no element at index " <> show i)
103+
Nothing -> pure $ failure ("no element at index " <> show i)
118104
Just a -> runValidation v a)
119105

120106
arrayOf :: forall m e a. Monad m => JsValidation m e a -> JsValidation m e (Array a)

‎src/Validators/UrlEncoded.purs

Lines changed: 29 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
module Validators.UrlEncoded
22
( UrlValidation
3+
, UrlError
34
, array
45
, boolean
56
, int
@@ -10,31 +11,38 @@ module Validators.UrlEncoded
1011

1112
import Prelude
1213

13-
import Data.Array (fromFoldable, singleton)
14-
import Data.Bifunctor (lmap, rmap)
15-
import Data.Either (Either)
14+
import Data.Array (fromFoldable)
15+
import Data.Bifunctor (rmap)
16+
import Data.Either (Either(..))
1617
import Data.Int as Int
1718
import Data.Maybe (Maybe(..))
1819
import Data.Number as Number
1920
import Data.StrMap (StrMap)
2021
import Data.StrMap as StrMap
2122
import Data.String (toLower)
23+
import Data.Symbol (SProxy(..))
2224
import Data.URI (Query(..))
2325
import Data.URI.Query (parser)
24-
import Polyform.Validation (V(..), Validation, hoistFnV)
25-
import Polyform.Validation as V
26+
import Data.Validator (Errors, Validator, fail)
27+
import Data.Variant (inj)
28+
import Polyform.Validation (V(..), hoistFnV)
2629
import Text.Parsing.StringParser (ParseError(..), runParser)
2730

28-
type UrlValidation m a b = Validation m (Array ParseError) a b
31+
type UrlValidation m e a b = Validator m (UrlError e) a b
32+
type UrlError e = (urlError :: ParseError | e)
2933
type UrlEncoded = StrMap (Array String)
3034

31-
fail :: forall a. String -> V (Array ParseError) a
32-
fail s = Invalid $ singleton $ ParseError s
35+
_urlErr :: SProxy "urlError"
36+
_urlErr = SProxy
3337

34-
fromEither :: forall a. Either ParseError a -> V (Array ParseError) a
35-
fromEither = lmap singleton >>> V.fromEither
38+
failure :: forall e a. String -> V (Errors (UrlError e)) a
39+
failure s = fail $ inj _urlErr $ ParseError s
3640

37-
urlEncoded :: forall m. Monad m => UrlValidation m String UrlEncoded
41+
fromEither :: forall e a. Either ParseError a -> V (Errors (UrlError e)) a
42+
fromEither (Left e) = fail $ inj _urlErr e
43+
fromEither (Right v) = Valid [] v
44+
45+
urlEncoded :: forall m e. Monad m => UrlValidation m e String UrlEncoded
3846
urlEncoded = hoistFnV \s ->
3947
(queryToMap <$> (fromEither $ runParser parser ("?" <> s)))
4048

@@ -44,28 +52,28 @@ queryToMap (Query q) =
4452
in StrMap.fromFoldableWith (<>) q'
4553

4654

47-
number :: forall m. Monad m => UrlValidation m String Number
55+
number :: forall m e. Monad m => UrlValidation m e String Number
4856
number = hoistFnV $ \s -> case Number.fromString s of
4957
Just n -> pure n
50-
Nothing -> fail $ "Could not parse " <> s <> " as number"
58+
Nothing -> failure $ "Could not parse " <> s <> " as number"
5159

52-
int :: forall m. Monad m => UrlValidation m String Int
60+
int :: forall m e. Monad m => UrlValidation m e String Int
5361
int = hoistFnV $ \s -> case Int.fromString s of
5462
Just n -> pure n
55-
Nothing -> fail $ "Could not parse " <> s <> " as int"
63+
Nothing -> failure $ "Could not parse " <> s <> " as int"
5664

57-
boolean :: forall m. Monad m => UrlValidation m String Boolean
65+
boolean :: forall m e. Monad m => UrlValidation m e String Boolean
5866
boolean = hoistFnV $ \s -> case toLower s of
5967
"false" -> pure false
6068
"true" -> pure true
61-
_ -> fail $ "Could not parse " <> s <> " as boolean"
69+
_ -> failure $ "Could not parse " <> s <> " as boolean"
6270

63-
single :: forall m. Monad m => String -> UrlValidation m UrlEncoded String
71+
single :: forall m e. Monad m => String -> UrlValidation m e UrlEncoded String
6472
single f = hoistFnV $ \q -> case StrMap.lookup f q of
6573
Just [s] -> pure s
66-
_ -> fail $ "Could not find field " <> f
74+
_ -> failure $ "Could not find field " <> f
6775

68-
array :: forall m. Monad m => String -> UrlValidation m UrlEncoded (Array String)
76+
array :: forall m e. Monad m => String -> UrlValidation m e UrlEncoded (Array String)
6977
array f = hoistFnV $ \q -> case StrMap.lookup f q of
7078
Just s -> pure s
71-
Nothing -> fail $ "Could not find field " <> f
79+
Nothing -> failure $ "Could not find field " <> f

0 commit comments

Comments
 (0)