module Data.Vinyl.Utils.Const
( cfmap
, cpure
, capp
, rconst
, constCommute
, rtraverseconst
, Record (..)
) where
import Data.Vinyl.Utils.Compose
import Data.Vinyl.Utils.Proxy
import Data.Vinyl.Functor
import Data.Vinyl
cfmap :: (a -> b) -> Rec (Const a) rs -> Rec (Const b) rs
cfmap _ RNil = RNil
cfmap f (Const r :& rs) = Const (f r) :& cfmap f rs
cpure :: Record rs => a -> Rec (Const a) rs
cpure = cpure' proxyRecord
cpure' :: Rec Proxy rs -> a -> Rec (Const a) rs
cpure' RNil _ = RNil
cpure' (Proxy :& ps) a = Const a :& cpure' ps a
capp :: (Rec (Const (a -> b)) rs) -> Rec (Const a) rs -> Rec (Const b) rs
capp RNil RNil = RNil
capp (Const f :& fs) (Const x :& xs) = Const (f x) :& capp fs xs
capp RNil _ = error "impossible"
capp _ RNil = error "impossible"
rconst :: (Applicative f, RecApplicative rs) => f a -> f (Rec (Const a) rs)
rconst = rtraverse1 . rcpure
where rcpure a = rpure (Compose $ Const <$> a)
constCommute :: Functor f => Const (f a) b -> Compose f (Const a) b
constCommute (Const a) = Compose $ Const <$> a
rtraverseconst :: Applicative f => Rec (Const (f a)) rs -> f (Rec (Const a) rs)
rtraverseconst rec = rtraverse1 $ constCommute <<$>> rec