blob: 30023ad5b819a3f0b06f516a9bb4f76bc6668b81 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
{-# LANGUAGE ConstraintKinds, GADTs, RankNTypes #-}
{-# LANGUAGE TypeOperators, KindSignatures #-}
module CatEntail where
import Prelude hiding (id, (.))
import Data.Kind
import Control.Category
-- One dictionary to rule them all.
data Dict :: Constraint -> Type where
Dict :: ctx => Dict ctx
-- Entailment.
-- Note the kind 'Constraint -> Constraint -> *'
newtype (|-) a b = Sub (a => Dict b)
(\\) :: a => (b => r) -> (a |- b) -> r
r \\ Sub Dict = r
reflexive :: a |- a
reflexive = Sub Dict
transitive :: (b |- c) -> (a |- b) -> a |- c
transitive f g = Sub $ Dict \\ f \\ g
instance Category (|-) where
id = reflexive
(.) = transitive
|
