Dirty.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}

module Descript.Misc.Error.Dirty
  ( Dirty (..)
  , DirtyM
  , DirtyT
  , DirtyRes
  , DirtyResT
  , mapWarnings
  , mapWarningsT
  , resToDirtyMon
  , resToDirtyMonT
  , mkDirtyM
  , mkDirtyT
  , runDirtyM
  , runDirtyT
  , runDirtyRes
  , runDirtyResT
  ) where

import Descript.Misc.Error.Result
import Descript.Misc.Summary
import Data.Bifunctor
import Data.Tuple
import Control.Monad.Trans.Writer.Strict
import Data.Functor.Identity

-- | The result of performing an operation which can be used, but has
-- some warnings of type @w@. This is isomorphic to 'Writer', but
-- clearer and doesn't need 'runWriter', although it's not a 'Monad'.
data Dirty w a
  = Dirty
  { dirtyWarnings :: [w]
  , dirtyVal :: a
  } deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)

-- | 'Dirty' as a monad.
type DirtyM w a = Writer [w] a

-- | 'Dirty' monad transformer.
type DirtyT w u a = WriterT [w] u a

-- | Stacked 'Result' and 'Dirty' (uses 'DirtyM'). Can completely fail
-- with an error (and possibly some warnings), partially succeed with
-- warnings, or completely succeed.
type DirtyRes e w a = ResultT e (WriterT [w] Identity) a

-- | Further stacked 'DirtyRes'.
type DirtyResT e w u a = ResultT e (WriterT [w] u) a

instance (Summary w, Summary a) => Summary (Dirty w a) where
  summary (Dirty warnings x) = unlines
    $ summary x
    : "Warnings:"
    : map summary warnings

-- | Transforms the warnings in the 'Dirty'.
mapWarnings :: (w1 -> w2) -> Dirty w1 a -> Dirty w2 a
mapWarnings f (Dirty warns x) = Dirty (map f warns) x

-- | Transforms the warnings in the 'DirtyT'.
mapWarningsT :: (Monad u) => (w1 -> w2) -> DirtyT w1 u a -> DirtyT w2 u a
mapWarningsT = mapWriterT . fmap . second . map

-- | If the result succeeded, returns the value and no warnings.
-- If it failed, returns 'mempty' and the error as a single warning.
resToDirtyMon :: (Monoid a) => Result ew a -> Dirty ew a
resToDirtyMon (Success x) = Dirty [] x
resToDirtyMon (Failure err) = Dirty [err] mempty

-- | If the result succeeded, returns the value and no warnings.
-- If it failed, returns 'mempty' and the error as a single warning.
resToDirtyMonT :: (Monad u, Monoid a) => ResultT ew u a -> DirtyT ew u a
resToDirtyMonT = mkDirtyT . fmap resToDirtyMon . runResultT

-- | Converts a 'Dirty' into a 'DirtyM'.
mkDirtyM :: Dirty w a -> DirtyM w a
mkDirtyM = writer . dirtyToTuple

-- | Converts a wrapped 'Dirty' into a 'DirtyT'.
mkDirtyT :: (Monad u) => u (Dirty w a) -> DirtyT w u a
mkDirtyT = WriterT . fmap dirtyToTuple

-- | Converts a 'Dirty' into a 2-tuple for 'Writer's.
dirtyToTuple :: Dirty w a -> (a, [w])
dirtyToTuple (Dirty warns x) = (x, warns)

-- | Converts a 'DirtyM' into a 'Dirty'.
runDirtyM :: DirtyM w a -> Dirty w a
runDirtyM = uncurry Dirty . swap . runWriter

-- | Converts a 'DirtyT' into a wrapped 'Dirty'.
runDirtyT :: (Monad u) => DirtyT w u a -> u (Dirty w a)
runDirtyT = fmap (uncurry Dirty . swap) . runWriterT

-- | Unstacks the 'DirtyRes'.
runDirtyRes :: DirtyRes e w a -> Dirty w (Result e a)
runDirtyRes = runDirtyM . runResultT

-- | Unstacks the 'DirtyResT'.
runDirtyResT :: (Monad u) => DirtyResT e w u a -> u (Dirty w (Result e a))
runDirtyResT = runDirtyT . runResultT