content: {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE Arrows #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE TupleSections #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE DataKinds #-}
  {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
  module Control.Arrow.Transformer.Abstract.LogError(LogErrorT,runLogErrorT) where
  
  import           Prelude hiding (id,(.),lookup,read)
  
  import           Control.Category
  import           Control.Arrow
  import           Control.Arrow.Const
  import           Control.Arrow.Environment as Env
  import           Control.Arrow.Closure as Cls
  import           Control.Arrow.LetRec
  import           Control.Arrow.Fail
  import           Control.Arrow.Fix
  import           Control.Arrow.Trans
  import           Control.Arrow.Reader
  import           Control.Arrow.Order (ArrowComplete(..),ArrowJoin(..))
  import           Control.Arrow.Store as Store
  import           Control.Arrow.Except as Exc
  import           Control.Arrow.Transformer.State
  import           Control.Arrow.Fix.Context
  
  import           Data.Abstract.MonotoneErrors
  import           Data.Profunctor
  import           Data.Order
  import           Data.Identifiable
  import           Data.Empty
  
  -- | Describes computations that can fail.
  newtype LogErrorT e c x y = LogErrorT (StateT (Errors e) c x y)
    deriving (Profunctor, Category, Arrow, ArrowChoice, ArrowLift, ArrowTrans,
              ArrowConst r, ArrowReader r,
              ArrowEnv var val, ArrowClosure expr cls, ArrowStore a b, ArrowLetRec var val,
              ArrowExcept e', ArrowCallSite ctx, ArrowJoin)
  
  runLogErrorT :: (Identifiable e, Profunctor c) => LogErrorT e c x y -> c x (Errors e, y)
  runLogErrorT f = lmap (empty,) (unlift f)
  {-# INLINE runLogErrorT #-}
  
  instance (Identifiable e, ArrowRun c) => ArrowRun (LogErrorT e c) where
    type Run (LogErrorT e c) x y = Run c x (Errors e,y)
    run = run . runLogErrorT
    {-# INLINE run #-}
  
  instance (Identifiable e, Arrow c, Profunctor c) => ArrowFail e (LogErrorT e c) where
    type Join x (LogErrorT e c) = LowerBounded x
    fail = lift $ proc (errs,e) -> returnA -< (insert e errs, bottom)
    {-# INLINE fail #-}
  
  -- instance (ArrowApply c, Profunctor c) => ArrowApply (LogErrorT e c) where
  --   app = LogErrorT (app .# first coerce)
  --   {-# INLINE app #-}
  
  deriving instance ArrowComplete (Errors e, y) c => ArrowComplete y (LogErrorT e c)
  instance ArrowFix (Underlying (LogErrorT e c) x y) => ArrowFix (LogErrorT e c x y) where
    type Fix (LogErrorT e c x y) = Fix (Underlying (LogErrorT e c) x y)
  