<commit_before>{-# LANGUAGE CPP #-}
module Bead.View.Snap.Validators where

import Prelude

#ifndef FAY
import Data.List (find)
import Bead.Invariants (Assertion(..))
#endif

{- This module is compiled with Fay and Haskell -}

-- | Validator for an input field
data FieldValidator = FieldValidator {
    validator :: String -> Bool -- Produces True if the String is valid
  , message   :: String         -- The message to shown when the validation fails
  }

validate :: FieldValidator -> String -> a -> (String -> a) -> a
validate f v onValid onFail
  | validator f v = onValid
  | otherwise     = onFail (message f)

isUsername :: FieldValidator
isUsername = FieldValidator {
    validator = \xs -> ((length xs) == 6) && (all isAlphaNum xs)
  , message   = "NEPTUN-kódot kell megadni!"
  }

isPassword :: FieldValidator
isPassword = FieldValidator {
    validator = (>=4) . length
  , message   = "4 karakternél hosszabbnak kell lennie!"
  }

isEmailAddress :: FieldValidator
isEmailAddress = FieldValidator {
    validator = emailAddress
  , message   = "Nem fogadható el email címnek!"
  }

isDateTime :: FieldValidator
isDateTime = FieldValidator {
    validator = dateTime
  , message   = "Hibás dátum vagy idő!"
  }

isDigit :: Char -> Bool
isDigit c = elem c "0123456789"

toLower :: Char -> Char
toLower c =
  let v = find ((c==).fst) $
            zip "QWERTZUIOPASDFGHJKLYXCVBNM"
                "qwertzuiopasdfghjklyxcvbnm"
  in case v of
       Nothing -> c
       Just c' -> snd c'

isAlpha :: Char -> Bool
isAlpha c = elem (toLower c) "qwertzuiopasdfghjklyxcvbnm"

isAlphaNum :: Char -> Bool
isAlphaNum c =
  if (isAlpha c)
     then True
     else (isDigit c)

emailAddress :: String -> Bool
emailAddress []     = False
emailAddress (c:cs) = isAlpha c && isEmailBody cs
  where
    isSpecial :: Char -> Bool
    isSpecial c = elem c "._,!-():;<>[\\]"

    isEmailChar :: Char -> Bool
    isEmailChar c = or [isAlpha c, isDigit c, isSpecial c]

    isEmailBody [] = False
    isEmailBody ('@':cs) = isEmailRest cs
    isEmailBody (c:cs)
      | isEmailChar c = isEmailBody cs
      | otherwise     = False

    isEmailRest []    = True
    isEmailRest ['.'] = False
    isEmailRest (c:cs)
      | isEmailChar c = isEmailRest cs
      | otherwise     = False

dateTime :: String -> Bool
dateTime s = case s of
  [y1,y2,y3,y4,'-',m1,m2,'-',d1,d2,' ',hr1,hr2,':',mn1,mn2,':',sc1,sc2] ->
    all isDigit [y1,y2,y3,y4,m1,m2,d1,d2,hr1,hr2,mn1,mn2,sc1,sc2]
  _ -> False

#ifndef FAY
assertEmailAddress = [
    Assertion "Empty"     (emailAddress "") False
  , Assertion "One char"  (emailAddress "q") False
  , Assertion "One char"  (emailAddress "1") False
  , Assertion "Only user" (emailAddress "q.dfs") False
  , Assertion "Valid"     (emailAddress "<EMAIL>") True
  , Assertion "Invalid"   (emailAddress "<EMAIL>.") False
  ]
#endif<commit_msg>Gmail compatible email address validator<commit_after>{-# LANGUAGE CPP #-}
module Bead.View.Snap.Validators where

import Prelude

#ifndef FAY
import Data.List (find)
import Bead.Invariants (Assertion(..))
#endif

{- This module is compiled with Fay and Haskell -}

-- | Validator for an input field
data FieldValidator = FieldValidator {
    validator :: String -> Bool -- Produces True if the String is valid
  , message   :: String         -- The message to shown when the validation fails
  }

validate :: FieldValidator -> String -> a -> (String -> a) -> a
validate f v onValid onFail
  | validator f v = onValid
  | otherwise     = onFail (message f)

isUsername :: FieldValidator
isUsername = FieldValidator {
    validator = \xs -> ((length xs) == 6) && (all isAlphaNum xs)
  , message   = "NEPTUN-kódot kell megadni!"
  }

isPassword :: FieldValidator
isPassword = FieldValidator {
    validator = (>=4) . length
  , message   = "4 karakternél hosszabbnak kell lennie!"
  }

isEmailAddress :: FieldValidator
isEmailAddress = FieldValidator {
    validator = emailAddress
  , message   = "Nem fogadható el email címnek!"
  }

isDateTime :: FieldValidator
isDateTime = FieldValidator {
    validator = dateTime
  , message   = "Hibás dátum vagy idő!"
  }

isDigit :: Char -> Bool
isDigit c = elem c "0123456789"

toLower :: Char -> Char
toLower c =
  let v = find ((c==).fst) $
            zip "QWERTZUIOPASDFGHJKLYXCVBNM"
                "qwertzuiopasdfghjklyxcvbnm"
  in case v of
       Nothing -> c
       Just c' -> snd c'

isAlpha :: Char -> Bool
isAlpha c = elem (toLower c) "qwertzuiopasdfghjklyxcvbnm"

isAlphaNum :: Char -> Bool
isAlphaNum c =
  if (isAlpha c)
     then True
     else (isDigit c)

emailAddress :: String -> Bool
emailAddress []     = False
emailAddress (c:cs) = isEmailChar c && isEmailBody cs
  where
    isSpecial :: Char -> Bool
    isSpecial c = elem c "._,!-():;<>[\\]"

    isEmailChar :: Char -> Bool
    isEmailChar c = or [isAlpha c, isDigit c, isSpecial c]

    isEmailBody [] = False
    isEmailBody ('@':cs) = isEmailRest cs
    isEmailBody (c:cs)
      | isEmailChar c = isEmailBody cs
      | otherwise     = False

    isEmailRest []    = True
    isEmailRest ['.'] = False
    isEmailRest (c:cs)
      | isEmailChar c = isEmailRest cs
      | otherwise     = False

dateTime :: String -> Bool
dateTime s = case s of
  [y1,y2,y3,y4,'-',m1,m2,'-',d1,d2,' ',hr1,hr2,':',mn1,mn2,':',sc1,sc2] ->
    all isDigit [y1,y2,y3,y4,m1,m2,d1,d2,hr1,hr2,mn1,mn2,sc1,sc2]
  _ -> False

#ifndef FAY
assertEmailAddress = [
    Assertion "Empty"     (emailAddress "") False
  , Assertion "One char"  (emailAddress "q") False
  , Assertion "One char"  (emailAddress "1") False
  , Assertion "Only user" (emailAddress "q.dfs") False
  , Assertion "Valid"     (emailAddress "<EMAIL>") True
  , Assertion "Valid 2"   (emailAddress "<EMAIL>.") True
  ]
#endif
{'fraction_non_alphanumeric': 0.12639275766016714, 'fraction_numerical': 0.014798050139275766, 'mean_word_length': 3.045774647887324, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 49, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7549191', 'n_tokens_mistral': 2064, 'n_tokens_neox': 2006, 'n_words': 572}