mirror of
https://github.com/Lysxia/first-class-families.git
synced 2024-09-11 19:47:12 +03:00
Add Fcf.Class.Foldable and Fcf.Class.Monoid.Types
This commit is contained in:
parent
7419cd47e3
commit
6de9f4a50d
@ -34,8 +34,10 @@ library
|
||||
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:
|
||||
|
195
src/Fcf/Class/Foldable.hs
Normal file
195
src/Fcf/Class/Foldable.hs
Normal file
@ -0,0 +1,195 @@
|
||||
{-# 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
|
||||
, And
|
||||
, Or
|
||||
, All
|
||||
, Any
|
||||
, Sum
|
||||
) 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.
|
||||
--
|
||||
-- === __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 :: [Bool] -> Exp Bool
|
||||
type instance Eval (Or lst) = Eval (Foldr (||) 'False lst)
|
||||
|
||||
|
||||
-- | Whether any element of the list satisfies a predicate.
|
||||
--
|
||||
-- === __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)
|
32
src/Fcf/Class/Monoid/Types.hs
Normal file
32
src/Fcf/Class/Monoid/Types.hs
Normal file
@ -0,0 +1,32 @@
|
||||
{-# 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.
|
||||
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
|
@ -79,9 +79,9 @@ 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.Function (Bicomap)
|
||||
import Fcf.Data.Nat
|
||||
import Fcf.Utils (If, TyEq)
|
||||
|
||||
@ -203,17 +203,6 @@ data Intercalate :: [a] -> [[a]] -> Exp [a]
|
||||
type instance Eval (Intercalate xs xss) = Eval (Concat =<< Intersperse xs xss)
|
||||
|
||||
|
||||
-- | 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 -> [a] -> Exp b
|
||||
type instance Eval (Foldr f y '[]) = y
|
||||
type instance Eval (Foldr f y (x ': xs)) = Eval (f x (Eval (Foldr f y xs)))
|
||||
|
||||
-- | 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)
|
||||
@ -238,77 +227,6 @@ data ConcatMap :: (a -> Exp [b]) -> [a] -> Exp [b]
|
||||
type instance Eval (ConcatMap f lst) = Eval (Concat (Eval (Map f lst)))
|
||||
|
||||
|
||||
-- | 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 :: [Bool] -> Exp Bool
|
||||
type instance Eval (And lst) = Eval (Foldr (&&) 'True lst)
|
||||
|
||||
|
||||
-- | Whether all elements of the list satisfy a predicate.
|
||||
--
|
||||
-- === __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) -> [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 :: [Bool] -> Exp Bool
|
||||
type instance Eval (Or lst) = Eval (Foldr (||) 'False lst)
|
||||
|
||||
|
||||
-- | Whether any element of the list satisfies a predicate.
|
||||
--
|
||||
-- === __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) -> [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 :: [Nat] -> Exp Nat
|
||||
type instance Eval (Sum ns) = Eval (Foldr (+) 0 ns)
|
||||
|
||||
|
||||
-- Helper for the Unfoldr.
|
||||
data UnfoldrCase :: (b -> Exp (Maybe (a, b))) -> Maybe (a, b) -> Exp [a]
|
||||
type instance Eval (UnfoldrCase f ('Just ab)) =
|
||||
|
Loading…
Reference in New Issue
Block a user