ContravariantLogging.purs

ContravariantLogging.purs

module ContravariantLogging where

import Prelude

import Data.Either (Either(..))
import Data.Tuple (Tuple(..))

-- See https://kowainik.github.io/posts/2018-09-25-co-log

--      Logger m a = Logger (Op (m Unit) a)
newtype Logger m a = Logger (a -> m Unit)

-- | Log a record to the logger.
-- | Equivalent to `MonadTell`'s `tell` but without
-- | the functional dependency incurred by that constraint.
log :: forall m a. Logger m a -> a -> m Unit
log (Logger l) = l

-- | Run both actions on the same input
append :: forall m a. Apply m => Logger m a -> Logger m a -> Logger m a
append (Logger action1) (Logger action2) = Logger \a -> action1 a *> action2 a

-- | Don't do anything for this logger's action.
mempty :: forall m a. Applicative m => Logger m a
mempty = Logger \_ -> pure unit

-- | Transform the logger such that it ignores records for which the predicate
-- | returns false.
cfilter :: forall m a. Applicative m => (a -> Boolean) -> Logger m a -> Logger m a
cfilter f (Logger l) = Logger \r -> when (f r) (l r)

-- | Transform the logger such that it ignores records for which the predicate
-- | returns false.
cfilterM :: forall m a. Monad m => (a -> m Boolean) -> Logger m a -> Logger m a
cfilterM f (Logger l) = Logger \r -> whenM (f r) (l r)

-- | Change the input type. Can be used to
-- | 1. Prepend/Append information (i.e. type is unchanged)
-- | 2. Bring the input value closer to the final logged value
-- |    (e.g. `MyLoggedValueType` to `String`)
-- | 3. Selects a smaller part out of some larger value (e.g. `\r -> r.label`).
cmap :: forall m a b. (a -> b) -> Logger m b -> Logger m a
cmap aToB (Logger bToMUnit) = Logger \a -> bToMUnit (aToB a)

-- | Log a larger value `a` by splitting it into two smaller pieces
-- | and logging each piece separately.
-- | Embeds the notion of `AND`
divide :: forall m a b c. Apply m => (a -> Tuple b c) -> Logger m b -> Logger m c -> Logger m a
divide f (Logger bToMUnit) (Logger cToMUnit) = Logger \a -> case f a of
  Tuple b c -> bToMUnit b *> cToMUnit c

-- | This would be easier to deal with at the cost of being more costly to write/run.
-- | The order of the actions would also depend on the alphbetical order of the record labels,
-- | not the order of their appearance in the record.
-- divideR :: forall m a b. Apply m => (a -> Record b) -> Record rows -> Logger m a
-- divideR f rec = Logger \a -> htraverse rec $ f a

-- | Log two things separately as though it was a larger thing.
divided :: forall m b c. Apply m => Logger m b -> Logger m c -> Logger m (Tuple b c)
divided (Logger bToMUnit) (Logger cToMUnit) = Logger \(Tuple b c) ->
  bToMUnit b *> cToMUnit c

-- | `mempty` at the `divide` or `choose` layer.
conquer :: forall m a. Applicative m => Logger m a
conquer = Logger \_ -> pure unit

-- | Determine whether to run the first or second logger based on the function `f`.
-- | Embeds the notion of `OR`
choose :: forall m a b c. Apply m => (a -> Either b c) -> Logger m b -> Logger m c -> Logger m a
choose f (Logger bToMUnit) (Logger cToMUnit) = Logger \a -> case f a of
  Left b -> bToMUnit b
  Right c -> cToMUnit c

-- | This would be easier to use at the cost of being harder to write/run
-- chooseR :: forall m a b c. Apply m => (a -> Variant rows) -> Record rows -> Logger a
-- chooseR f rec = Logger \a -> V.case_ # onMatch rec (f a)

-- | Acts as a sort of filter. Log only one of the two possibilities.
choosen
  :: forall m b c
   . Apply m
  => Logger m b
  -> Logger m c
  -> Logger m (Either b c)
choosen (Logger bToMUnit) (Logger cToMUnit) = Logger case _ of
  Left b -> bToMUnit b
  Right c -> cToMUnit c

-- | This seems to be: if you can prove that `a` won't happen
-- | then it's also proven that this logger's action won't happen.
lose :: forall m a. Applicative m => (a -> Void) -> Logger m a
lose aToVoid = Logger \a -> absurd (aToVoid a)

-- | A logger for `Void`. Needed to deal with things like `Logger m (Either a Void)`.
lost :: forall m. Applicative m => Logger m Void
lost = Logger \a -> absurd a

-- | Apply a natural transformation to the underlying functor.
hoist :: forall m m' a. (m ~> m') -> Logger m a -> Logger m' a
hoist f (Logger l) = Logger (f <<< l)