validate.hs

{-# language ExistentialQuantification #-}
{-# language NoMonomorphismRestriction #-}

import Data.List
import Data.List.Utils

data Validate a
    = Property String (a -> Bool)
    | Any [Validate a]
    | All [Validate a]
    | (:?) String (Validate a)
    | forall b . Projection (String, a -> b) (Validate b)
    | Not String (Validate a)

infix 0 ~>
infix 1 ?
(?) = Property
(~>) = Projection
(?=) = (:?)

data Result
    = Success
    | Failed String
    | FailedMany [Result]
    | String :~> Result
  deriving (Eq, Show)

has ws str = any (`isInfixOf` str) (words ws)
consistsOf set = all (`elem` set)
hasChar = elem

validate :: a -> Validate a -> Result
validate object scheme = case scheme of
    Property msg pred ->
        if pred object
        then Success
        else Failed msg

    Any subs ->
        let results = map (validate object) subs
        in  case foldl1 firstSuccess results of
            Success -> Success
            _       -> FailedMany results
      where
        firstSuccess Success _ = Success
        firstSuccess _       x = x

    All subs ->
        let results  = map (validate object) subs
            failures = filter (/= Success) results
        in  if null failures
            then Success
            else FailedMany failures

    Projection (name, proj) v ->
        case validate (proj object) v of
            Success -> Success
            other   -> name :~> other

    msg :? v ->
        case validate object v of
            Success -> Success
            _       -> Failed msg

    Not msg v ->
        case validate object v of
            Success -> Failed msg
            _       -> Success

data User = User
    { email    :: String
    , name     :: String
    , password :: String
    }

userValidation = All
    [ ("email", email) ~>
        "proper email"? (hasChar '@')
    , ("name", name) ~> All
        [ ("length", length) ~> All
            [ ">= 3 chars"?  (>= 3)
            , "<= 20 chars"? (<= 20)
            ]
        , "consists of alphanum and '-'"?
            consistsOf (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-")
        , Not "bad words"
            ("bad"? has "shit crap")
        ]
    , ("password", password) ~> All
        [ ("length", length) ~> All
            [ ">= 8 chars"?   (>= 8)
            , "<= 256 chars"? (<= 256)
            ]
        , "has lowercase chars"? hasAny ['a'..'z']
        , "has uppercase chars"? hasAny ['A'..'Z']
        , "has alphanums"?       hasAny ['0'..'9']
        ]
    ]

testUser = User
    { email    = "lol-mail.ru"
    , name     = "crappy"
    , password = "123lold"
    }

main = print (testUser `validate` userValidation)
{- Will print:
    FailedMany
      [ "email" :~> Failed "proper email"
      , "name"  :~> FailedMany
          [ Failed "bad words" ],
        "password" :~> FailedMany
          [ "length" :~> FailedMany
              [ Failed ">= 8 chars" ]
          , Failed "has uppercase chars"
          ]
      ]

-}

validate.js

var any      = (...vs)      => ["any", ...vs]
var all      = (...vs)      => ["all", ...vs]
var prop     = (msg, p)     => ["prop", msg, p]
var describe = (message, v) => ["describe", message, v]
var fields   = (scheme)     => ["fields", scheme]
var not      = (msg, v)     => ["not", msg, v]

var matches = (string) =>
    prop("matches " + string, (input) =>
        input.match(string))

var length = (msg, lenPred) =>
    map((str) => str.length, prop(msg, lenPred))

var map = (f, v) => ["map", f, v]

var validateWith = (template, object) => {
    let [head, ...tail] = template
    switch (head) {
        case "all": {
            let errors = tail.
                map(t => validateWith(t, object)).
                filter(x => x)

            return errors.length? ["all", ...errors] : null
        }

        case "any": {
            var acc = []
            for (var i = 0; i < tail.length; i++) {
                let sub = validateWith(tail[i], object)
                if (!sub)
                    return null

                acc.push(sub)
            }
            return ["any", ...acc]
        }

        case "prop": {
            let [msg, prop] = tail
            return prop(object) ? null : msg
        }

        case "describe": {
            let [msg, v] = tail
            let  sub     = validateWith(v, object)
            return sub ? msg : null
        }

        case "fields": {
            let [o] = tail
            var acc = {}
            var hasErrors = false
            for (var key in o) {
                let sub = validateWith(o[key], object[key])
                if (sub) {
                    acc[key] = sub
                    hasErrors = true
                }
            }
            return hasErrors? ["fields", acc] : null
        }

        case "not": {
            let [msg, v] = tail
            let sub = validateWith(v, object)

            return sub? null: msg;
        }

        case "map": {
            let [f, v] = tail
            let projected = f(object)
            return validateWith(v, projected)
        }
    }
}

var makeValidatorFromScheme = (scheme) => (o) =>
    validateWith(scheme, o)

var validateUser = makeValidatorFromScheme(
    fields({
        email: describe("proper email",
            matches(".*@.*")
        ),
        name: all(
            describe("contains only alphanumeric and '-'",
                matches("[A-Za-z0-9-]*")
            ),
            length(">= 3 chars",  (len) => len >= 3),
            length("<= 20 chars", (len) => len <= 20),
            describe("no shit",
                not("bad word", matches("shit|crap"))
            )
        ),
        password: all(
            describe("has lower chars",   matches("[a-z]")),
            describe("has capital chars", matches("[A-Z]")),
            describe("has numeric chars", matches("[0-9]")),
            length(">= 8 chars", (len) => len >= 8)
        )
    })
)

// validator will produce "null" on success and non-null structure on failure

console.log(validateUser({
    email: "hui-mail.ru",
    name: "crappy-nickname",
    password: "lol567"
}));

// Will print:
//  [ 'fields',
//      { name: [ 'all', 'no shit' ],
//          password: [ 'all', 'has capital chars', '>= 8 chars' ] } ]

console.log(validateUser({
    email: "[email protected]",
    name: "cparry-nickname",
    password: "loLd5671"
}));

// Will print:
//  null