{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE
BangPatterns, BlockArguments, DeriveFunctor,
DerivingStrategies, GADTs, LambdaCase,
ScopedTypeVariables, StandaloneDeriving,
TypeApplications
#-}
module Control.Grab
(
Grab (..)
, Simple, Dump, Result, Extract
, partition, (/)
, dump, discardResidue
, success, failure, warning, extract
, runGrab, runDump
, residue, log, desideratum
, runGrabMaybe
) where
import Control.Applicative (Applicative (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Function ((.))
import Data.Functor (Functor (..))
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import Prelude ()
newtype Grab bag residue log desideratum =
Grab
(bag -> (residue, log, Maybe desideratum))
type Simple bag log desideratum = Grab bag bag log desideratum
type Dump bag log desideratum = Grab bag () log desideratum
type Result residue log desideratum = Grab () residue log desideratum
type log desideratum = Grab () () log desideratum
deriving stock instance Functor (Grab bag residue log)
instance (bag ~ residue, Monoid log) =>
Applicative (Grab bag residue log)
where
pure :: a -> Grab bag residue log a
pure = a -> Grab bag residue log a
forall bag log desideratum.
Monoid log =>
desideratum -> Grab bag bag log desideratum
grabPure
<*> :: Grab bag residue log (a -> b)
-> Grab bag residue log a -> Grab bag residue log b
(<*>) = Grab bag residue log (a -> b)
-> Grab bag residue log a -> Grab bag residue log b
forall bag log x desideratum.
Monoid log =>
Grab bag bag log (x -> desideratum)
-> Grab bag bag log x -> Grab bag bag log desideratum
grabAp
grabPure :: forall bag log desideratum. Monoid log =>
desideratum -> Grab bag bag log desideratum
grabPure :: desideratum -> Grab bag bag log desideratum
grabPure desideratum
x = (bag -> (bag, log, Maybe desideratum))
-> Grab bag bag log desideratum
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \bag
bag -> (bag
bag, log
forall a. Monoid a => a
mempty, desideratum -> Maybe desideratum
forall a. a -> Maybe a
Just desideratum
x)
grabAp :: forall bag log x desideratum. Monoid log =>
Grab bag bag log (x -> desideratum) ->
Grab bag bag log x ->
Grab bag bag log desideratum
grabAp :: Grab bag bag log (x -> desideratum)
-> Grab bag bag log x -> Grab bag bag log desideratum
grabAp (Grab bag -> (bag, log, Maybe (x -> desideratum))
pf) (Grab bag -> (bag, log, Maybe x)
px) =
(bag -> (bag, log, Maybe desideratum))
-> Grab bag bag log desideratum
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \bag
bag ->
let
(bag
bag', log
log1, Maybe (x -> desideratum)
f) = bag -> (bag, log, Maybe (x -> desideratum))
pf bag
bag
(bag
bag'', log
log2, Maybe x
x) = bag -> (bag, log, Maybe x)
px bag
bag'
in
(bag
bag'', log
log1 log -> log -> log
forall a. Semigroup a => a -> a -> a
<> log
log2, Maybe (x -> desideratum)
f Maybe (x -> desideratum) -> Maybe x -> Maybe desideratum
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe x
x)
instance Bifunctor (Grab bag residue)
where
bimap :: (a -> b)
-> (c -> d) -> Grab bag residue a c -> Grab bag residue b d
bimap = (a -> b)
-> (c -> d) -> Grab bag residue a c -> Grab bag residue b d
forall bag residue a b c d.
(a -> b)
-> (c -> d) -> Grab bag residue a c -> Grab bag residue b d
bimapGrab
bimapGrab :: forall bag residue log log' a a'.
(log -> log') -> (a -> a') ->
Grab bag residue log a ->
Grab bag residue log' a'
bimapGrab :: (log -> log')
-> (a -> a') -> Grab bag residue log a -> Grab bag residue log' a'
bimapGrab log -> log'
f a -> a'
g (Grab bag -> (residue, log, Maybe a)
x) =
(bag -> (residue, log', Maybe a')) -> Grab bag residue log' a'
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \bag
bag ->
let
(residue
bag', log
lg, Maybe a
a) = bag -> (residue, log, Maybe a)
x bag
bag
in
(residue
bag', log -> log'
f log
lg, (a -> a') -> Maybe a -> Maybe a'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap @Maybe a -> a'
g Maybe a
a)
extract :: forall log desideratum.
log
-> Maybe desideratum
-> Extract log desideratum
log
x Maybe desideratum
y = (() -> ((), log, Maybe desideratum)) -> Extract log desideratum
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \() -> ((), log
x, Maybe desideratum
y)
success :: forall log desideratum. Monoid log =>
desideratum
-> Extract log desideratum
failure :: forall log desideratum.
log
-> Extract log desideratum
warning :: forall log.
log
-> Extract log ()
success :: desideratum -> Extract log desideratum
success desideratum
x = log -> Maybe desideratum -> Extract log desideratum
forall log desideratum.
log -> Maybe desideratum -> Extract log desideratum
extract log
forall a. Monoid a => a
mempty (desideratum -> Maybe desideratum
forall a. a -> Maybe a
Just desideratum
x)
failure :: log -> Extract log desideratum
failure log
x = log -> Maybe desideratum -> Extract log desideratum
forall log desideratum.
log -> Maybe desideratum -> Extract log desideratum
extract log
x (Maybe desideratum
forall a. Maybe a
Nothing)
warning :: log -> Extract log ()
warning log
x = log -> Maybe () -> Extract log ()
forall log desideratum.
log -> Maybe desideratum -> Extract log desideratum
extract log
x (() -> Maybe ()
forall a. a -> Maybe a
Just ())
partition :: forall bag residue log desideratum. Monoid log =>
(bag -> (desideratum, residue))
-> Grab bag residue log desideratum
partition :: (bag -> (desideratum, residue)) -> Grab bag residue log desideratum
partition bag -> (desideratum, residue)
f =
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \bag
i ->
let
(desideratum
s, residue
r) = bag -> (desideratum, residue)
f bag
i
in
(residue
r, log
forall a. Monoid a => a
mempty, desideratum -> Maybe desideratum
forall a. a -> Maybe a
Just desideratum
s)
dump :: forall bag log desideratum.
(bag -> Extract log desideratum)
-> Dump bag log desideratum
dump :: (bag -> Extract log desideratum) -> Dump bag log desideratum
dump bag -> Extract log desideratum
f =
(bag -> ((), log, Maybe desideratum)) -> Dump bag log desideratum
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \bag
i ->
let
p :: Extract log desideratum
p = bag -> Extract log desideratum
f bag
i
in
((), Extract log desideratum -> log
forall residue log desideratum.
Result residue log desideratum -> log
log Extract log desideratum
p, Extract log desideratum -> Maybe desideratum
forall residue log desideratum.
Result residue log desideratum -> Maybe desideratum
desideratum Extract log desideratum
p)
(/) :: forall bag residue _r log x desideratum. Semigroup log =>
Grab bag residue log x
-> Grab x _r log desideratum
-> Grab bag residue log desideratum
/ :: Grab bag residue log x
-> Grab x _r log desideratum -> Grab bag residue log desideratum
(/) (Grab bag -> (residue, log, Maybe x)
f) (Grab x -> (_r, log, Maybe desideratum)
g) =
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \bag
i ->
let
(residue
x, log
y, Maybe x
z) = bag -> (residue, log, Maybe x)
f bag
i
in
case Maybe x
z of
Maybe x
Nothing -> (residue
x, log
y, Maybe desideratum
forall a. Maybe a
Nothing)
Just x
a ->
let
(_r
_, log
y', Maybe desideratum
z') = x -> (_r, log, Maybe desideratum)
g x
a
in
(residue
x, log
y log -> log -> log
forall a. Semigroup a => a -> a -> a
<> log
y', Maybe desideratum
z')
discardResidue :: forall bag residue log desideratum .
Grab bag residue log desideratum
-> Dump bag log desideratum
discardResidue :: Grab bag residue log desideratum -> Dump bag log desideratum
discardResidue (Grab bag -> (residue, log, Maybe desideratum)
f) =
(bag -> ((), log, Maybe desideratum)) -> Dump bag log desideratum
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \bag
bag ->
let
(residue
_, log
y, Maybe desideratum
z) = bag -> (residue, log, Maybe desideratum)
f bag
bag
in
((), log
y, Maybe desideratum
z)
runGrab :: forall bag residue log desideratum.
Grab bag residue log desideratum
-> bag
-> Result residue log desideratum
runGrab :: Grab bag residue log desideratum
-> bag -> Result residue log desideratum
runGrab (Grab bag -> (residue, log, Maybe desideratum)
f) bag
x =
let
!r :: (residue, log, Maybe desideratum)
r = bag -> (residue, log, Maybe desideratum)
f bag
x
in
(() -> (residue, log, Maybe desideratum))
-> Result residue log desideratum
forall bag residue log desideratum.
(bag -> (residue, log, Maybe desideratum))
-> Grab bag residue log desideratum
Grab \() -> (residue, log, Maybe desideratum)
r
runDump :: forall bag log desideratum.
Dump bag log desideratum
-> bag
-> Extract log desideratum
runDump :: Dump bag log desideratum -> bag -> Extract log desideratum
runDump = Dump bag log desideratum -> bag -> Extract log desideratum
forall bag residue log desideratum.
Grab bag residue log desideratum
-> bag -> Result residue log desideratum
runGrab
runGrabMaybe :: forall bag residue log desideratum.
Grab bag residue log desideratum
-> bag
-> Maybe desideratum
runGrabMaybe :: Grab bag residue log desideratum -> bag -> Maybe desideratum
runGrabMaybe Grab bag residue log desideratum
x = Result residue log desideratum -> Maybe desideratum
forall residue log desideratum.
Result residue log desideratum -> Maybe desideratum
desideratum (Result residue log desideratum -> Maybe desideratum)
-> (bag -> Result residue log desideratum)
-> bag
-> Maybe desideratum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grab bag residue log desideratum
-> bag -> Result residue log desideratum
forall bag residue log desideratum.
Grab bag residue log desideratum
-> bag -> Result residue log desideratum
runGrab Grab bag residue log desideratum
x
desideratum :: forall residue log desideratum.
Result residue log desideratum
-> Maybe desideratum
log :: forall residue log desideratum.
Result residue log desideratum
-> log
residue :: forall residue log desideratum.
Result residue log desideratum
-> residue
residue :: Result residue log desideratum -> residue
residue (Grab () -> (residue, log, Maybe desideratum)
f) = let (residue
x, log
_, Maybe desideratum
_) = () -> (residue, log, Maybe desideratum)
f () in residue
x
log :: Result residue log desideratum -> log
log (Grab () -> (residue, log, Maybe desideratum)
f) = let (residue
_, log
x, Maybe desideratum
_) = () -> (residue, log, Maybe desideratum)
f () in log
x
desideratum :: Result residue log desideratum -> Maybe desideratum
desideratum (Grab () -> (residue, log, Maybe desideratum)
f) = let (residue
_, log
_, Maybe desideratum
x) = () -> (residue, log, Maybe desideratum)
f () in Maybe desideratum
x