andThen

src/App/Validation.purs

@@ -3,15 +3,20 @@ module App.Validation where
 import Prelude
 
 import Data.Validation.Semigroup
-import Data.Array
+import Data.Array as A
 import Data.Maybe
+import Data.Either
 import Data.Tuple (Tuple(..))
-import Data.String.Regex
+import Data.String.Regex as R
+import Data.String.Regex.Flags as RF
+import Data.String as S
 import Data.Int (fromString)
 
 import App.RR
 import App.ResourceRecord (ResourceRecord)
 
+infixl 8 andThen as !>
+
 data Attribute
   = Name
   | TTL
@@ -40,17 +45,18 @@ name_format = "[a-zA-Z]+"
 
 lengthIsBetween :: Attribute -> Int -> Int -> String -> V Errors String
 lengthIsBetween field minlen maxlen value
-  | valid_condition = invalid [ Tuple field error_message ]
-  | otherwise       = pure value
+  = if valid_condition
+      then pure value
+      else invalid [ Tuple field error_message ]
   where
-    actual_len = A.length value
+    actual_len = S.length value
     valid_condition = actual_len >= minlen && actual_len <= maxlen
     error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]"
 
-matches :: Attribute -> Regex -> String -> V Errors String
+matches :: Attribute -> R.Regex -> String -> V Errors String
 matches field regex value
-  | test regex value = pure value
-  | otherwise        = invalid [Tuple field "unacceptable format"]
+  | R.test regex value = pure value
+  | otherwise          = invalid [Tuple field "unacceptable format"]
 
 intBetween :: Attribute -> Int -> Int -> Int -> V Errors Int
 intBetween field min max value
@@ -60,39 +66,43 @@ intBetween field min max value
     error_message = "acceptable value [" <> show min <> "-" <> show max <> "]"
 
 validate_integer :: Attribute -> String -> V Errors Int
-validate_integer field value
-  = case fromString form.ttl of
+validate_integer field string
+  = case fromString string of
       Nothing -> invalid [Tuple field "not an integer"]
       Just i  -> pure i
 
+xx :: forall y a. y -> Array a -> y
+xx f _ = f
+
 -- Field-related validations.
 
 validate_name :: String -> V Errors String
-validate_name name = ado
-  _ <- lengthIsBetween Name name_min_len name_max_len name
-  _ <- matches         Name name_format  name
-  in pure name
+validate_name name
+  = case R.regex name_format RF.unicode of
+      Left error_string -> invalid [Tuple NotAnAttribute $ "error in name regex: " <> error_string]
+      Right regex       -> verify_length !> (matches Name regex)
+    where
+      verify_length = lengthIsBetween Name name_min_len name_max_len name
 
 validate_ttl :: String -> V Errors Int
-validate_ttl str_ttl = ado
-  ttl <- validate_integer TTL str_ttl
-  in ado
-    value  <- intBetween TTL min_ttl max_ttl ttl
-    in pure value
+validate_ttl str_ttl
+  = is_int str_ttl !> (intBetween TTL min_ttl max_ttl) !> pure
+  where
+    is_int = validate_integer TTL
 
 validate_target :: String -> V Errors String
-validate_target target = ado
-  target <- lengthIsBetween Target target_min_len target_max_len target
-  in pure target
+validate_target target = verify_length target !> pure
+  where
+    verify_length = lengthIsBetween Target target_min_len target_max_len
 
 -- Resource-related validations.
 
 validateA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
 validateA form = ado
-  name <- validate_name form.name
-  ttl  <- validate_ttl form.ttl
+  name   <- validate_name   form.name
+  ttl    <- validate_ttl    form.ttl
   target <- validate_target form.target
-  in pure $ toRR_basic form.readonly form.rrid "A" name ttl target
+  in pure $ toRR_basic form.rrid form.readonly "A" name ttl target
 
 validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
 validateAAAA _ = invalid [Tuple NotAnAttribute "validation not implemented"]
@@ -144,6 +154,7 @@ type RRRetry    = Maybe Int
 type RRExpire   = Maybe Int
 type RRMinttl   = Maybe Int
 
+
 toRR :: Int -> Boolean -> String -> String -> Int -> String
      -> RRPriority
      -> RRPort
@@ -187,19 +198,19 @@ toRR rrid readonly rrtype rrname ttl target
 toRR_basic :: Int -> Boolean -> String -> String -> Int -> String -> ResourceRecord
 toRR_basic rrid readonly rrtype rrname ttl target
   = toRR rrid readonly rrtype rrname ttl target
-         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 -- last + priority
 toRR_mx :: Int -> Boolean -> String -> String -> Int -> String -> Int -> ResourceRecord
 toRR_mx rrid readonly rrtype rrname ttl target priority
   = toRR rrid readonly rrtype rrname ttl target (Just priority)
-         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 -- last + port + protocol + weight
 toRR_srv :: Int -> Boolean -> String -> String -> Int -> String -> Int -> Int -> String -> Int -> ResourceRecord
 toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight
   = toRR rrid readonly rrtype rrname ttl target (Just priority) (Just port) (Just protocol) (Just weight)
-         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+         Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromLocalSimpleRRRepresentationToResourceRecord :: forall l. SimpleRR (|l) -> ResourceRecord
 fromLocalSimpleRRRepresentationToResourceRecord form