{-# LANGUAGE OverloadedStrings #-}

-- | Validate values, such as common user inputs; emails, age,
--   address, credit card, web address, etc.

module Data.Validate
    (-- Exports
     module Data.GenericString
     -- Types
    , Test
     -- * Validation 
    , validate
     -- * Testing utilities
    , test
    , label
     -- * Testing functions
    , equal
    , isInt
    , less
    , more
    , age
    , email
    , pattern
     -- * Conversion functions
    , int
    , float
    )
    where

import Data.Char (isDigit)
import Data.Maybe (isJust)
import Control.Monad ((>=>))
import Text.Regex (matchRegex, mkRegex)
import Data.GenericString

------------------------------------------------------------------------------
-- Testing framework

-- | Validate some input with testing function.
validate :: Str e =>
            Test e a b  -- ^ Test to perform.
         -> a           -- ^ Value on which to perform the test.
         -> Maybe [e]   -- ^ Maybe a list of errors, or Nothing, meaning
                        --   success.
validate t v = toMaybe (Ok (Just v) >>= t) where
    toMaybe (Invalid _ err) = Just err
    toMaybe _               = Nothing

-- | A validation success, preserving the data.
ok :: Str e => a -> Input e (Maybe a)
ok = Ok . Just

-- | A test taking input and producing a new input.
type Test e a b = Maybe a -> Input e (Maybe b)

-- | Monad instance for testing inputs and keeping errors.
instance Str e => Monad (Input e) where
    return               = Ok
    Ok v        >>= test = test v
    Invalid v e >>= test =
        case test v of
          Ok v'         -> Invalid v' e
          Invalid v' e' -> Invalid v' (e' ++ e)

-- | A given input which is either "ok" or "invalid".
data Input e a = Ok a | Invalid a [e]


------------------------------------------------------------------------------
-- Testing utilities

-- | A generic testing function with a predicate, with type preservation.
test :: Str e => 
        e            -- ^ Error if predicate fails.
     -> (a -> Bool)  -- ^ Predicate to test the value with.
     -> Test e a a   -- ^ A test from a to a.
test e p v = maybe inv (\v -> if p v then ok v else inv) v where
    inv = Invalid v [e]

-- | Attach a \"label\" around a testing function which errors. This might be
--   useless.
label :: Str e =>
         e   -- ^ Error message to attach if test fails.
      -> Test e a b -- ^ Test whose result is checked for failure.
      -> Test e a b -- ^ A new test from a to b which shows the label as an
                    --   error on failure.
label l t v = case t v of
                Invalid v' es -> Invalid v' (l : es)
                ok            -> ok

-- | Make a test which tests a string according to a regular expression pattern.
pattern :: (Str e, Str s) =>
           e          -- ^ An error message if the match fails.
        -> s          -- ^ The regular expression
        -> Test e s s -- ^ The produced testing function.
pattern e r = test e (isJust . (matchRegex $ mkRegex reg) . strToString)
                      where reg = strToString r

------------------------------------------------------------------------------
-- Testing "predicates"

-- | Is equal to something.
equal :: (Show a, Eq a, Str e) => a -> Test e a a
equal a = test ("equal to " `appendStr` showToStr a) (==a)

-- | Check that a String contains an integer.
isInt :: Str e => Test e e e
isInt = test "numeric" (const True)

-- | Check that a a value is less than a specified value.
less :: (Str e, Ord a, Show a) =>
        a          -- ^ Something which the value being test must be less than.
     -> Test e a a -- ^ A test from a to a which tests this property.
less a = test ("less than " `appendStr` showToStr a) (< a)

-- | Like "less" but the value must be more than the specified value.
more :: (Str e, Ord a, Show a) => a -> Test e a a
more a = test ("more than " `appendStr` showToStr a) (> a)

-- | Test that a given age is correct (130 years of age max.). 
--  http://www.seniorjournal.com/NEWS/SeniorStats/5-12-03-NoOne123.htm
age :: (Str e, Str s) => Test e s Int
age = label "age" $ int >=> less 120

-- | Test that a given email is correct.
-- Based on http://www.hm2k.com/posts/what-is-a-valid-email-address
email :: (Str e, Str s) => Test e s s
-- The regex should be:
-- /^[\w!#$%&\'*+\/=?^`{|}~.-]+@(?:[a-z\d][a-z\d-]*(?:\.[a-z\d][a-z\d-]*)?)+\.(?:[a-z][a-z\d-]+)$/iD
email = pattern "valid email address" ""

------------------------------------------------------------------------------
-- Testing functions with conversion

-- | Check that a string contains an integer, and try to convert to an Int.
int :: (Str e, Str s) => Test e s Int
int = maybe inv (maybe inv ok . readToMaybeStr) where
    inv = Invalid Nothing ["integer"]

-- | Check that a string contains an integer, and try to convert to a Float.
float :: (Str e, Str s) => Test e s Float
float = maybe inv (maybe inv ok . readToMaybeStr) where
    inv = Invalid Nothing ["integer"]