Commit f7cacb89 authored by MrMan's avatar MrMan

Adding the concept of validity

parent 4cba30e8
......@@ -6,8 +6,10 @@
module Types where
import Data.Text
import Data.Functor.Identity
import qualified Data.Text as DT
import Data.Either (isRight)
import Data.Maybe (isJust, fromJust)
import Data.Functor.Identity (Identity(..))
----------------
-- First Stab --
......@@ -65,9 +67,9 @@ import Data.Functor.Identity
-------------------------------------------
-- Individual separate types for tasks to enable specifying them as part of (Task f state)
data Finished = FinishedTask deriving (Eq, Read, Show)
data InProgress = InProgressTask deriving (Eq, Read, Show)
data NotStarted = NotStartedTask deriving (Eq, Read, Show)
data Finished = FinishedState deriving (Eq, Read, Show)
data InProgress = InProgressState deriving (Eq, Read, Show)
data NotStarted = NotStartedState deriving (Eq, Read, Show)
-- Task state for abstracting over TaskState
data TaskState = Finished
......@@ -75,8 +77,8 @@ data TaskState = Finished
| NotStarted deriving (Eq, Enum, Read, Show)
-- Newtypes preventing careless
newtype TaskName = TaskName { getTName :: Text } deriving (Eq, Show)
newtype TaskDesc = TaskDesc { getTDesc :: Text } deriving (Eq, Show)
newtype TaskName = TaskName { getTName :: DT.Text } deriving (Eq, Show)
newtype TaskDesc = TaskDesc { getTDesc :: DT.Text } deriving (Eq, Show)
-- The beefy task class
data Task f state = Task { tName :: f TaskName
......@@ -89,15 +91,15 @@ type CompletedTask = Task Identity Finished
deriving instance Eq CompletedTask
deriving instance Show CompletedTask
-- Incomplete, partially specified tasks
type IncompletePartialTask = Task Maybe InProgress
deriving instance Eq IncompletePartialTask
deriving instance Show IncompletePartialTask
-- InProgress, partially specified tasks
type InProgressPartialTask = Task Maybe InProgress
deriving instance Eq InProgressPartialTask
deriving instance Show InProgressPartialTask
-- Incomplete, fully specified tasks
type IncompleteTask = Task Identity InProgress
deriving instance Eq IncompleteTask
deriving instance Show IncompleteTask
-- InProgress, fully specified tasks
type InProgressTask = Task Identity InProgress
deriving instance Eq InProgressTask
deriving instance Show InProgressTask
-- Not started, partially specified tasks
type NotStartedPartialTask = Task Maybe NotStarted
......@@ -108,3 +110,78 @@ deriving instance Show NotStartedPartialTask
type NotStartedTask = Task Identity NotStarted
deriving instance Eq NotStartedTask
deriving instance Show NotStartedTask
----------------
-- Validation --
----------------
newtype FieldName = FieldName { getFieldName :: DT.Text } deriving (Eq, Show, Read)
data ValidationError = InvalidField FieldName
| MissingField FieldName deriving (Eq, Show, Read)
data Validated t = Validated t
type ValidationCheck t = t -> Maybe ValidationError
class Validatable t where
-- | Helper method to quickly determine of a type is valid
isValid :: t -> Bool
isValid = either (const True) (const False) . validate
-- | Run all checks on the validated
validate :: t -> Either [ValidationError] (Validated t)
validate t = if null errors then Right (Validated t) else Left errors
where
checkResults = [check t | check <- validationChecks]
errors = [fromJust e | e <- checkResults, isJust e]
-- | List of validation checks to run on the type (any of which could produce an error)
validationChecks :: [ValidationCheck t]
type FullySpecifiedTask = Task Identity
type PartialTask = Task Maybe
taskNameField :: FieldName
taskNameField = FieldName "name"
taskDescField :: FieldName
taskDescField = FieldName "description"
-- | Helper function to access task name for fully specified task
-- this works for both `FullySpecifiedTask state` (where state can vary, e.g. s`CompletedTask`(~`Task Identity Finished`) or `IncompleteTask`s (~`Task Identity InProgress`)
fsTaskName :: FullySpecifiedTask state -> DT.Text
fsTaskName = DT.strip . getTName . runIdentity . tName
fsTaskDesc :: FullySpecifiedTask state -> DT.Text
fsTaskDesc = DT.strip . getTDesc . runIdentity . tDescription
instance Validatable (FullySpecifiedTask state) where
validationChecks = [checkName, checkDescription]
where
checkName :: (FullySpecifiedTask state) -> Maybe ValidationError
checkName t = if DT.null (fsTaskName t) then Just (InvalidField taskNameField) else Nothing
checkDescription :: (FullySpecifiedTask state) -> Maybe ValidationError
checkDescription t = if DT.null (fsTaskDesc t) then Just (InvalidField taskDescField) else Nothing
pTaskName :: PartialTask state -> Maybe DT.Text
pTaskName = (DT.strip . getTName <$>) . tName
pTaskDesc :: PartialTask state -> Maybe DT.Text
pTaskDesc = (DT.strip . getTDesc <$>) . tDescription
instance Validatable (PartialTask state) where
validationChecks = [checkName, checkDescription]
where
checkName :: (PartialTask state) -> Maybe ValidationError
checkName = maybe (Just (MissingField taskNameField)) notEmptyIfPresent . pTaskName
where
notEmptyIfPresent :: DT.Text -> Maybe ValidationError
notEmptyIfPresent v = if DT.null v then Just (InvalidField taskNameField) else Nothing
checkDescription :: (PartialTask state) -> Maybe ValidationError
checkDescription = maybe (Just (MissingField taskDescField)) notEmptyIfPresent . pTaskDesc
where
notEmptyIfPresent :: DT.Text -> Maybe ValidationError
notEmptyIfPresent v = if DT.null v then Just (InvalidField taskDescField) else Nothing
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment