content: {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE TypeFamilies #-}
  module Control.Arrow.Transformer.Concrete.Random where
  
  import           Prelude hiding ((.))
  
  import           Control.Category
  import           Control.Arrow
  import           Control.Arrow.Const
  import           Control.Arrow.Environment
  import           Control.Arrow.Closure
  import           Control.Arrow.Except
  import           Control.Arrow.Trans
  import           Control.Arrow.Fail
  import           Control.Arrow.Fix
  import           Control.Arrow.Reader
  import           Control.Arrow.Random
  import           Control.Arrow.State
  import           Control.Arrow.Store
  
  import           Control.Arrow.Transformer.State
  
  import           Data.Profunctor
  import           Data.Coerce
  
  import           System.Random(StdGen,Random)
  import qualified System.Random as R
  
  newtype RandomT c x y = RandomT (StateT StdGen c x y)
    deriving (Profunctor,Category,Arrow,ArrowChoice,ArrowLift,ArrowTrans,ArrowRun,
              ArrowConst r, ArrowReader r, ArrowFail e, ArrowExcept e,
              ArrowEnv var val, ArrowClosure expr cls, ArrowStore var val)
  
  runRandomT :: RandomT c x y -> c (StdGen,x) (StdGen,y)
  runRandomT = coerce
  {-# INLINE runRandomT #-}
  
  instance (Random v, Arrow c, Profunctor c) => ArrowRand v (RandomT c) where
    random = RandomT $ modify' (\((),gen) -> R.random gen)
  
  instance (Arrow c, ArrowFix (Underlying (RandomT c) x y)) => ArrowFix (RandomT c x y) where
    type Fix (RandomT c x y) = Fix (Underlying (RandomT c) x y)
  
  instance ArrowState s c => ArrowState s (RandomT c) where
    get = lift' get
    put = lift' put
  