content: {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE UndecidableInstances #-}
  -- | Arrow Transformer that can be used to define value operations:
  --
  -- > instance IsVal Val (ValueT Val c) where ...
  --
  -- ATTENTION: 'ArrowComplete' should be defined on a case by case basis.
  -- For example, we could define a 'ArrowComplete' instance for values
  -- that turns @Top@ into an error:
  --
  -- > instance ArrowComplete Val c => ArrowComplete Val (ValueT Val c) where
  -- >   ValueT f <⊔> ValueT g = ValueT $ proc x -> do
  -- >     v <- f <⊔> g -< x
  -- >     case v of
  -- >       Top -> fail "Encountered top while joining values."
  -- >       v' -> returnA -< v'
  module Control.Arrow.Transformer.Value where
  
  import Prelude hiding ((.))
  
  import Control.Category
  import Control.Arrow
  import Control.Arrow.Cont
  import Control.Arrow.Const
  import Control.Arrow.Fail
  import Control.Arrow.Fix
  import Control.Arrow.Frame
  import Control.Arrow.Trans
  import Control.Arrow.Environment
  import Control.Arrow.Store
  import Control.Arrow.Except
  import Control.Arrow.Reader
  import Control.Arrow.State
  import Control.Arrow.LetRec
  import Control.Arrow.Fix.Context
  import Control.Arrow.Writer
  
  import Data.Profunctor.Unsafe
  import Data.Coerce
  
  newtype ValueT val c x y = ValueT { runValueT :: c x y }
    deriving (Profunctor,Category,Arrow,ArrowChoice, ArrowConst r,
              ArrowFrame frame, ArrowEnv var val', ArrowLetRec var val', ArrowStore addr val',
              ArrowExcept exc,ArrowFail e, ArrowWriter w,
              ArrowReader r, ArrowState s, ArrowCont, ArrowCallSite ctx)
  
  instance (ArrowApply c, Profunctor c) => ArrowApply (ValueT val c) where
    app = lift (app .# first coerce)
    {-# INLINE app #-}
  
  instance ArrowRun c => ArrowRun (ValueT val c) where type Run (ValueT val c) x y = Run c x y
  instance ArrowLift (ValueT val c) where type Underlying (ValueT val c) x y = c x y
  instance ArrowFix (c x y) => ArrowFix (ValueT val c x y) where
    type Fix (ValueT val c x y) = Fix (Underlying (ValueT val c) x y)
  