{-# OPTIONS_GHC -Wall #-}

{-# LANGUAGE

    BangPatterns, BlockArguments, DeriveFunctor,
    DerivingStrategies, GADTs, LambdaCase,
    ScopedTypeVariables, StandaloneDeriving,
    TypeApplications

#-}

module Control.Grab
  (
  -- * Types
  -- ** The Grab type
    Grab (..)
  -- ** Aliases: Simple, Dump, Result, Extract
  , Simple, Dump, Result, Extract

  -- * Creation
  -- ** Making grabs
  , partition, (/)
  -- ** Making dumps
  , dump, discardResidue
  -- ** Making extracts
  , success, failure, warning, extract

  -- * Use
  -- ** Applying a grab to an input
  , runGrab, runDump
  -- ** Deconstructing results
  , residue, log, desideratum
  -- ** Both applying and deconstructing
  , 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 ()


--- The Grab type ---

{- |

A 'Grab':

  1. Consumes some portion (none, part, or all) of its input
     __@bag@__;

  2. Returns a 'Result':

      * A __@residue@__ consisting of the unconsumed input;

      * Some monoidal __@log@__ e.g. a list of error messages;

      * Some __@desideratum@__ (the object of desire) produced from
        the consumed input, or @Nothing@ if the grab failed.

Specializations of this type:

  * If the bag and residue types are the same, the grab
    is a __'Simple'__ grab and it has an 'Applicative' instance.

  * If the residue is @()@, the grab is a __'Dump'__; it
    dumps out the entire bag so there is nothing remaining.

  * If the bag is @()@, the grab is just a single fixed
    __'Result'__, which consists of the residue, log, and
    maybe the desideratum.

  * If both the bag and residue are @()@, the grab is
    just the __'Extract'__, which consists of the log and
    maybe the desideratum.

-}

newtype Grab bag residue log desideratum =
  Grab
    (bag -> (residue, log, Maybe desideratum))


--- Type aliases ---

{- |

A 'Simple' grab:

  1. Consumes some portion (none, part, or all) of its input
     __@bag@__;

  2. Returns a 'Result':

      * A modified __@bag@__ representing the unconsumed
        portion of the input;

      * Some monoidal __@log@__ e.g. a list of error messages;

      * Some __@desideratum@__ (the object of desire) produced from
        the consumed input, or @Nothing@ if the grab failed.

-}

type Simple bag log desideratum = Grab bag bag log desideratum

{- | A 'Dump':

  1. Consumes all of its input __@bag@__;

  2. Returns a 'Extract':

      * Some monoidal __@log@__ e.g. a list of error messages;

      * Some __@desideratum@__ (the object of desire) produced from
        the consumed input, or @Nothing@ if the grab failed.
-}

type Dump bag log desideratum = Grab bag () log desideratum

{- | The result of performing a 'Grab'. Consists of:

  * A __@residue@__ consisting of the unconsumed input;

  * Some monoidal __@log@__ e.g. a list of error messages;

  * Some __@desideratum@__ (the object of desire) produced from
    the consumed input, or @Nothing@ if the grab failed.
-}

type Result residue log desideratum = Grab () residue log desideratum

{- | What is produced by performing a 'Dump'. Consists of:

  * Some monoidal __@log@__ e.g. a list of error messages;

  * Some __@desideratum@__ (the object of desire) produced from
    the consumed input, or @Nothing@ if the grab failed.
-}

type Extract log desideratum = Grab () () log desideratum


--- Functor ---

deriving stock instance Functor (Grab bag residue log)


--- Applicative functor ---

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)


--- Bifunctor ---

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)


--- Creating grabs ---

-- | The most general way to construct an 'Extract'.
extract :: forall log desideratum.
    log
        -- ^ Log output, such as an error or warning message.
    -> Maybe desideratum
        -- ^ 'Just' some desideratum if the extract represents the
        --   outcome of a successful grab, or 'Nothing' if it
        --   represents failure.
    -> Extract log desideratum
        -- ^ An extract consisting of the given log and desideratum.

extract :: log -> Maybe desideratum -> Extract log desideratum
extract 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
        -- ^ The desired object.
    -> Extract log desideratum
        -- ^ A successful extract with an empty log.

failure :: forall log desideratum.
    log
        -- ^ Log output such as an error message.
    -> Extract log desideratum
        -- ^ An extract with the given log and no desideratum.

warning :: forall log.
    log
        -- ^ Log output such as a warning message.
    -> Extract log ()
        -- ^ An extract with the given log and a desideratum of @()@.

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))
        -- ^ Function that partitions the bag into desideratum and residue.
    -> Grab bag residue log desideratum
        -- ^ A grab that always succeeds and never logs.

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)
        -- ^ A function which, given the entire input, produces
        --   some log output and maybe a desideratum.
    -> Dump bag log desideratum
        -- ^ A grab that consumes the entire bag, producing
        --   whatever the function extracted from its contents.

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)

-- | @a / b@ is a pipeline of two grabs, using the output of /a/
-- as the input to /b/.
(/) :: forall bag residue _r log x desideratum. Semigroup log =>
    Grab bag residue log x
        -- ^ The first grab /a/, whose desideratum @x@ will be
        --   passed as input to the second grab /b/.
    -> Grab x _r log desideratum
        -- ^ The second grab /b/. The residue of this grab will be
        --   ignored, so it usually ought to be a 'Dump'.
    -> Grab bag residue log desideratum
        -- ^ A grab whose result is the residue of /a/, the combined
        --   logs of both /a/ and /b/, and the desideratum of /b/.

/ :: 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
        -- ^ A grab which may produce some residue.
    -> Dump bag log desideratum
        -- ^ A grab that produces no residue.

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)


--- Using grabs ---

-- | When @residue@ is @()@, this function specializes to 'runDump'.
runGrab :: forall bag residue log desideratum.
    Grab bag residue log desideratum
        -- ^ A grab, which may consume some portion of the input.
    -> bag
        -- ^ The input.
    -> Result residue log desideratum
        -- ^ The result of performing the grab, which consists of
        --   the @residue@ representing the remaining portion of
        --   input, a @log@ for providing error output, and a
        --   @desideratum@ if the grab was successful.

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

-- | This is a specialization of the more general 'runGrab' function.
runDump :: forall bag log desideratum.
    Dump bag log desideratum
        -- ^ A dump which consumes the input.
    -> bag
        -- ^ The input.
    -> Extract log desideratum
        -- ^ The result extracted from the input, which
        --   consists of a @log@ for providing error output
        --   and a @desideratum@ if the grab was successful.

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

-- | Run a grab, ignoring the residue and log, producing only
-- the desideratum.
--
-- > runGrabMaybe x = desideratum . runGrab x
--
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
        -- ^ Either a 'Result' or an 'Extract'.
    -> Maybe desideratum
        -- ^ The desired object, if one was successfully
        --   extracted from the bag.

log :: forall residue log desideratum.
    Result residue log desideratum
        -- ^ Either a 'Result' or an 'Extract'.
    -> log
        -- ^ Any extra information produced during the
        --   grab, such as error messages.

residue :: forall residue log desideratum.
    Result residue log desideratum
        -- ^ The result of 'run'ning a 'Grab'
    -> residue
        -- ^ The portion of the bag that was not consumed
        --   by the grab.

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