validation-prism.hs

-- | A 'Validator a b' is in particular a '(Applicative f, Choice p) => p a (f b)'.
type Validator a b = a -> Validation ValidationErrors b

-- | Lift a 'Getting (Maybe a) s (Maybe a)' into a 'Prism'. This should only be used if the
-- target domain type is a 'Maybe b'. 
--
-- Note that error messages from 'Validator's consumed in this way are preserved.
--
-- @
-- 'validating' :: Getting (Maybe a) s (Maybe a) -> Validator a b -> Validator s (Maybe b)
-- @
--
-- Usage:
-- >>> validating _1 f $ (Nothing, 2)
-- Success Nothing
--
-- >>> validating _1 f $ (Just [], 2)
-- Success (Just Nothing)
--
-- >>> validating _1 f $ (Just [1,2], 2)
-- Failure (InvalidRecord "List is too long!" :| [])
--
-- >>> (_Right . validating _1) f $ Right (Nothing, 2)
-- Success (Right Nothing)
--
-- >>> matching (_Right . validating _1) $ Right (Nothing, 2)
-- Left (Right Nothing)
--
-- >>> matching (_Right . validating _1) $ Right (Just [], 2)
-- Right []
--
validating :: Getting (Maybe a) s (Maybe a) -> Prism s (Maybe b) a b 
validating field = prism Just $ note Nothing . view field

-- | Non-prismatic version of 'validating'. 
--
-- Usage:
-- >>> validateThen "first" _1 f $ (Nothing, 2)
-- Failure (MissingField "first" :| [])
--
-- >>> validateThen "first" _1 f $ (Just [], 2)
-- Success Nothing
--
-- >>> validateThen "first" _1 f $ (Just [1,2], 2)
-- Failure (InvalidRecord "List is too long!" :| [])
--
validateThen :: Text -> Getting (Maybe a) s (Maybe a) -> Validator a c -> Validator s c
validateThen name field = rmap handleMaybe . validating field
  where handleMaybe = over _Validation (>>= note (pure $ MissingField name))

-- | Lift a 'Getting (First a) s a' into a 'Prism'.
--
-- @
-- 'validating'' :: Getting (First a) s a -> Validator a b -> Validator s (Maybe b)
-- @
--
-- Usage:
-- >>> _Right f $ Right [1]
-- Success (Right (Just 1))
--
-- >>> validating' _Right f $ Right [1]
-- Success (Just (Just 1))
--
-- >>> validating' _Success f $ Success [1]
-- Success (Just (Just 1))
--
-- >>> let g = validatePrism "list" _Just
--
-- >>> validating' _Success f $ g (Just [1,2])
-- Failure (InvalidRecord "List is too long!" :| [])
--
validating' :: Getting (First a) s a -> Prism s (Maybe b) a b 
validating' field = prism Just $ note Nothing . preview field