module Data.Has
(
Has
, Field
, (&), (:&:), field
, (^=), (^.), (^:)
, Knows(..), updl
, Labelled(), (:>), (.>)
, TypeOf, FieldOf, fieldOf
, (:::)(), TyNil(), Contains()
) where
import Control.Applicative
import Test.QuickCheck (Arbitrary(..), CoArbitrary(..))
import Data.Monoid (Monoid (..))
import Data.Has.Engine
import Data.Has.TypeList ((:::), TyNil)
newtype Labelled lab a = Label { unLabelled :: a }
deriving (Eq,Ord,Show,Read,Bounded)
type lab :> a = Field (Labelled lab a)
infix 6 :>
label :: lab -> a -> Labelled lab a
label _ a = Label a
unlabel :: lab -> Labelled lab a -> a
unlabel _ = unLabelled
(.>) :: lab -> a -> lab :> a
(.>) = (field .) . label
infix 6 .>
class (Contains (Labelled lab e) s) => Knows lab e s | lab s -> e where
injl :: lab -> e -> s -> s
prjl :: lab -> s -> e
instance (Contains (Labelled lab e) s) => Knows lab e s where
injl lab e s = inj (label lab e) s
prjl lab s = unlabel lab (prj s)
updl :: (Knows lab b a)
=> lab -> (b -> b) -> (a -> a)
updl lab f a = let b = prjl lab a in injl lab (f b) a
type family TypeOf a
type family FieldOf a
type instance FieldOf a = a :> TypeOf a
fieldOf :: TypeOf a -> FieldOf a
fieldOf a = undefined .> a
class (Knows lab (TypeOf lab) s) => Has lab s
instance (Knows lab (TypeOf lab) s) => Has lab s
(^=) :: (Knows lab (TypeOf lab) s)
=> lab -> TypeOf lab -> s -> s
(^=) = injl
infix 6 ^=
(^.) :: (Knows lab (TypeOf lab) s)
=> lab -> s -> TypeOf lab
(^.) = prjl
infix 4 ^.
(^:) :: (Knows lab (TypeOf lab) s)
=> lab -> (TypeOf lab -> TypeOf lab) -> (s -> s)
(^:) = updl
infixr 5 ^:
instance (Monoid a) => Monoid (Labelled lab a) where
mempty = Label mempty
mappend a b = Label (unLabelled a `mappend` unLabelled b)
instance (Arbitrary a) => Arbitrary (Labelled lab a) where
arbitrary = Label <$> arbitrary
instance (CoArbitrary a) => CoArbitrary (Labelled lab a) where
coarbitrary = coarbitrary . unLabelled