1module Validation where
2
3data Validation e a
4 = Failure [e]
5 | Success a
6 deriving (Show, Eq)
7
8instance Functor (Validation e) where
9 fmap _ (Failure es) = Failure es
10 fmap f (Success a) = Success (f a)
11
12instance Semigroup (Validation e a) where
13 Failure e1 <> Failure e2 = Failure (e1 <> e2)
14 Failure e1 <> _ = Failure e1
15 _ <> Failure e2 = Failure e2
16 Success a <> _ = Success a
17
18validate :: (a -> Bool) -> e -> a -> Validation e a
19validate predicate err value
20 | predicate value = Success value
21 | otherwise = Failure [err]
22
23data User = User
24 { userName :: String
25 , userEmail :: String
26 , userAge :: Int
27 } deriving (Show)
28
29nonEmpty :: String -> String -> Validation String String
30nonEmpty field value =
31 validate (not . null) (field ++ " must not be empty") value
32
33validAge :: Int -> Validation String Int
34validAge =
35 validate (\a -> a >= 0 && a <= 150) "Age must be 0-150"
36
37validEmail :: String -> Validation String String
38validEmail =
39 validate (elem '@') "Email must contain @"
40
41mkUser :: String -> String -> Int -> Validation String User
42mkUser name email age =
43 case (nonEmpty "Name" name, validEmail email, validAge age) of
44 (Success n, Success e, Success a) ->
45 Success (User n e a)
46 (n, e, a) ->
47 Failure (getErrors n ++ getErrors e ++ getErrors a)
48 where
49 getErrors (Failure es) = es
50 getErrors _ = []
51
52mapValidation :: (a -> b) -> Validation e a -> Validation e b
53mapValidation = fmap
54
55bindValidation :: Validation e a
56 -> (a -> Validation e b)
57 -> Validation e b
58bindValidation (Failure es) _ = Failure es
59bindValidation (Success a) f = f a