-- | Validated values
--
-- 'Validated' is similar to 'Feldspar.Option.Option', with the difference that
-- 'Validated' does not guarantee that invalid values are not evaluated.
-- Therefore, 'Validated' should not be used to guard operations from illegal
-- use (e.g. array bounds checking).
--
-- Still, the operations try to defer evaluation of invalid values as much as
-- possible.
module Feldspar.Data.Validated where
-- Since there's no guarantee that invalid values are not evaluated, there is
-- no point in hiding the implementation. Having access to the implementation
-- means that it's possible to take shortcuts. For example, `fmap` could not
-- have been implemented without opening up the representation.
import Prelude ()
import Language.Syntactic
import Feldspar hiding (desugar, sugar)
import Feldspar.Representation
-- | A value that can be valid or invalid
data Validated a = Validated (Data Bool) a
instance Functor Validated
where
fmap f (Validated valid a) = Validated valid (f a)
instance Applicative Validated
where
pure = return
(<*>) = ap
instance Monad Validated
where
return = Validated true
Validated valid a >>= k = Validated (valid && valid') b
where
Validated valid' b = k a
instance Syntax a => Syntactic (Validated a)
where
type Domain (Validated a) = FeldDomain
type Internal (Validated a) = (Bool, Internal a)
desugar (Validated valid a) = desugar (valid,a)
sugar = uncurry Validated . sugar
-- | Create a validated value. Note that the value may get evaluated even if the
-- condition is false.
validWhen :: Data Bool -> a -> Validated a
validWhen = Validated
-- | Invalid value
invalid :: Syntax a => Validated a
invalid = Validated false example
-- | Deconstruct an 'Validated' value
validated :: Syntax b
=> b -- ^ Invalid case
-> (a -> b) -- ^ Valid case
-> Validated a
-> b
validated no yes (Validated valid a) = valid ? yes a $ no
-- | Deconstruct an 'Validated' value
caseValidated :: Syntax b
=> Validated a
-> b -- ^ Invalid case
-> (a -> b) -- ^ Valid case
-> b
caseValidated v no yes = validated no yes v
fromValidated :: Syntax a
=> Validated a
-> a -- ^ Value to return in case the first arg. is invalid
-> a
fromValidated v def = caseValidated v def id
-- | Deconstruct an 'Validated' value
validatedM :: MonadComp m
=> m () -- ^ Invalid case
-> (a -> m ()) -- ^ Valid case
-> Validated a
-> m ()
validatedM no yes (Validated valid a) = iff valid (yes a) no
-- | Deconstruct an 'Validated' value
caseValidatedM :: MonadComp m
=> Validated a
-> m () -- ^ Invalid case
-> (a -> m ()) -- ^ Valid case
-> m ()
caseValidatedM v no yes = validatedM no yes v