Created
September 18, 2014 06:00
-
-
Save chendrix/302d0c421813b4b09fe6 to your computer and use it in GitHub Desktop.
"Policy" implementation in haskell
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Policy where | |
import Data.List | |
type Reason = String | |
type Reasons = [Reason] | |
data Policy = Invalid Reasons | Valid | |
instance Show Policy where | |
show Valid = "Valid" | |
show (Invalid reasons) = "Invalid: " ++ (intercalate ". " reasons) -- intercalate == Ruby's join | |
and :: Policy -> Policy -> Policy | |
and Valid Valid = Valid | |
and Valid second = second | |
and first Valid = first | |
and (Invalid firstReasons) (Invalid secondReasons) = Invalid (firstReasons ++ secondReasons) | |
or :: Policy -> Policy -> Policy | |
or Valid _ = Valid | |
or _ Valid = Valid | |
or (Invalid firstReasons) (Invalid secondReasons) = Invalid (firstReasons ++ secondReasons) | |
not :: Policy -> Reasons -> Policy | |
not (Invalid _) _ = Valid | |
not Valid reasons = Invalid reasons | |
return :: Bool -> Reasons -> Policy | |
return True _ = Valid | |
return False reasons = Invalid reasons | |
---Domain specific stuff------------------------------------------------------------------ | |
data Episode = Episode { free :: Bool } deriving Show | |
isFree :: Episode -> Policy | |
isFree episode = Policy.return (free episode) ["Episode is not free"] | |
data User = User { subscriber :: Bool } deriving Show | |
isCurrentSubscriber :: User -> Policy | |
isCurrentSubscriber user = Policy.return (subscriber user) ["User is not a current subscriber"] | |
isAvailableToUser :: Episode -> User -> Policy | |
isAvailableToUser episode user = (isFree episode) `Policy.or` (isCurrentSubscriber user) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment