first-class-families-0.8.0.1/src/0000755000000000000000000000000013672702407014664 5ustar0000000000000000first-class-families-0.8.0.1/src/Fcf/0000755000000000000000000000000013672702407015362 5ustar0000000000000000first-class-families-0.8.0.1/src/Fcf/Class/0000755000000000000000000000000014021277556016430 5ustar0000000000000000first-class-families-0.8.0.1/src/Fcf/Class/Monoid/0000755000000000000000000000000014021271720017640 5ustar0000000000000000first-class-families-0.8.0.1/src/Fcf/Data/0000755000000000000000000000000014021277556016234 5ustar0000000000000000first-class-families-0.8.0.1/test/0000755000000000000000000000000014021277556015055 5ustar0000000000000000first-class-families-0.8.0.1/src/Fcf.hs0000644000000000000000000000413313672702407015717 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} -- | First-class type families -- -- For example, here is a regular type family: -- -- @ -- type family FromMaybe (a :: k) (m :: Maybe k) :: k -- type instance FromMaybe a 'Nothing = a -- type instance FromMaybe a ('Just b) = b -- @ -- -- With @Fcf@, it translates to a @data@ declaration: -- -- @ -- data FromMaybe :: k -> Maybe k -> 'Exp' k -- type instance 'Eval' (FromMaybe a 'Nothing) = a -- type instance 'Eval' (FromMaybe a ('Just b)) = b -- @ -- -- - Fcfs can be higher-order. -- - The kind constructor 'Exp' is a monad: there's @('=<<')@ and 'Pure'. -- -- Essential language extensions for "Fcf": -- -- > {-# LANGUAGE -- > DataKinds, -- > PolyKinds, -- > TypeFamilies, -- > TypeInType, -- > TypeOperators, -- > UndecidableInstances #-} module Fcf ( -- * First-class type families Exp , Eval , type (@@) -- ** Functional combinators , Pure , Pure1 , Pure2 , Pure3 , type (=<<) , type (<=<) , LiftM , LiftM2 , LiftM3 , Join , type (<$>) , type (<*>) , Flip , ConstFn , type ($) -- * Operations on common types -- ** Pairs , Uncurry , Fst , Snd , type (***) -- ** Either , UnEither , IsLeft , IsRight -- ** Maybe , UnMaybe , FromMaybe , IsNothing , IsJust -- ** Lists , Foldr , UnList , type (++) , Filter , Head , Tail , Null , Length , Find , FindIndex , Lookup , SetIndex , ZipWith , Zip , Unzip , Cons2 -- ** Bool , UnBool , type (||) , type (&&) , Not -- ** Case splitting , Case , Match() , type (-->) , Is , Any , Else -- ** Nat , type (+) , type (-) , type (Fcf.Data.Nat.*) , type (^) , type (<=) , type (>=) , type (<) , type (>) -- * Overloaded operations , Map , Bimap -- * Miscellaneous , Error , Constraints , TyEq , Stuck , IsBool(_If) , If ) where import Fcf.Core import Fcf.Combinators import Fcf.Data.Bool import Fcf.Data.Common import Fcf.Data.List import Fcf.Data.Nat import Fcf.Class.Functor import Fcf.Class.Bifunctor import Fcf.Utils first-class-families-0.8.0.1/src/Fcf/Core.hs0000644000000000000000000000074713672702407016616 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators #-} -- | The 'Eval' family. module Fcf.Core ( Exp , Eval , type (@@) ) where import Data.Kind (Type) -- * First-class type families -- | Kind of type-level expressions indexed by their result type. type Exp a = a -> Type -- | Expression evaluator. type family Eval (e :: Exp a) :: a -- ** Miscellaneous -- | Apply and evaluate a unary type function. type f @@ x = Eval (f x) first-class-families-0.8.0.1/src/Fcf/Combinators.hs0000644000000000000000000000377113672702407020206 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | General fcf combinators. -- -- See also "Fcf.Data.Function" for more. module Fcf.Combinators ( Pure , Pure1 , Pure2 , Pure3 , type (=<<) , type (<=<) , LiftM , LiftM2 , LiftM3 , Join , type (<$>) , type (<*>) , Flip , ConstFn , type ($) ) where import Fcf.Core -- ** Monadic operations infixl 1 >>= infixr 1 =<<, <=< infixl 4 <$>, <*> data Pure :: a -> Exp a type instance Eval (Pure x) = x data Pure1 :: (a -> b) -> a -> Exp b type instance Eval (Pure1 f x) = f x data Pure2 :: (a -> b -> c) -> a -> b -> Exp c type instance Eval (Pure2 f x y) = f x y data Pure3 :: (a -> b -> c -> d) -> a -> b -> c -> Exp d type instance Eval (Pure3 f x y z) = f x y z data (=<<) :: (a -> Exp b) -> Exp a -> Exp b type instance Eval (k =<< e) = Eval (k (Eval e)) data (>>=) :: Exp a -> (a -> Exp b) -> Exp b type instance Eval (e >>= k) = Eval (k (Eval e)) data (<=<) :: (b -> Exp c) -> (a -> Exp b) -> a -> Exp c type instance Eval ((f <=< g) x) = Eval (f (Eval (g x))) type LiftM = (=<<) data LiftM2 :: (a -> b -> Exp c) -> Exp a -> Exp b -> Exp c type instance Eval (LiftM2 f x y) = Eval (f (Eval x) (Eval y)) data LiftM3 :: (a -> b -> c -> Exp d) -> Exp a -> Exp b -> Exp c -> Exp d type instance Eval (LiftM3 f x y z) = Eval (f (Eval x) (Eval y) (Eval z)) data Join :: Exp (Exp a) -> Exp a type instance Eval (Join e) = Eval (Eval e) data (<$>) :: (a -> b) -> Exp a -> Exp b type instance Eval (f <$> e) = f (Eval e) data (<*>) :: Exp (a -> b) -> Exp a -> Exp b type instance Eval (f <*> e) = Eval f (Eval e) data Flip :: (a -> b -> Exp c) -> b -> a -> Exp c type instance Eval (Flip f y x) = Eval (f x y) data ConstFn :: a -> b -> Exp a type instance Eval (ConstFn a _b) = a -- | Note that this denotes the identity function, so @($) f@ can usually be -- replaced with @f@. data ($) :: (a -> Exp b) -> a -> Exp b type instance Eval (($) f a) = Eval (f a) infixr 0 $ first-class-families-0.8.0.1/src/Fcf/Data/Bool.hs0000644000000000000000000000235314021277556017466 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Booleans. -- -- Note that the operations from this module conflict with -- "Data.Type.Bool". module Fcf.Data.Bool ( UnBool , type (||) , type (&&) , Not ) where import Fcf.Core -- $setup -- >>> :set -XTypeFamilies -- | N.B.: The order of the two branches is the opposite of "if": -- @UnBool ifFalse ifTrue bool@. -- -- This mirrors the default order of constructors: -- -- @ -- data Bool = False | True -- ----------- False < True -- @ data UnBool :: Exp a -> Exp a -> Bool -> Exp a type instance Eval (UnBool fal tru 'False) = Eval fal type instance Eval (UnBool fal tru 'True ) = Eval tru infixr 2 || infixr 3 && data (||) :: Bool -> Bool -> Exp Bool type instance Eval ('True || b) = 'True type instance Eval (a || 'True) = 'True type instance Eval ('False || b) = b type instance Eval (a || 'False) = a data (&&) :: Bool -> Bool -> Exp Bool type instance Eval ('False && b) = 'False type instance Eval (a && 'False) = 'False type instance Eval ('True && b) = b type instance Eval (a && 'True) = a data Not :: Bool -> Exp Bool type instance Eval (Not 'True) = 'False type instance Eval (Not 'False) = 'True first-class-families-0.8.0.1/src/Fcf/Data/Common.hs0000644000000000000000000000357313672702407020027 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators #-} -- | Common data types: tuples, 'Either', 'Maybe'. module Fcf.Data.Common ( -- ** Pairs Uncurry , Fst , Snd , type (***) -- ** Either , UnEither , IsLeft , IsRight -- ** Maybe , UnMaybe , FromMaybe , IsNothing , IsJust ) where import Fcf.Core -- ** Pairs data Uncurry :: (a -> b -> Exp c) -> (a, b) -> Exp c type instance Eval (Uncurry f '(x, y)) = Eval (f x y) data Fst :: (a, b) -> Exp a type instance Eval (Fst '(a, _b)) = a data Snd :: (a, b) -> Exp b type instance Eval (Snd '(_a, b)) = b infixr 3 *** -- | Specialization of 'Fcf.Class.Bifunctor.Bimap' for pairs. data (***) :: (b -> Exp c) -> (b' -> Exp c') -> (b, b') -> Exp (c, c') type instance Eval ((***) f f' '(b, b')) = '(Eval (f b), Eval (f' b')) -- ** Either data UnEither :: (a -> Exp c) -> (b -> Exp c) -> Either a b -> Exp c type instance Eval (UnEither f g ('Left x)) = Eval (f x) type instance Eval (UnEither f g ('Right y)) = Eval (g y) data IsLeft :: Either a b -> Exp Bool type instance Eval (IsLeft ('Left _a)) = 'True type instance Eval (IsLeft ('Right _a)) = 'False data IsRight :: Either a b -> Exp Bool type instance Eval (IsRight ('Left _a)) = 'False type instance Eval (IsRight ('Right _a)) = 'True -- ** Maybe data UnMaybe :: Exp b -> (a -> Exp b) -> Maybe a -> Exp b type instance Eval (UnMaybe y f 'Nothing) = Eval y type instance Eval (UnMaybe y f ('Just x)) = Eval (f x) data FromMaybe :: k -> Maybe k -> Exp k type instance Eval (FromMaybe a 'Nothing) = a type instance Eval (FromMaybe _a ('Just b)) = b data IsNothing :: Maybe a -> Exp Bool type instance Eval (IsNothing ('Just _a)) = 'False type instance Eval (IsNothing 'Nothing) = 'True data IsJust :: Maybe a -> Exp Bool type instance Eval (IsJust ('Just _a)) = 'True type instance Eval (IsJust 'Nothing) = 'False first-class-families-0.8.0.1/src/Fcf/Data/Function.hs0000644000000000000000000000276214021277556020364 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Simple combinators for functions. module Fcf.Data.Function ( type (&) , On , Bicomap ) where import Fcf.Core infixl 1 & -- $setup -- >>> :set -XTypeFamilies -XDataKinds -XTypeOperators -- >>> import Fcf.Core -- >>> import Fcf.Combinators (Pure) -- >>> import Fcf.Data.Common (Fst) -- >>> import Fcf.Data.Bool (type (&&), type (||)) -- | Reverse function application, argument first. -- -- === __Example__ -- -- >>> :kind! Eval ('( 'True, 'Nothing) & Fst) -- Eval ('( 'True, 'Nothing) & Fst) :: Bool -- = 'True data (&) :: a -> (a -> Exp b) -> Exp b type instance Eval (x & f) = Eval (f x) -- | Lift a binary function to the domain of a projection. -- -- === __Example__ -- -- >>> :kind! Eval (((&&) `On` Fst) '( 'True, 'Nothing) '( 'False, 'Just '())) -- Eval (((&&) `On` Fst) '( 'True, 'Nothing) '( 'False, 'Just '())) :: Bool -- = 'False data On :: (b -> b -> Exp c) -> (a -> Exp b) -> a -> a -> Exp c type instance Eval (On r f x y) = Eval (r (Eval (f x)) (Eval (f y))) -- | Pre-compose a binary function with a function for each argument. -- -- === __Example__ -- -- >>> :kind! Eval (Bicomap Fst Pure (||) '( 'False, 'Nothing) 'True) -- Eval (Bicomap Fst Pure (||) '( 'False, 'Nothing) 'True) :: Bool -- = 'True data Bicomap :: (a -> Exp c) -> (b -> Exp d) -> (c -> d -> Exp e) -> a -> b -> Exp e type instance Eval (Bicomap f g r x y) = Eval (r (Eval (f x)) (Eval (g y))) first-class-families-0.8.0.1/src/Fcf/Data/List.hs0000644000000000000000000003705714021277556017517 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Lists. -- -- See also "Fcf.Class.Foldable" for additional functions. module Fcf.Data.List ( -- * Basic functions type (++) , Head , Last , Tail , Cons , Snoc , Cons2 , Init , Null , Length -- * List transformations , Reverse , Intersperse , Intercalate -- * Reducing lists -- | See also "Fcf.Class.Foldable". , Foldr , UnList , Concat , ConcatMap -- * Unfolding and building , Unfoldr , Replicate -- * Sublists , Take , Drop , TakeWhile , DropWhile , Span , Break , Tails -- ** Predicates , IsPrefixOf , IsSuffixOf , IsInfixOf -- * Searching , Elem , Lookup , Find , Filter , Partition -- * Indexing lists , FindIndex , SetIndex -- * Zipping and unzipping , ZipWith , Zip , Unzip ) where import qualified GHC.TypeLits as TL import Fcf.Core import Fcf.Combinators import Fcf.Class.Functor (Map) import Fcf.Class.Monoid (type (<>)) import Fcf.Class.Foldable import Fcf.Data.Bool import Fcf.Data.Common import Fcf.Data.Nat import Fcf.Utils (If, TyEq) -- $setup -- >>> import Fcf.Core (Eval) -- >>> import Fcf.Combinators -- >>> import Fcf.Class.Monoid () -- >>> import qualified GHC.TypeLits as TL -- >>> import GHC.TypeLits (Nat) -- | List catenation. -- -- === __Example__ -- -- >>> :kind! Eval ('[1, 2] ++ '[3, 4]) -- Eval ('[1, 2] ++ '[3, 4]) :: [Nat] -- = '[1, 2, 3, 4] -- data (++) :: [a] -> [a] -> Exp [a] type instance Eval ((++) xs ys) = xs <> ys data Head :: [a] -> Exp (Maybe a) type instance Eval (Head '[]) = 'Nothing type instance Eval (Head (a ': _as)) = 'Just a data Last :: [a] -> Exp (Maybe a) type instance Eval (Last '[]) = 'Nothing type instance Eval (Last (a ': '[])) = 'Just a type instance Eval (Last (a ': b ': as)) = Eval (Last (b ': as)) data Init :: [a] -> Exp (Maybe [a]) type instance Eval (Init '[]) = 'Nothing type instance Eval (Init (a ': '[])) = 'Just '[] type instance Eval (Init (a ': b ': as)) = Eval (Map (Cons a) =<< (Init (b ': as))) data Tail :: [a] -> Exp (Maybe [a]) type instance Eval (Tail '[]) = 'Nothing type instance Eval (Tail (_a ': as)) = 'Just as data Null :: [a] -> Exp Bool type instance Eval (Null '[]) = 'True type instance Eval (Null (a ': as)) = 'False data Length :: [a] -> Exp Nat type instance Eval (Length '[]) = 0 type instance Eval (Length (a ': as)) = 1 TL.+ Eval (Length as) -- | Append an element to a list. -- -- === __Example__ -- -- >>> :kind! Eval (Cons 1 '[2, 3]) -- Eval (Cons 1 '[2, 3]) :: [Nat] -- = '[1, 2, 3] -- >>> :kind! Eval (Cons Int '[Char, Maybe Double]) -- Eval (Cons Int '[Char, Maybe Double]) :: [*] -- = '[Int, Char, Maybe Double] -- data Cons :: a -> [a] -> Exp [a] type instance Eval (Cons a as) = a ': as -- | Append elements to two lists. Used in the definition of 'Unzip'. data Cons2 :: (a, b) -> ([a], [b]) -> Exp ([a], [b]) type instance Eval (Cons2 '(a, b) '(as, bs)) = '(a ': as, b ': bs) -- | Append an element to the end of a list. -- -- === __Example__ -- -- >>> :kind! Eval (Snoc '[1,2,3] 4) -- Eval (Snoc '[1,2,3] 4) :: [Nat] -- = '[1, 2, 3, 4] data Snoc :: [a] -> a -> Exp [a] type instance Eval (Snoc lst a) = Eval (lst ++ '[a]) -- Helper for Reverse. This corresponds to rev in the data list lib. data Rev :: [a] -> [a] -> Exp [a] type instance Eval (Rev '[] ys) = ys type instance Eval (Rev (x ': xs) ys) = Eval (Rev xs (x ': ys)) -- | Reverse a list. -- -- === __Example__ -- -- >>> :kind! Eval (Reverse '[1,2,3,4,5]) -- Eval (Reverse '[1,2,3,4,5]) :: [Nat] -- = '[5, 4, 3, 2, 1] data Reverse :: [a] -> Exp [a] type instance Eval (Reverse l) = Eval (Rev l '[]) -- | Intersperse a separator between elements of a list. -- -- === __Example__ -- -- >>> :kind! Eval (Intersperse 0 '[1,2,3,4]) -- Eval (Intersperse 0 '[1,2,3,4]) :: [Nat] -- = '[1, 0, 2, 0, 3, 0, 4] data Intersperse :: a -> [a] -> Exp [a] type instance Eval (Intersperse _ '[] ) = '[] type instance Eval (Intersperse sep (x ': xs)) = x ': Eval (PrependToAll sep xs) -- | Helper for Intersperse data PrependToAll :: a -> [a] -> Exp [a] type instance Eval (PrependToAll _ '[] ) = '[] type instance Eval (PrependToAll sep (x ': xs)) = sep ': x ': Eval (PrependToAll sep xs) -- | Join a list of words separated by some word. -- -- === __Example__ -- -- >>> :kind! Eval (Intercalate '[", "] '[ '["Lorem"], '["ipsum"], '["dolor"] ]) -- Eval (Intercalate '[", "] '[ '["Lorem"], '["ipsum"], '["dolor"] ]) :: [TL.Symbol] -- = '["Lorem", ", ", "ipsum", ", ", "dolor"] data Intercalate :: [a] -> [[a]] -> Exp [a] type instance Eval (Intercalate xs xss) = Eval (Concat =<< Intersperse xs xss) -- | This is 'Foldr' with its argument flipped. data UnList :: b -> (a -> b -> Exp b) -> [a] -> Exp b type instance Eval (UnList y f xs) = Eval (Foldr f y xs) -- Helper for the Unfoldr. data UnfoldrCase :: (b -> Exp (Maybe (a, b))) -> Maybe (a, b) -> Exp [a] type instance Eval (UnfoldrCase f ('Just ab)) = Eval (Fst ab) ': Eval (Unfoldr f (Eval (Snd ab))) type instance Eval (UnfoldrCase _ 'Nothing) = '[] -- | Unfold a generator into a list. -- -- === __Example__ -- -- >>> data ToThree :: Nat -> Exp (Maybe (Nat, Nat)) -- >>> :{ -- type instance Eval (ToThree b) = -- If (Eval (b Fcf.>= 4)) -- 'Nothing -- ('Just '(b, b TL.+ 1)) -- :} -- -- >>> :kind! Eval (Unfoldr ToThree 0) -- Eval (Unfoldr ToThree 0) :: [Nat] -- = '[0, 1, 2, 3] -- -- See also the definition of `Replicate`. data Unfoldr :: (b -> Exp (Maybe (a, b))) -> b -> Exp [a] type instance Eval (Unfoldr f c) = Eval (UnfoldrCase f (f @@ c)) -- Helper for the Replicate. data NumIter :: a -> Nat -> Exp (Maybe (a, Nat)) type instance Eval (NumIter a s) = If (Eval (s > 0)) ('Just '(a, s TL.- 1)) 'Nothing -- | Repeat the same element in a list. -- -- === __Example__ -- -- >>> :kind! Eval (Replicate 4 '("ok", 2)) -- Eval (Replicate 4 '("ok", 2)) :: [(TL.Symbol, Nat)] -- = '[ '("ok", 2), '("ok", 2), '("ok", 2), '("ok", 2)] data Replicate :: Nat -> a -> Exp [a] type instance Eval (Replicate n a) = Eval (Unfoldr (NumIter a) n) -- | Take a prefix of fixed length. -- -- === __Example__ -- -- >>> :kind! Eval (Take 2 '[1,2,3,4,5]) -- Eval (Take 2 '[1,2,3,4,5]) :: [Nat] -- = '[1, 2] data Take :: Nat -> [a] -> Exp [a] type instance Eval (Take n as) = Take_ n as type family Take_ (n :: Nat) (xs :: [a]) :: [a] where Take_ 0 _ = '[] Take_ _ '[] = '[] Take_ n (x ': xs) = x ': Take_ (n TL.- 1) xs -- | Drop a prefix of fixed length, evaluate to the remaining suffix. -- -- === __Example__ -- -- >>> :kind! Eval (Drop 2 '[1,2,3,4,5]) -- Eval (Drop 2 '[1,2,3,4,5]) :: [Nat] -- = '[3, 4, 5] data Drop :: Nat -> [a] -> Exp [a] type instance Eval (Drop n as) = Drop_ n as type family Drop_ (n :: Nat) (xs :: [a]) :: [a] where Drop_ 0 xs = xs Drop_ _ '[] = '[] Drop_ n (x ': xs) = Drop_ (n TL.- 1) xs -- | Take the longest prefix of elements satisfying a predicate. -- -- === __Example__ -- -- >>> :kind! Eval (TakeWhile ((>=) 3) '[1, 2, 3, 4, 5]) -- Eval (TakeWhile ((>=) 3) '[1, 2, 3, 4, 5]) :: [Nat] -- = '[1, 2, 3] data TakeWhile :: (a -> Exp Bool) -> [a] -> Exp [a] type instance Eval (TakeWhile p '[]) = '[] type instance Eval (TakeWhile p (x ': xs)) = Eval (If (Eval (p x)) ('(:) x <$> TakeWhile p xs) (Pure '[])) -- | Drop the longest prefix of elements satisfying a predicate, -- evaluate to the remaining suffix. -- -- === __Example__ -- -- :kind! Eval (DropWhile ((>=) 3) '[1, 2, 3, 4, 5]) -- Eval (DropWhile ((>=) 3) '[1, 2, 3, 4, 5]) :: [Nat] -- = '[4, 5] data DropWhile :: (a -> Exp Bool) -> [a] -> Exp [a] type instance Eval (DropWhile p '[]) = '[] type instance Eval (DropWhile p (x ': xs)) = Eval (If (Eval (p x)) (DropWhile p xs) (Pure (x ': xs))) -- | 'Span', applied to a predicate @p@ and a list @xs@, returns a tuple: -- the first component is the longest prefix (possibly empty) of @xs@ whose elements -- satisfy @p@; -- the second component is the remainder of the list. -- -- See also 'TakeWhile', 'DropWhile', and 'Break'. -- -- === __Example__ -- -- >>> :kind! Eval (Span (Flip (<) 3) '[1,2,3,4,1,2,3,4]) -- Eval (Span (Flip (<) 3) '[1,2,3,4,1,2,3,4]) :: ([Nat], [Nat]) -- = '( '[1, 2], '[3, 4, 1, 2, 3, 4]) -- -- >>> :kind! Eval (Span (Flip (<) 9) '[1,2,3]) -- Eval (Span (Flip (<) 9) '[1,2,3]) :: ([Nat], [Nat]) -- = '( '[1, 2, 3], '[]) -- -- >>> :kind! Eval (Span (Flip (<) 0) '[1,2,3]) -- Eval (Span (Flip (<) 0) '[1,2,3]) :: ([Nat], [Nat]) -- = '( '[], '[1, 2, 3]) data Span :: (a -> Exp Bool) -> [a] -> Exp ([a],[a]) type instance Eval (Span p lst) = '( Eval (TakeWhile p lst), Eval (DropWhile p lst)) -- | 'Break', applied to a predicate @p@ and a list @xs@, returns a tuple: -- the first component is the longest prefix (possibly empty) of @xs@ whose elements -- /do not satisfy/ @p@; the second component is the remainder of the list. -- -- === __Example__ -- -- >>> :kind! Eval (Break (Flip (>) 3) '[1,2,3,4,1,2,3,4]) -- Eval (Break (Flip (>) 3) '[1,2,3,4,1,2,3,4]) :: ([Nat], [Nat]) -- = '( '[1, 2, 3], '[4, 1, 2, 3, 4]) -- -- >>> :kind! Eval (Break (Flip (<) 9) '[1,2,3]) -- Eval (Break (Flip (<) 9) '[1,2,3]) :: ([Nat], [Nat]) -- = '( '[], '[1, 2, 3]) -- -- >>> :kind! Eval (Break (Flip (>) 9) '[1,2,3]) -- Eval (Break (Flip (>) 9) '[1,2,3]) :: ([Nat], [Nat]) -- = '( '[1, 2, 3], '[]) data Break :: (a -> Exp Bool) -> [a] -> Exp ([a],[a]) type instance Eval (Break p lst) = Eval (Span (Not <=< p) lst) -- | List of suffixes of a list. -- -- === __Example__ -- -- >>> :kind! Eval (Tails '[0,1,2,3]) -- Eval (Tails '[0,1,2,3]) :: [[Nat]] -- = '[ '[0, 1, 2, 3], '[1, 2, 3], '[2, 3], '[3]] data Tails :: [a] -> Exp [[a]] type instance Eval (Tails '[]) = '[] type instance Eval (Tails (a ': as)) = (a ': as) ': Eval (Tails as) -- | Return @True@ when the first list is a prefix of the second. -- -- === __Example__ -- -- >>> :kind! Eval (IsPrefixOf '[0,1,2] '[0,1,2,3,4,5]) -- Eval (IsPrefixOf '[0,1,2] '[0,1,2,3,4,5]) :: Bool -- = 'True -- -- >>> :kind! Eval (IsPrefixOf '[0,1,2] '[0,1,3,2,4,5]) -- Eval (IsPrefixOf '[0,1,2] '[0,1,3,2,4,5]) :: Bool -- = 'False -- -- >>> :kind! Eval (IsPrefixOf '[] '[0,1,3,2,4,5]) -- Eval (IsPrefixOf '[] '[0,1,3,2,4,5]) :: Bool -- = 'True -- -- >>> :kind! Eval (IsPrefixOf '[0,1,3,2,4,5] '[]) -- Eval (IsPrefixOf '[0,1,3,2,4,5] '[]) :: Bool -- = 'False data IsPrefixOf :: [a] -> [a] -> Exp Bool type instance Eval (IsPrefixOf xs ys) = IsPrefixOf_ xs ys -- helper for IsPrefixOf type family IsPrefixOf_ (xs :: [a]) (ys :: [a]) :: Bool where IsPrefixOf_ '[] _ = 'True IsPrefixOf_ _ '[] = 'False IsPrefixOf_ (x ': xs) (y ': ys) = Eval ((Eval (TyEq x y)) && IsPrefixOf_ xs ys) -- | Return @True@ when the first list is a suffix of the second. -- -- === __Example__ -- -- >>> :kind! Eval (IsSuffixOf '[3,4,5] '[0,1,2,3,4,5]) -- Eval (IsSuffixOf '[3,4,5] '[0,1,2,3,4,5]) :: Bool -- = 'True -- -- >>> :kind! Eval (IsSuffixOf '[3,4,5] '[0,1,3,2,4,5]) -- Eval (IsSuffixOf '[3,4,5] '[0,1,3,2,4,5]) :: Bool -- = 'False -- -- >>> :kind! Eval (IsSuffixOf '[] '[0,1,3,2,4,5]) -- Eval (IsSuffixOf '[] '[0,1,3,2,4,5]) :: Bool -- = 'True -- -- >>> :kind! Eval (IsSuffixOf '[0,1,3,2,4,5] '[]) -- Eval (IsSuffixOf '[0,1,3,2,4,5] '[]) :: Bool -- = 'False data IsSuffixOf :: [a] -> [a] -> Exp Bool type instance Eval (IsSuffixOf xs ys) = Eval (IsPrefixOf (Reverse @@ xs) (Reverse @@ ys)) -- | Return @True@ when the first list is contained within the second. -- -- === __Example__ -- -- >>> :kind! Eval (IsInfixOf '[2,3,4] '[0,1,2,3,4,5,6]) -- Eval (IsInfixOf '[2,3,4] '[0,1,2,3,4,5,6]) :: Bool -- = 'True -- -- >>> :kind! Eval (IsInfixOf '[2,4,4] '[0,1,2,3,4,5,6]) -- Eval (IsInfixOf '[2,4,4] '[0,1,2,3,4,5,6]) :: Bool -- = 'False data IsInfixOf :: [a] -> [a] -> Exp Bool type instance Eval (IsInfixOf xs ys) = Eval (Any (IsPrefixOf xs) =<< Tails ys) -- | Return @True@ if an element is in a list. -- -- See also 'FindIndex'. -- -- === __Example__ -- -- >>> :kind! Eval (Elem 1 '[1,2,3]) -- Eval (Elem 1 '[1,2,3]) :: Bool -- = 'True -- >>> :kind! Eval (Elem 1 '[2,3]) -- Eval (Elem 1 '[2,3]) :: Bool -- = 'False -- data Elem :: a -> [a] -> Exp Bool type instance Eval (Elem a as) = Eval (IsJust =<< FindIndex (TyEq a) as) -- | Find an element associated with a key in an association list. data Lookup :: k -> [(k, b)] -> Exp (Maybe b) type instance Eval (Lookup (a :: k) (as :: [(k, b)])) = Eval (Map Snd (Eval (Find (TyEq a <=< Fst) as)) :: Exp (Maybe b)) -- | Find @Just@ the first element satisfying a predicate, or evaluate to -- @Nothing@ if no element satisfies the predicate. -- -- === __Example__ -- -- >>> :kind! Eval (Find (TyEq 0) '[1,2,3]) -- Eval (Find (TyEq 0) '[1,2,3]) :: Maybe Nat -- = 'Nothing -- -- >>> :kind! Eval (Find (TyEq 0) '[1,2,3,0]) -- Eval (Find (TyEq 0) '[1,2,3,0]) :: Maybe Nat -- = 'Just 0 data Find :: (a -> Exp Bool) -> [a] -> Exp (Maybe a) type instance Eval (Find _p '[]) = 'Nothing type instance Eval (Find p (a ': as)) = Eval (If (Eval (p a)) (Pure ('Just a)) (Find p as)) -- | Keep all elements that satisfy a predicate, remove all that don't. -- -- === __Example__ -- -- >>> :kind! Eval (Filter ((>) 3) '[1,2,3,0]) -- Eval (Filter ((>) 3) '[1,2,3,0]) :: [Nat] -- = '[1, 2, 0] data Filter :: (a -> Exp Bool) -> [a] -> Exp [a] type instance Eval (Filter _p '[]) = '[] type instance Eval (Filter p (a ': as)) = Eval (If (Eval (p a)) ('(:) a <$> Filter p as) (Filter p as)) -- | Split a list into one where all elements satisfy a predicate, -- and a second where no elements satisfy it. -- -- === __Example__ -- -- >>> :kind! Eval (Partition ((>=) 35) '[ 20, 30, 40, 50]) -- Eval (Partition ((>=) 35) '[ 20, 30, 40, 50]) :: ([Nat], [Nat]) -- = '( '[20, 30], '[40, 50]) data Partition :: (a -> Exp Bool) -> [a] -> Exp ([a], [a]) type instance Eval (Partition p lst) = Eval (Foldr (PartHelp p) '( '[], '[]) lst) -- | Helper for 'Partition'. data PartHelp :: (a -> Exp Bool) -> a -> ([a],[a]) -> Exp ([a],[a]) type instance Eval (PartHelp p a '(xs,ys)) = If (Eval (p a)) '(a ': xs, ys) '(xs, a ': ys) -- | Find the index of an element satisfying the predicate. -- -- === __Example__ -- -- >>> :kind! Eval (FindIndex ((<=) 3) '[1,2,3,1,2,3]) -- Eval (FindIndex ((<=) 3) '[1,2,3,1,2,3]) :: Maybe Nat -- = 'Just 2 -- -- >>> :kind! Eval (FindIndex ((>) 0) '[1,2,3,1,2,3]) -- Eval (FindIndex ((>) 0) '[1,2,3,1,2,3]) :: Maybe Nat -- = 'Nothing data FindIndex :: (a -> Exp Bool) -> [a] -> Exp (Maybe Nat) type instance Eval (FindIndex _p '[]) = 'Nothing type instance Eval (FindIndex p (a ': as)) = Eval (If (Eval (p a)) (Pure ('Just 0)) (Map ((+) 1) =<< FindIndex p as)) -- | Modify an element at a given index. -- -- The list is unchanged if the index is out of bounds. -- -- === __Example__ -- -- >>> :kind! Eval (SetIndex 2 7 '[1,2,3]) -- Eval (SetIndex 2 7 '[1,2,3]) :: [Nat] -- = '[1, 2, 7] data SetIndex :: Nat -> a -> [a] -> Exp [a] type instance Eval (SetIndex n a' as) = SetIndexImpl n a' as type family SetIndexImpl (n :: Nat) (a' :: k) (as :: [k]) where SetIndexImpl _n _a' '[] = '[] SetIndexImpl 0 a' (_a ': as) = a' ': as SetIndexImpl n a' (a ': as) = a ': SetIndexImpl (n TL.- 1) a' as -- | Combine elements of two lists pairwise. -- -- === __Example__ -- -- >>> :kind! Eval (ZipWith (+) '[1,2,3] '[1,1,1]) -- Eval (ZipWith (+) '[1,2,3] '[1,1,1]) :: [Nat] -- = '[2, 3, 4] data ZipWith :: (a -> b -> Exp c) -> [a] -> [b] -> Exp [c] type instance Eval (ZipWith _f '[] _bs) = '[] type instance Eval (ZipWith _f _as '[]) = '[] type instance Eval (ZipWith f (a ': as) (b ': bs)) = Eval (f a b) ': Eval (ZipWith f as bs) data Zip :: [a] -> [b] -> Exp [(a, b)] type instance Eval (Zip as bs) = Eval (ZipWith (Pure2 '(,)) as bs) data Unzip :: Exp [(a, b)] -> Exp ([a], [b]) type instance Eval (Unzip as) = Eval (Foldr Cons2 '( '[], '[]) (Eval as)) first-class-families-0.8.0.1/src/Fcf/Data/Nat.hs0000644000000000000000000000262014021270574017303 0ustar0000000000000000{-# LANGUAGE CPP, DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE NoStarIsType #-} #endif -- | Natural numbers. -- -- Note that the operators from this module conflict with "GHC.TypeLits" and -- "GHC.TypeNats". module Fcf.Data.Nat ( -- * Reexported type -- | From "GHC.TypeNats". Nat -- * Operations , type (+) , type (-) , type (Fcf.Data.Nat.*) , type (^) -- * Comparisons -- | Note that these conflict with "Fcf.Class.Ord". , type (<=) , type (>=) , type (<) , type (>) ) where import GHC.TypeLits (Nat) import qualified GHC.TypeLits as TL import Fcf.Core import Fcf.Combinators import Fcf.Data.Bool (Not) data (+) :: Nat -> Nat -> Exp Nat type instance Eval ((+) a b) = a TL.+ b data (-) :: Nat -> Nat -> Exp Nat type instance Eval ((-) a b) = a TL.- b data (*) :: Nat -> Nat -> Exp Nat type instance Eval ((Fcf.Data.Nat.*) a b) = a TL.* b data (^) :: Nat -> Nat -> Exp Nat type instance Eval ((^) a b) = a TL.^ b data (<=) :: Nat -> Nat -> Exp Bool type instance Eval ((<=) a b) = a TL.<=? b data (>=) :: Nat -> Nat -> Exp Bool type instance Eval ((>=) a b) = b TL.<=? a data (<) :: Nat -> Nat -> Exp Bool type instance Eval ((<) a b) = Eval (Not =<< (a >= b)) data (>) :: Nat -> Nat -> Exp Bool type instance Eval ((>) a b) = Eval (Not =<< (a <= b)) first-class-families-0.8.0.1/src/Fcf/Data/Symbol.hs0000644000000000000000000000135713672702407020042 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Werror=incomplete-patterns #-} {-| Module : Fcf.Data.Symbol Description : Type-level strings = Symbols Type-level strings. Note that the operators from this module conflict with "GHC.TypeLits". 'Symbol' also has instances of @('Fcf.Class.Monoid.<>')@ and 'Fcf.Class.Monoid.MEmpty'. -} module Fcf.Data.Symbol ( -- * Type of symbols -- | From "GHC.TypeLits". Symbol ) where import GHC.TypeLits (Symbol) first-class-families-0.8.0.1/src/Fcf/Classes.hs0000644000000000000000000000036013672702407017312 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} -- | Overloaded functions. module Fcf.Classes {-# DEPRECATED "Use Fcf.Class.Functor or Fcf.Class.Bifunctor instead." #-} ( Map , Bimap ) where import Fcf.Class.Functor import Fcf.Class.Bifunctor first-class-families-0.8.0.1/src/Fcf/Class/Bifunctor.hs0000644000000000000000000000334214021277556020721 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Bifunctors. -- -- Bifunctors are "two-argument functors". -- -- This module is the type-level equivalent of "Data.Bifunctor". module Fcf.Class.Bifunctor ( Bimap , First , Second ) where import Fcf.Core (Exp, Eval) import Fcf.Combinators (Pure) -- $setup -- >>> import Fcf.Core (Eval) -- >>> import Fcf.Combinators (Flip) -- >>> import Fcf.Data.Nat (Nat, type (+), type (-)) -- >>> import Fcf.Data.Symbol (Symbol) -- | Type-level 'Data.Bifunctor.bimap'. -- -- >>> :kind! Eval (Bimap ((+) 1) (Flip (-) 1) '(2, 4)) -- Eval (Bimap ((+) 1) (Flip (-) 1) '(2, 4)) :: (Nat, Nat) -- = '(3, 3) data Bimap :: (a -> Exp a') -> (b -> Exp b') -> f a b -> Exp (f a' b') -- (,) type instance Eval (Bimap f g '(x, y)) = '(Eval (f x), Eval (g y)) -- Either type instance Eval (Bimap f g ('Left x)) = 'Left (Eval (f x)) type instance Eval (Bimap f g ('Right y)) = 'Right (Eval (g y)) -- | Type-level 'Data.Bifunctor.first'. -- Apply a function along the first parameter of a bifunctor. -- -- === __Example__ -- -- >>> :kind! Eval (First ((+) 1) '(3,"a")) -- Eval (First ((+) 1) '(3,"a")) :: (Nat, Symbol) -- = '(4, "a") data First :: (a -> Exp b) -> f a c -> Exp (f b c) type instance Eval (First f x) = Eval (Bimap f Pure x) -- | Type-level 'Data.Bifunctor.second'. -- Apply a function along the second parameter of a bifunctor. -- -- This is generally equivalent to 'Data.Functor.Map'. -- -- === __Example__ -- -- >>> :kind! Eval (Second ((+) 1) '("a",3)) -- Eval (Second ((+) 1) '("a",3)) :: (Symbol, Nat) -- = '("a", 4) data Second :: (c -> Exp d) -> f a c -> Exp (f a d) type instance Eval (Second g x) = Eval (Bimap Pure g x) first-class-families-0.8.0.1/src/Fcf/Class/Foldable.hs0000644000000000000000000001435613672702407020504 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Foldable types. -- -- A minimal implementation of this interface is given by either 'FoldMap' or -- 'Foldr', but a default still needs to be given explicitly for the other. -- -- @ -- data MyType a = ... {- Some custom Foldable type -} -- -- -- Method 1: Implement Foldr, default FoldMap. -- type instance 'Eval' ('Foldr' f y xs) = ... {- Explicit implementation -} -- type instance 'Eval' ('FoldMap' f xs) = 'FoldMapDefault_' f xs {- Default -} -- -- -- Method 2: Implement FoldMap, default Foldr. -- type instance 'Eval' ('FoldMap' f xs) = ... {- Explicit implementation -} -- type instance 'Eval' ('Foldr' f y xs) = 'FoldrDefault_' f y xs {- Default -} -- @ module Fcf.Class.Foldable ( -- * Core interface Foldr , FoldMap -- ** Default implementations , FoldMapDefault_ , FoldrDefault_ -- * Derived operations -- ** Predicates , And , Or , All , Any -- ** Numbers , Sum -- ** Lists , Concat , ConcatMap ) where import Fcf.Core (Exp, Eval) import Fcf.Combinators (Pure, Pure1, type (<=<)) import Fcf.Data.Function (Bicomap) import Fcf.Class.Monoid import Fcf.Class.Monoid.Types (Endo(..), UnEndo) import Fcf.Data.Bool (type (&&), type (||)) import Fcf.Data.Nat (Nat, type (+)) -- $setup -- >>> import Fcf.Combinators (Flip) -- >>> import Fcf.Class.Ord (type (<)) -- | Type-level 'Data.Foldable.foldMap'. data FoldMap :: (a -> Exp m) -> t a -> Exp m -- List type instance Eval (FoldMap f '[]) = MEmpty type instance Eval (FoldMap f (x ': xs)) = Eval (f x) <> Eval (FoldMap f xs) -- Maybe type instance Eval (FoldMap f 'Nothing) = MEmpty type instance Eval (FoldMap f ('Just x)) = Eval (f x) -- Either type instance Eval (FoldMap f ('Left _a)) = MEmpty type instance Eval (FoldMap f ('Right x)) = Eval (f x) -- | Default implementation of 'FoldMap'. -- -- === __Usage__ -- -- To define an instance of 'FoldMap' for a custom @MyType@ for which you already have -- an instance of 'Foldr': -- -- @ -- type instance 'Eval' ('FoldMap' f (xs :: MyType a)) = 'FoldMapDefault_' f xs -- @ -- -- ==== __Example__ -- -- >>> :kind! FoldMapDefault_ Pure '[ 'EQ, 'LT, 'GT ] -- FoldMapDefault_ Pure '[ 'EQ, 'LT, 'GT ] :: Ordering -- = 'LT type FoldMapDefault_ f xs = Eval (Foldr (Bicomap f Pure (.<>)) MEmpty xs) -- | Default implementation of 'Foldr'. -- -- === __Usage__ -- -- To define an instance of 'Foldr' for a custom @MyType@ for which you already -- have an instance of 'FoldMap': -- -- @ -- type instance 'Eval' ('Foldr' f y (xs :: MyType a)) = 'FoldrDefault_' f y xs -- @ -- -- ==== __Example__ -- -- >>> :kind! FoldrDefault_ (.<>) 'EQ '[ 'EQ, 'LT, 'GT ] -- FoldrDefault_ (.<>) 'EQ '[ 'EQ, 'LT, 'GT ] :: Ordering -- = 'LT type FoldrDefault_ f y xs = Eval (UnEndo (Eval (FoldMap (Pure1 'Endo <=< Pure1 f) xs)) y) -- | Right fold. -- -- === __Example__ -- -- >>> :kind! Eval (Foldr (+) 0 '[1, 2, 3, 4]) -- Eval (Foldr (+) 0 '[1, 2, 3, 4]) :: Nat -- = 10 data Foldr :: (a -> b -> Exp b) -> b -> t a -> Exp b -- List type instance Eval (Foldr f y '[]) = y type instance Eval (Foldr f y (x ': xs)) = Eval (f x (Eval (Foldr f y xs))) -- Maybe type instance Eval (Foldr f y 'Nothing) = y type instance Eval (Foldr f y ('Just x)) = Eval (f x y) -- Either type instance Eval (Foldr f y ('Left _a)) = y type instance Eval (Foldr f y ('Right x)) = Eval (f x y) -- * Derived operations -- | Give @True@ if all of the booleans in the list are @True@. -- -- === __Example__ -- -- >>> :kind! Eval (And '[ 'True, 'True]) -- Eval (And '[ 'True, 'True]) :: Bool -- = 'True -- -- >>> :kind! Eval (And '[ 'True, 'True, 'False]) -- Eval (And '[ 'True, 'True, 'False]) :: Bool -- = 'False data And :: t Bool -> Exp Bool type instance Eval (And lst) = Eval (Foldr (&&) 'True lst) -- | Whether all elements of the list satisfy a predicate. -- -- Note: this identifier conflicts with 'Data.Monoid.All' (from "Data.Monoid"). -- -- === __Example__ -- -- >>> :kind! Eval (All (Flip (<) 6) '[0,1,2,3,4,5]) -- Eval (All (Flip (<) 6) '[0,1,2,3,4,5]) :: Bool -- = 'True -- -- >>> :kind! Eval (All (Flip (<) 5) '[0,1,2,3,4,5]) -- Eval (All (Flip (<) 5) '[0,1,2,3,4,5]) :: Bool -- = 'False data All :: (a -> Exp Bool) -> t a -> Exp Bool type instance Eval (All p lst) = Eval (Foldr (Bicomap p Pure (&&)) 'True lst) -- | Give @True@ if any of the booleans in the list are @True@. -- -- === __Example__ -- -- >>> :kind! Eval (Or '[ 'True, 'True]) -- Eval (Or '[ 'True, 'True]) :: Bool -- = 'True -- -- >>> :kind! Eval (Or '[ 'False, 'False]) -- Eval (Or '[ 'False, 'False]) :: Bool -- = 'False data Or :: t Bool -> Exp Bool type instance Eval (Or lst) = Eval (Foldr (||) 'False lst) -- | Whether any element of the list satisfies a predicate. -- -- Note: this identifier conflicts with 'Fcf.Utils.Any' (from "Fcf.Utils"), -- 'Data.Monoid.Any' (from "Data.Monoid"), and 'GHC.Exts.Any' (from "GHC.Exts"). -- -- === __Example__ -- -- >>> :kind! Eval (Any (Flip (<) 5) '[0,1,2,3,4,5]) -- Eval (Any (Flip (<) 5) '[0,1,2,3,4,5]) :: Bool -- = 'True -- -- >>> :kind! Eval (Any (Flip (<) 0) '[0,1,2,3,4,5]) -- Eval (Any (Flip (<) 0) '[0,1,2,3,4,5]) :: Bool -- = 'False data Any :: (a -> Exp Bool) -> t a -> Exp Bool type instance Eval (Any p lst) = Eval (Foldr (Bicomap p Pure (||)) 'False lst) -- | Sum a @Nat@-list. -- -- === __Example__ -- -- >>> :kind! Eval (Sum '[1,2,3]) -- Eval (Sum '[1,2,3]) :: Nat -- = 6 data Sum :: t Nat -> Exp Nat type instance Eval (Sum ns) = Eval (Foldr (+) 0 ns) -- | Concatenate a collection of elements from a monoid. -- -- === __Example__ -- -- For example, fold a list of lists. -- -- > Concat :: [[a]] -> Exp [a] -- -- >>> :kind! Eval (Concat ( '[ '[1,2], '[3,4], '[5,6]])) -- Eval (Concat ( '[ '[1,2], '[3,4], '[5,6]])) :: [Nat] -- = '[1, 2, 3, 4, 5, 6] -- >>> :kind! Eval (Concat ( '[ '[Int, Maybe Int], '[Maybe String, Either Double Int]])) -- Eval (Concat ( '[ '[Int, Maybe Int], '[Maybe String, Either Double Int]])) :: [*] -- = '[Int, Maybe Int, Maybe String, Either Double Int] -- data Concat :: t m -> Exp m type instance Eval (Concat xs) = Eval (FoldMap Pure xs) -- | Map a function and concatenate the results. -- -- This is 'FoldMap' specialized to the list monoid. data ConcatMap :: (a -> Exp [b]) -> t a -> Exp [b] type instance Eval (ConcatMap f xs) = Eval (FoldMap f xs) first-class-families-0.8.0.1/src/Fcf/Class/Functor.hs0000644000000000000000000000277614021277556020420 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} module Fcf.Class.Functor ( Map , FMap ) where import Fcf.Core (Exp, Eval) -- $setup -- >>> :set -XUndecidableInstances -XTypeInType -- >>> import Fcf.Core (Eval, Exp) -- >>> import Fcf.Data.Nat -- >>> import qualified GHC.TypeLits as TL -- | Type-level 'fmap' for type-level functors. -- -- Note: this name clashes with 'Data.Map.Lazy.Map' from /containers/. -- 'FMap' is provided as a synonym to avoid this. -- -- === __Example__ -- -- >>> data AddMul :: Nat -> Nat -> Exp Nat -- >>> type instance Eval (AddMul x y) = (x TL.+ y) TL.* (x TL.+ y) -- >>> :kind! Eval (Map (AddMul 2) '[0, 1, 2, 3, 4]) -- Eval (Map (AddMul 2) '[0, 1, 2, 3, 4]) :: [Nat] -- = '[4, 9, 16, 25, 36] data Map :: (a -> Exp b) -> f a -> Exp (f b) -- | Synonym of 'Map' to avoid name clashes. type FMap = Map -- [] type instance Eval (Map f '[]) = '[] type instance Eval (Map f (a ': as)) = Eval (f a) ': Eval (Map f as) -- Maybe type instance Eval (Map f 'Nothing) = 'Nothing type instance Eval (Map f ('Just a)) = 'Just (Eval (f a)) -- Either type instance Eval (Map f ('Left x)) = 'Left x type instance Eval (Map f ('Right a)) = 'Right (Eval (f a)) -- Tuples type instance Eval (Map f '(x, a)) = '(x, Eval (f a)) type instance Eval (Map f '(x, y, a)) = '(x, y, Eval (f a)) type instance Eval (Map f '(x, y, z, a)) = '(x, y, z, Eval (f a)) type instance Eval (Map f '(x, y, z, w, a)) = '(x, y, z, w, Eval (f a)) first-class-families-0.8.0.1/src/Fcf/Class/Monoid.hs0000644000000000000000000000527013672702407020214 0ustar0000000000000000{-# LANGUAGE CPP, DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Semigroups and monoids. module Fcf.Class.Monoid ( -- * Pure type families -- | Nicer to use when applied explicitly. type (<>) , MEmpty -- * First-class families -- | Can be composed and passed to higher-order functions. , type (.<>) , MEmpty_ ) where import Fcf.Core (Exp, Eval) import Data.Monoid (All(..), Any(..)) import Data.Type.Bool (type (&&), type (||)) #if __GLASGOW_HASKELL__ >= 802 import GHC.TypeLits (AppendSymbol) #endif -- $setup -- >>> import GHC.TypeLits (Nat) -- | Type-level semigroup composition @('Data.Semigroup.<>')@. -- -- This is the fcf-encoding of @('<>')@. -- To define a new semigroup, add type instances to @('<>')@. data (.<>) :: a -> a -> Exp a type instance Eval (x .<> y) = x <> y -- | Type-level semigroup composition @('Data.Semigroup.<>')@. type family (<>) (x :: a) (y :: a) :: a -- (,) type instance (<>) '(a1, a2) '(b1, b2) = '(a1 <> b1, a2 <> b2) -- (,,) type instance (<>) '(a1, a2, a3) '(b1, b2, b3) = '(a1 <> b1, a2 <> b2, a3 <> b3) -- List type instance (<>) '[] ys = ys type instance (<>) (x ': xs) ys = x ': (<>) xs ys -- Maybe type instance (<>) 'Nothing b = b type instance (<>) a 'Nothing = a type instance (<>) ('Just a) ('Just b) = 'Just (a <> b) -- Ordering type instance (<>) 'EQ b = b type instance (<>) a 'EQ = a type instance (<>) 'LT _b = 'LT type instance (<>) 'GT _b = 'GT -- () type instance (<>) _a _b = '() -- All type instance (<>) ('All a) ('All b) = 'All (a && b) -- Any type instance (<>) ('Any a) ('Any b) = 'Any (a || b) #if __GLASGOW_HASKELL__ >= 802 -- Symbol -- | With /base >= 4.10.0.0/. type instance (<>) x y = AppendSymbol x y #endif -- | Type-level monoid identity 'Data.Monoid.mempty'. -- -- This is the fcf-encoding of 'MEmpty'. data MEmpty_ :: Exp a type instance Eval MEmpty_ = MEmpty -- | Type-level monoid identity 'Data.Monoid.mempty'. -- -- === __Examples__ -- -- >>> :kind! 'LT <> MEmpty -- 'LT <> MEmpty :: Ordering -- = 'LT -- -- >>> :kind! MEmpty <> '( 'EQ, '[1, 2]) -- MEmpty <> '( 'EQ, '[1, 2]) :: (Ordering, [Nat]) -- = '( 'EQ, '[1, 2]) -- -- >>> :kind! '( 'GT, 'Just '()) <> MEmpty -- '( 'GT, 'Just '()) <> MEmpty :: (Ordering, Maybe ()) -- = '( 'GT, 'Just '()) type family MEmpty :: a -- (,) type instance MEmpty = '(MEmpty, MEmpty) -- (,,) type instance MEmpty = '(MEmpty, MEmpty, MEmpty) -- List type instance MEmpty = '[] -- Maybe type instance MEmpty = 'Nothing -- Ordering type instance MEmpty = 'EQ -- () type instance MEmpty = '() -- All type instance MEmpty = 'All 'True -- Any type instance MEmpty = 'Any 'False -- Symbol type instance MEmpty = "" first-class-families-0.8.0.1/src/Fcf/Class/Monoid/Types.hs0000644000000000000000000000145613672702407021322 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Carriers of useful monoid instances. module Fcf.Class.Monoid.Types ( -- * Endo Endo(..) , UnEndo ) where import Fcf.Core (Exp) import Fcf.Combinators (Pure, type (<=<)) import Fcf.Class.Monoid -- | Endofunctions. -- -- === __Details__ -- -- This is is used in the default implementation of -- 'Fcf.Class.Foldable.Foldr' in terms of -- 'Fcf.Class.Foldable.FoldMap'. newtype Endo a = Endo (a -> Exp a) -- | Inverse of the 'Endo' constructor. type family UnEndo (e :: Endo a) :: a -> Exp a where UnEndo ('Endo f) = f -- * Endo as a monoid -- -- Note it is only a monoid up to 'Eval'. type instance 'Endo f <> 'Endo g = 'Endo (f <=< g) type instance MEmpty = 'Endo Pure first-class-families-0.8.0.1/src/Fcf/Class/Ord.hs0000644000000000000000000000731714021277556017520 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Equality and ordering. -- -- Note that equality doesn't really require a class, -- it can be defined uniformly as 'TyEq'. module Fcf.Class.Ord ( -- * Order Compare , type (<=) , type (>=) , type (<) , type (>) -- * Equality , TyEq ) where import qualified GHC.TypeLits as TL import Fcf.Core import Fcf.Class.Monoid (type (<>)) -- Semigroup Ordering import Fcf.Data.Bool (Not) import Fcf.Utils (TyEq) -- $setup -- >>> import Fcf.Core (Eval) -- | Type-level 'compare' for totally ordered data types. -- -- === __Example__ -- -- >>> :kind! Eval (Compare "a" "b") -- Eval (Compare "a" "b") :: Ordering -- = 'LT -- -- >>> :kind! Eval (Compare '[1, 2, 3] '[1, 2, 3]) -- Eval (Compare '[1, 2, 3] '[1, 2, 3]) :: Ordering -- = 'EQ -- -- >>> :kind! Eval (Compare '[1, 3] '[1, 2]) -- Eval (Compare '[1, 3] '[1, 2]) :: Ordering -- = 'GT data Compare :: a -> a -> Exp Ordering -- (,) type instance Eval (Compare '(a1, a2) '(b1, b2)) = Eval (Compare a1 b1) <> Eval (Compare a2 b2) -- (,,) type instance Eval (Compare '(a1, a2, a3) '(b1, b2, b3)) = Eval (Compare a1 b1) <> Eval (Compare a2 b2) <> Eval (Compare a3 b3) -- Either type instance Eval (Compare ('Left a) ('Left b)) = Eval (Compare a b) type instance Eval (Compare ('Right a) ('Right b)) = Eval (Compare a b) type instance Eval (Compare ('Left _a) ('Right _b)) = 'LT type instance Eval (Compare ('Right _a) ('Left _b)) = 'GT -- Maybe type instance Eval (Compare 'Nothing 'Nothing) = 'EQ type instance Eval (Compare ('Just a) ('Just b)) = Eval (Compare a b) type instance Eval (Compare 'Nothing ('Just _b)) = 'LT type instance Eval (Compare ('Just _a) 'Nothing) = 'GT -- List type instance Eval (Compare '[] '[]) = 'EQ type instance Eval (Compare (x ': xs) (y ': ys)) = Eval (Compare x y) <> Eval (Compare xs ys) type instance Eval (Compare '[] (_y ': _ys)) = 'LT type instance Eval (Compare (_x ': _xs) '[]) = 'GT -- Bool type instance Eval (Compare (a :: Bool) a) = 'EQ type instance Eval (Compare 'False 'True) = 'GT type instance Eval (Compare 'True 'False) = 'GT -- Ordering type instance Eval (Compare (a :: Ordering) a) = 'EQ type instance Eval (Compare 'LT 'EQ) = 'LT type instance Eval (Compare 'LT 'GT) = 'LT type instance Eval (Compare 'EQ 'GT) = 'LT type instance Eval (Compare 'EQ 'LT) = 'GT type instance Eval (Compare 'GT 'LT) = 'GT type instance Eval (Compare 'GT 'EQ) = 'GT -- Symbol type instance Eval (Compare a b) = TL.CmpSymbol a b -- Nat type instance Eval (Compare a b) = TL.CmpNat a b -- () type instance Eval (Compare (a :: ()) b) = 'EQ -- * Derived operations -- Asymmetric comparison operators @Exp a -> a -> Bool@. type a ~== b = Eval (TyEq (Eval a) b) type a ~/= b = Eval (Not (a ~== b)) -- | "Smaller than or equal to". Type-level version of @('<=')@. -- -- === __Example__ -- -- >>> :kind! Eval ("b" <= "a") -- Eval ("b" <= "a") :: Bool -- = 'False data (<=) :: a -> a -> Exp Bool type instance Eval ((<=) a b) = Compare a b ~/= 'GT -- | "Greater than or equal to". Type-level version of @('>=')@. -- -- === __Example__ -- -- >>> :kind! Eval ("b" >= "a") -- Eval ("b" >= "a") :: Bool -- = 'True data (>=) :: a -> a -> Exp Bool type instance Eval ((>=) a b) = Compare a b ~/= 'LT -- | "Smaller than". Type-level version of @('<')@. -- -- === __Example__ -- -- >>> :kind! Eval ("a" < "b") -- Eval ("a" < "b") :: Bool -- = 'True data (<) :: a -> a -> Exp Bool type instance Eval ((<) a b) = Compare a b ~== 'LT -- | "Greater than". Type-level version of @('>')@. -- -- === __Example__ -- -- >>> :kind! Eval ("b" > "a") -- Eval ("b" > "a") :: Bool -- = 'True data (>) :: a -> a -> Exp Bool type instance Eval ((>) a b) = Compare a b ~== 'GT first-class-families-0.8.0.1/src/Fcf/Utils.hs0000644000000000000000000000672513672702407017030 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DataKinds, PolyKinds, RankNTypes, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} -- | Miscellaneous families. module Fcf.Utils ( Error , TError , Constraints , TyEq , Stuck , IsBool(_If) , Case , Match() , type (-->) , Is , Any , Else -- * From "Data.Type.Bool" , If ) where import Data.Kind (Constraint) import Data.Type.Bool (If) import GHC.TypeLits (Symbol, TypeError, ErrorMessage(..)) import Fcf.Core import Fcf.Combinators (Pure) -- | Type-level 'error'. data Error :: Symbol -> Exp a type instance Eval (Error msg) = TypeError ('Text msg) -- | 'TypeError' as a fcf. data TError :: ErrorMessage -> Exp a type instance Eval (TError msg) = TypeError msg -- | Conjunction of a list of constraints. data Constraints :: [Constraint] -> Exp Constraint type instance Eval (Constraints '[]) = (() :: Constraint) type instance Eval (Constraints (a ': as)) = (a, Eval (Constraints as)) -- | Type equality. -- -- === __Details__ -- -- The base library also defines a similar @('Type.Equality.==')@; -- it differs from 'TyEq' in the following ways: -- -- * 'TyEq' is heterogeneous: its arguments may have different kinds; -- * 'TyEq' is reflexive: @TyEq a a@ always reduces to 'True' even if @a@ is -- a variable. data TyEq :: a -> b -> Exp Bool type instance Eval (TyEq a b) = TyEqImpl a b type family TyEqImpl (a :: k) (b :: l) :: Bool where TyEqImpl a a = 'True TyEqImpl a b = 'False -- | A stuck type that can be used like a type-level 'undefined'. type family Stuck :: a -- * Reification class IsBool (b :: Bool) where _If :: ((b ~ 'True) => r) -> ((b ~ 'False) => r) -> r instance IsBool 'True where _If a _ = a instance IsBool 'False where _If _ b = b -- * Case splitting infix 0 --> data Match j k = Match_ j k | Is_ (j -> Exp Bool) k | Any_ k | Else_ (j -> Exp k) -- | (Limited) equivalent of @\\case { .. }@ syntax. Supports matching of exact -- values ('-->') and final matches for any value ('Any') or for passing value -- to subcomputation ('Else'). Examples: -- -- @ -- type BoolToNat = 'Case' -- [ 'True '-->' 0 -- , 'False '-->' 1 -- ] -- -- type NatToBool = 'Case' -- [ 0 '-->' 'False -- , 'Any' 'True -- ] -- -- type ZeroOneOrSucc = 'Case' -- [ 0 '-->' 0 -- , 1 '-->' 1 -- , 'Else' (('+') 1) -- ] -- @ data Case :: [Match j k] -> j -> Exp k type instance Eval (Case ms a) = Case_ ms a type family Case_ (ms :: [Match j k]) (a :: j) :: k where Case_ ('Match_ a' b : ms) a = Eval (If (TyEqImpl a' a) (Pure b) (Case ms a)) Case_ ('Is_ p b : ms) a = Case_ [ 'True --> b , 'False --> Case_ ms a ] (p @@ a) Case_ ('Any_ b : _ ) _ = b Case_ ('Else_ f : _ ) a = f @@ a -- | Match concrete type in 'Case'. type (-->) = ('Match_ :: j -> k -> Match j k) -- | Match on predicate being successful with type in 'Case'. type Is = ('Is_ :: (j -> Exp Bool) -> k -> Match j k) -- | Match any type in 'Case'. Should be used as a final branch. -- -- Note: this identifier conflicts with 'Fcf.Class.Foldable.Any' (from "Fcf.Class.Foldable") -- 'Data.Monoid.Any' (from "Data.Monoid"), and 'GHC.Exts.Any' (from "GHC.Exts"). -- -- We recommend importing this one qualified. type Any = ('Any_ :: k -> Match j k) -- | Pass type being matched in 'Case' to subcomputation. Should be used as a -- final branch. type Else = ('Else_ :: (j -> Exp k) -> Match j k) first-class-families-0.8.0.1/test/test.hs0000644000000000000000000000561013672702407016371 0ustar0000000000000000{-# LANGUAGE CPP, DataKinds, KindSignatures, TypeOperators #-} import Data.Type.Equality ((:~:)(Refl)) import qualified Data.Monoid as Monoid import Fcf.Core (Eval, type (@@)) import Fcf.Combinators import Fcf.Utils (Case, type (-->), Error) import qualified Fcf.Utils as Case import Fcf.Class.Bifunctor import Fcf.Class.Foldable import Fcf.Class.Monoid import Fcf.Class.Ord import Fcf.Data.Function import Fcf.Data.List import Fcf.Data.Nat (type (+)) type UnitPrefix = Case [ 0 --> "" , 1 --> "deci" , 2 --> "hecto" , 3 --> "kilo" , 6 --> "mega" , 9 --> "giga" , Case.Any (Error @@ "Something Else") ] -- Compile-time tests _ = Refl :: Eval (UnitPrefix 0) :~: "" _ = Refl :: Eval (UnitPrefix 3) :~: "kilo" -- * Class -- ** Ord _ = Refl :: Eval (Compare '( '(), 0 ) '( '(), 1 )) :~: 'LT _ = Refl :: Eval (Compare '( 1, 3 ) '( 1, 2 )) :~: 'GT _ = Refl :: Eval (Compare ('Left '()) ('Right 'LT)) :~: 'LT _ = Refl :: Eval (Compare ('Right 'EQ) ('Right 'EQ)) :~: 'EQ _ = Refl :: Eval (Compare '[ 'LT, 'EQ, 'GT ] '[ 'LT, 'EQ, 'GT ]) :~: 'EQ _ = Refl :: Eval (Compare 'True 'True) :~: 'EQ _ = Refl :: Eval (Compare "A" "B") :~: 'LT _ = Refl :: Eval (1 <= 1) :~: 'True _ = Refl :: Eval (2 <= 1) :~: 'False _ = Refl :: Eval (1 < 1) :~: 'False _ = Refl :: Eval (1 < 2) :~: 'True _ = Refl :: Eval (1 >= 1) :~: 'True _ = Refl :: Eval (1 >= 2) :~: 'False _ = Refl :: Eval (1 > 1) :~: 'False _ = Refl :: Eval (2 > 1) :~: 'True -- ** Monoid _ = Refl :: Eval ('( '(), '[ 'LT, 'EQ ]) .<> '( '(), '[ 'GT ])) :~: '( '(), '[ 'LT, 'EQ, 'GT ]) _ = Refl :: Eval ('Nothing .<> 'Just '[]) :~: 'Just '[] _ = Refl :: Eval ('LT .<> 'GT) :~: 'LT _ = Refl :: Eval ('EQ .<> 'GT) :~: 'GT _ = Refl :: Eval ('Monoid.All 'True .<> 'Monoid.All 'False) :~: 'Monoid.All 'False _ = Refl :: Eval ('Monoid.Any 'True .<> 'Monoid.Any 'False) :~: 'Monoid.Any 'True #if __GLASGOW_HASKELL__ >= 802 _ = Refl :: Eval ("a" .<> MEmpty) :~: "a" #endif -- ** Foldable _ = Refl :: Eval (FoldMap (Pure1 'Monoid.All) '[ 'True, 'False ]) :~: 'Monoid.All 'False _ = Refl :: Eval (FoldMap (Pure1 'Monoid.All) 'Nothing) :~: 'Monoid.All 'True _ = Refl :: Eval (Foldr (.<>) 'LT '[ 'EQ, 'EQ ]) :~: 'LT _ = Refl :: Eval (And '[ 'False, 'False ]) :~: 'False _ = Refl :: Eval (Or '[ 'False, 'False ]) :~: 'False _ = Refl :: Eval (Concat ('Right 'LT)) :~: 'LT _ = Refl :: FoldMapDefault_ (Pure1 'Monoid.All) 'Nothing :~: 'Monoid.All 'True _ = Refl :: FoldrDefault_ (.<>) 'LT '[ 'EQ, 'EQ ] :~: 'LT -- ** Functor _ = Refl :: Eval (Bimap ((+) 1) (Pure2 '(:) '()) '(8, '[])) :~: '(9, '[ '()]) _ = Refl :: Eval (First ((+) 1) ('Left 8)) :~: 'Left 9 _ = Refl :: Eval (First ((+) 1) ('Right 0)) :~: 'Right 0 _ = Refl :: Eval (Second ((+) 1) ('Left 0)) :~: 'Left 0 _ = Refl :: Eval (Second ((+) 1) ('Right 8)) :~: 'Right 9 -- ** Function _ = Refl :: Eval (3 & Pure) :~: 3 _ = Refl :: Eval (((+) `On` Length) '[1,2,3] '[1,2]) :~: 5 -- Dummy main :: IO () main = pure () first-class-families-0.8.0.1/LICENSE0000644000000000000000000000204513672702407015103 0ustar0000000000000000Copyright Li-yao Xia (c) 2018 Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.first-class-families-0.8.0.1/Setup.hs0000644000000000000000000000005613672702407015532 0ustar0000000000000000import Distribution.Simple main = defaultMain first-class-families-0.8.0.1/first-class-families.cabal0000644000000000000000000000272114021277556021105 0ustar0000000000000000name: first-class-families version: 0.8.0.1 synopsis: First-class type families description: A library for type-level programming. . See README. homepage: https://github.com/Lysxia/first-class-families#readme license: MIT license-file: LICENSE author: Li-yao Xia maintainer: lysxia@gmail.com copyright: 2018 Li-yao Xia category: Other build-type: Simple extra-source-files: README.md, CHANGELOG.md cabal-version: >=1.10 tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1, GHC == 8.10.1, GHC == 9.0.1 library hs-source-dirs: src exposed-modules: Fcf Fcf.Core Fcf.Combinators Fcf.Data.Bool Fcf.Data.Common Fcf.Data.Function Fcf.Data.List Fcf.Data.Nat Fcf.Data.Symbol Fcf.Classes Fcf.Class.Bifunctor Fcf.Class.Foldable Fcf.Class.Functor Fcf.Class.Monoid Fcf.Class.Monoid.Types Fcf.Class.Ord Fcf.Utils build-depends: -- This upper bound is conservative. base >= 4.9 && < 4.16 ghc-options: -Wall default-language: Haskell2010 test-suite fcf-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test.hs default-language: Haskell2010 build-depends: base, first-class-families source-repository head type: git location: https://github.com/Lysxia/first-class-families first-class-families-0.8.0.1/README.md0000644000000000000000000000606513672702407015363 0ustar0000000000000000# First-class type families [![Hackage](https://img.shields.io/hackage/v/first-class-families.svg)](https://hackage.haskell.org/package/first-class-families) [![Build Status](https://travis-ci.org/Lysxia/first-class-families.svg)](https://travis-ci.org/Lysxia/first-class-families) First-class type families are type-level functions that can be composed using higher-order functions. The core of the idea is an extensible kind of "type-level expressions" and an open type family for evaluating such expressions. ```haskell type Exp (k :: Type) :: Type type family Eval (e :: Exp k) :: k ``` This library provides that core foundation, and also exports basic first-class type families. ## Example For example, consider this simple type family: ```haskell type family FromMaybe (a :: k) (m :: Maybe k) :: k type instance FromMaybe a 'Nothing = a type instance FromMaybe a ('Just b) = b ``` With first-class-families (fcfs), it translates to a `data` declaration and instances for a single `Eval` family: ```haskell import Fcf data FromMaybe :: k -> Maybe k -> Exp k type instance Eval (FromMaybe a 'Nothing) = a type instance Eval (FromMaybe a ('Just b)) = b ``` That way, the `FromMaybe` constructor can be partially applied, and passed to higher-order fcfs such as `Map`: ```haskell Eval (Map (FromMaybe 0) '[ 'Just 1, 'Nothing ]) = '[ 1, 0 ] :: [Nat] ``` Essential language extensions: ```haskell {-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeInType, TypeOperators, UndecidableInstances #-} ``` ## Overview - `Fcf.Core`: definition of `Exp` and `Eval`. - `Fcf.Combinators`: general combinators to compose first-class families. - `Fcf.Data.*`: first-class families on common data types. - `Fcf.Class.*`: overloaded first-class families. - `Fcf.Utils`: miscellaneous. The top-level module `Fcf` is a prelude to get acquainted with the library. For regular use, import what you need from the specialized modules above, preferably with explicit import lists. ```haskell import Fcf -- Simple but fragile import Fcf.Class.Functor (FMap) -- Explicit and robust ``` ## Features ### Overloaded type families Value-level functions can be overloaded using type classes. Type families---type-level functions---are open by design, so overloading is as easy as just declaring them with more general types. ```haskell data Map :: (a -> Exp b) -> f a -> Exp (f b) -- Instances for f = [] type instance Eval (Map f '[]) = '[] type instance Eval (Map f (x ': xs)) = Eval (f x) ': Eval (Map f xs) -- Instances for f = Maybe type instance Eval (Map f 'Nothing) = 'Nothing type instance Eval (Map f ('Just x)) = 'Just (Eval (f x)) ``` ## See also - [Haskell with only one type family](http://blog.poisson.chat/posts/2018-08-06-one-type-family.html) - [Overloaded type families](https://blog.poisson.chat/posts/2018-09-29-overloaded-families.html) - [The *singletons* library](https://hackage.haskell.org/package/singletons) --- Contributions are welcome. Feel free to open an issue or make a PR on [Github](https://github.com/Lysxia/first-class-families)! first-class-families-0.8.0.1/CHANGELOG.md0000644000000000000000000000342314021277556015711 0ustar0000000000000000# 0.8.0.1 - Bump upper bounds for GHC 9.0 - Update doctests for cabal-docspec # 0.8.0.0 - Add modules + `Fcf.Data.Symbol` (currently just reexports `Symbol`) (thanks to gspia) + `Fcf.Data.Function` + "Overloaded type families" ("type-level type classes") * `Fcf.Class.Ord` * `Fcf.Class.Monoid` * `Fcf.Class.Monoid.Types` (which exports just an `Endo a` to wrap `a -> Exp a`) * `Fcf.Class.Functor` * `Fcf.Class.Bifunctor` * `Fcf.Class.Foldable` - Add functions in `Fcf.Data.List`: `Intersperse`, `Intercalate`, `Span`, `Break`, `Tails`, `IsPrefixOf`, `IsSuffixOf`, `IsInfixOf`, `Partition`. - Generalize `Foldr`, `Concat` and `ConcatMap` to foldable types. - Remove deprecated `Guarded`, `Guard((:=))`, `Otherwise`. - Deprecate `Fcf.Classes` # 0.7.0.0 - Add `Unfoldr`, `Concat`, `ConcatMap`, `Replicate`, `Take`, `Drop`, `TakeWhile`, `DropWhile`, `Reverse` to `Data.List`. (thanks to gspia) - Change `Elem`, `Lookup`, `Zip` to be `data` instead of `type` synonyms. - Fix performance of `Filter` and `Find`. # 0.6.0.0 - Add `Fcf.Utils.Case` and `(Fcf.Combinators.>>=)` (thanks to TheMatten) - Deprecate `Fcf.Bool.Guarded` - GHC 8.8 compatibility # 0.5.0.0 - Modularized library - `Fcf.Utils`: + Add `TError` + Rename `Collapse` to `Constraints` - `Fcf.Data.List`: Added `Cons`, `Last`, `Init`, `Elem` # 0.4.0.0 - New functions (thanks to blmage) + `LiftM`, `LiftM2`, `LiftM3` + `(<=)`, `(>=)`, `(<)`, `(>)` + `Guarded`, `Guard((:=))`, `Otherwise` # 0.3.0.1 - GHC 8.6 compatibility # 0.3.0.0 - More new functions, (thanks to isovector) # 0.2.0.0 - A whole bunch of basic functions (thanks to isovector) - Remove `Traverse` (now `Map`), `BimapPair`, `BimapEither` (now `Bimap`) # 0.1.0.0 Initial version