mirror of
https://github.com/coot/free-category.git
synced 2024-09-11 14:17:30 +03:00
Show instances for ListTr and Queue (with QuantifiedConstraints)
This commit is contained in:
parent
d4966a6108
commit
c77fa194f5
@ -1,11 +1,15 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 806
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
#endif
|
||||
|
||||
{-# OPTIONS_HADDOCK show-extensions #-}
|
||||
|
||||
@ -53,6 +57,7 @@ import Control.Algebra.Free2 ( AlgebraType0
|
||||
-- from @b@ to @a@ in the original category.
|
||||
--
|
||||
newtype Op (f :: k -> k -> *) (a :: k) (b :: k) = Op { runOp :: f b a }
|
||||
deriving Show
|
||||
|
||||
-- | 'Op' is an endo-functor of the category of categories.
|
||||
--
|
||||
@ -91,6 +96,16 @@ data ListTr :: (k -> k -> *) -> k -> k -> * where
|
||||
NilTr :: ListTr f a a
|
||||
ConsTr :: f b c -> ListTr f a b -> ListTr f a c
|
||||
|
||||
lengthListTr :: ListTr f a b -> Int
|
||||
lengthListTr NilTr = 0
|
||||
lengthListTr (ConsTr _ xs) = 1 + lengthListTr xs
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 806
|
||||
instance (forall (x :: k) (y :: k). Show (f x y)) => Show (ListTr f a b) where
|
||||
show NilTr = "NilTr"
|
||||
show (ConsTr x xs) = "ConsTr " ++ show x ++ " " ++ show xs
|
||||
#endif
|
||||
|
||||
instance Category (ListTr f) where
|
||||
id = NilTr
|
||||
NilTr . ys = ys
|
||||
@ -154,6 +169,12 @@ data Queue (f :: k -> k -> *) (a :: k) (b :: k) where
|
||||
-> !(ListTr f b x)
|
||||
-> Queue f a c
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 806
|
||||
instance (forall (x :: k) (y :: k). Show (f x y))
|
||||
=> Show (Queue f a b) where
|
||||
show (Queue f r s) = "Queue (" ++ show f ++ ") (" ++ show r ++ ") " ++ show (lengthListTr s)
|
||||
#endif
|
||||
|
||||
emptyQ :: Queue (f :: k -> k -> *) a a
|
||||
emptyQ = Queue NilTr NilTr NilTr
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user