Function form validations written in Haskell

formValidations.hs

{-# LANGUAGE DuplicateRecordFields #-}

module FormValidations where

import Data.Either
import Data.Maybe
import Text.Read

main :: IO ()
main = return ()

type FormError = String
type FormValue = String
type Rule = FormValue -> Either FormError FormValue
-- | Either is a natural fit for this context because bind "ignores" a Left value
-- Left a >>= someFunc == Left a
-- Right a >>= someFunc == someFunc a

withMessage :: String -> Rule -> Rule
withMessage msg rule val
  | isLeft output = Left msg
  | otherwise = output
  where
    output = rule val

withPredicate :: (FormValue -> Bool) -> Rule
withPredicate predicate val
  | predicate val = Right val
  | otherwise = Left "Failed predicate"

required :: Rule
required = withMessage "Required" (withPredicate (not . null))

minLength :: Int -> Rule
minLength min =
  withMessage
    ("Must be longer than " ++ show min)
    (withPredicate (\x -> min < length x))

maxLength :: Int -> Rule
maxLength max =
  withMessage
    ("Must be shorter than " ++ show max)
    (withPredicate (\x -> max < length x))

isNumeric :: FormValue -> Bool
isNumeric val = isJust (readMaybe val :: Maybe Integer)

numeric :: Rule
numeric = withMessage "Must be numeric" (withPredicate isNumeric)

lessThan :: Integer -> Rule
lessThan max =
  withMessage
    ("Must be less than " ++ show max)
    (withPredicate (\x -> max > read x))

greaterThan :: Integer -> Rule
greaterThan min =
  withMessage
    ("Must be greater than " ++ show min)
    (withPredicate (\x -> min < read x))

composeRules :: [Rule] -> Rule
composeRules rules val = foldr (=<<) (Right val) rules
-- | Usage
-- return "123" >>= required >>= numeric >>= lessThan 10
-- composeRules [lessThan 10, numeric, required] "123"
--
-- | TODO -- validate fn takes record of fields to validate & form values
-- How should this be typed? Validations needs to be a "subrecord" of FormValues
-- and FormErrors needs to be a "subrecord" of Validations
-- validateForm :: Validations -> FormValues -> FormErrors
-- Data Validation = Validation { name :: Rule, email :: Rule }
-- Data FormValues = FormValues { name :: String, email :: String, age :: Integer }
-- data FormErrors = FormErrors { name :: Maybe FormError, email :: Maybe FormError }