1
1
module Validators.Json
2
2
( JsError
3
- , JsErr
4
3
, JsValidation
5
- , Err
6
4
, array
7
5
, arrayOf
8
6
, elem
9
- , fail
10
7
, field
11
8
, int
12
9
, object
@@ -17,7 +14,7 @@ module Validators.Json
17
14
import Prelude
18
15
19
16
import Data.Argonaut (Json , foldJson , toArray , toNumber , toObject , toString )
20
- import Data.Array (fromFoldable , singleton , (!!))
17
+ import Data.Array ((!!))
21
18
import Data.Bifunctor (lmap )
22
19
import Data.Int (fromNumber )
23
20
import Data.List (List (..), (:))
@@ -26,23 +23,12 @@ import Data.Monoid (class Monoid, mempty)
26
23
import Data.StrMap (StrMap , lookup )
27
24
import Data.Symbol (SProxy (..))
28
25
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 )
31
29
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
46
32
47
33
jsType :: Json -> String
48
34
jsType = foldJson
@@ -55,40 +41,40 @@ jsType = foldJson
55
41
56
42
_jsErr = SProxy :: SProxy " jsError"
57
43
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 }
60
46
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 }
63
49
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
69
55
70
56
int :: forall m e . Monad m => JsValidation m e Int
71
57
int = hoistFnV $ \v ->
72
58
case toNumber v >>= fromNumber of
73
- Nothing -> fail (jsType v <> " is not an int" )
59
+ Nothing -> failure (jsType v <> " is not an int" )
74
60
Just n -> pure n
75
61
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 )
77
63
object = hoistFnV $ \v ->
78
64
case toObject v of
79
- Nothing -> fail (jsType v <> " is not an object" )
65
+ Nothing -> failure (jsType v <> " is not an object" )
80
66
Just o -> pure o
81
67
82
68
string :: forall m e . Monad m => JsValidation m e String
83
69
string = hoistFnV $ \v ->
84
70
case toString v of
85
- Nothing -> fail (jsType v <> " is not a string" )
71
+ Nothing -> failure (jsType v <> " is not a string" )
86
72
Just s -> pure s
87
73
88
74
field :: forall m e a . Monad m => String -> JsValidation m e a -> JsValidation m e a
89
75
field f nested = object >>> hoistFnMV (\v ->
90
76
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)
92
78
Just json -> do
93
79
res <- runValidation nested json
94
80
pure $ lmap (extend f) res)
@@ -108,13 +94,13 @@ optionalField f nested = object >>> hoistFnMV (\v ->
108
94
array :: forall m e . Monad m => JsValidation m e (Array Json )
109
95
array = hoistFnV $ \v ->
110
96
case toArray v of
111
- Nothing -> fail (jsType v <> " is not an array" )
97
+ Nothing -> failure (jsType v <> " is not an array" )
112
98
Just a -> pure a
113
99
114
100
elem :: forall m e a . Monad m => Int -> JsValidation m e a -> JsValidation m e a
115
101
elem i v = array >>> hoistFnMV (\arr ->
116
102
case arr !! i of
117
- Nothing -> pure $ fail (" no element at index " <> show i)
103
+ Nothing -> pure $ failure (" no element at index " <> show i)
118
104
Just a -> runValidation v a)
119
105
120
106
arrayOf :: forall m e a . Monad m => JsValidation m e a -> JsValidation m e (Array a )
0 commit comments