diff --git a/Data/TASequence.hs b/Data/TASequence.hs index e72b347..324bd93 100644 --- a/Data/TASequence.hs +++ b/Data/TASequence.hs @@ -104,7 +104,29 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where -- > TAEmptyL -> tempty -- > h :< t -> f h <| tmap f t tmap :: (forall x y. c x y -> d x y) -> s c x y -> s d x y - + + -- | Apply a function to all elements in a type aligned sequence, and combine them using a 'Category' instance. + -- + -- Default definition: + -- + -- > tfoldMap f q = case tviewl q of + -- > TAEmptyL -> id + -- > h :< t -> f h >>> tfoldMap f t + tfoldMap :: Category d => (forall x y. c x y -> d x y) -> s c x y -> d x y + + -- | Combine all elements in a type aligned sequence using a 'Category' instance. + -- + -- Default definition: + -- + -- > tfold = tfoldMap id + tfold :: Category c => s c x y -> c x y + + -- | Right-associative fold of a type aligned sequence. + tfoldr :: (forall x y z . c x y -> d y z -> d x z) -> d q r -> s c p q -> d p r + + -- | Left-associative fold of a type aligned sequence. + tfoldl :: (forall x y z . d x y -> c y z -> d x z) -> d p q -> s c q r -> d p r + l |> r = l >< tsingleton r l <| r = tsingleton l >< r l >< r = case tviewl l of @@ -127,6 +149,15 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where TAEmptyL -> tempty h :< t -> f h <| tmap f t + tfoldMap f q = case tviewl q of + TAEmptyL -> id + h :< t -> f h >>> tfoldMap f t + + tfold = tfoldMap id + + tfoldr f z t = appEndoR (tfoldMap (\ x -> EndoR (\ y -> f x y)) t) z + + tfoldl f z t = appEndoL (tfoldMap (\ x -> EndoL (\ y -> f y x)) t) z data TAViewL s c x y where TAEmptyL :: TAViewL s c x x @@ -135,3 +166,17 @@ data TAViewL s c x y where data TAViewR s c x y where TAEmptyR :: TAViewR s c x x (:>) :: s c x y -> c y z -> TAViewR s c x z + + +-- Approach adapted from Joachim Breitner: https://stackoverflow.com/a/30986119/88018 +newtype EndoR h c d = EndoR { appEndoR :: forall b. h d b -> h c b } + +instance Category (EndoR h) where + id = EndoR id + EndoR f1 . EndoR f2 = EndoR (f2 . f1) + +newtype EndoL h c d = EndoL { appEndoL :: forall b . h b c -> h b d } + +instance Category (EndoL h) where + id = EndoL id + EndoL f1 . EndoL f2 = EndoL (f1 . f2) diff --git a/Data/TASequence/BinaryTree.hs b/Data/TASequence/BinaryTree.hs index 8995dde..15d31e9 100644 --- a/Data/TASequence/BinaryTree.hs +++ b/Data/TASequence/BinaryTree.hs @@ -19,6 +19,7 @@ module Data.TASequence.BinaryTree(module Data.TASequence, BinaryTree) where import Control.Category import Data.TASequence +import Prelude hiding (id) data BinaryTree c x y where Empty :: BinaryTree c x x @@ -39,6 +40,10 @@ instance TASequence BinaryTree where tmap phi (Leaf c) = Leaf (phi c) tmap phi (Node b b') = Node (tmap phi b) (tmap phi b') + tfoldMap phi Empty = id + tfoldMap phi (Leaf c) = phi c + tfoldMap phi (Node a b) = tfoldMap phi a >>> tfoldMap phi b + instance Category (BinaryTree c) where id = tempty (.) = flip (><) diff --git a/Data/TASequence/FingerTree.hs b/Data/TASequence/FingerTree.hs index 1e14a2e..52a70ef 100644 --- a/Data/TASequence/FingerTree.hs +++ b/Data/TASequence/FingerTree.hs @@ -24,6 +24,7 @@ module Data.TASequence.FingerTree (module Data.TASequence, FingerTree ) where import Control.Category import Data.TASequence +import Prelude hiding (id) data FingerTree r a b where @@ -71,6 +72,10 @@ instance TASequence FingerTree where tmap f (Single a) = Single (f a) tmap f (Deep l m r) = Deep (mapd f l) (tmap (mapn f) m) (mapd f r) + tfoldMap f Empty = id + tfoldMap f (Single a) = f a + tfoldMap f (Deep l m r) = foldMapd f l >>> tfoldMap (foldMapn f) m >>> foldMapd f r + instance Category (FingerTree c) where id = tempty (.) = flip (><) @@ -194,11 +199,19 @@ nodes (a ::: b ::: c ::: xs) = Node3 a b c ::: nodes xs mapn :: (forall x y. c x y -> d x y) -> Node c x y -> Node d x y mapn phi (Node2 r s) = Node2 (phi r) (phi s) mapn phi (Node3 r s t) = Node3 (phi r) (phi s) (phi t) - + +foldMapn :: Category d => (forall x y. c x y -> d x y) -> Node c x y -> d x y +foldMapn phi (Node2 r s) = phi r >>> phi s +foldMapn phi (Node3 r s t) = phi r >>> phi s >>> phi t + mapd :: (forall x y. c x y -> d x y) -> Digit c x y -> Digit d x y mapd phi (One r) = One (phi r) mapd phi (Two r s) = Two (phi r) (phi s) mapd phi (Three r s t) = Three (phi r) (phi s) (phi t) mapd phi (Four r s t u) = Four (phi r) (phi s) (phi t) (phi u) - +foldMapd :: Category d => (forall x y. c x y -> d x y) -> Digit c x y -> d x y +foldMapd phi (One r) = phi r +foldMapd phi (Two r s) = phi r >>> phi s +foldMapd phi (Three r s t) = phi r >>> phi s >>> phi t +foldMapd phi (Four r s t u) = phi r >>> phi s >>> phi t >>> phi u diff --git a/Data/TASequence/Queue.hs b/Data/TASequence/Queue.hs index b7f66bd..af8ee13 100644 --- a/Data/TASequence/Queue.hs +++ b/Data/TASequence/Queue.hs @@ -23,6 +23,7 @@ module Data.TASequence.Queue(module Data.TASequence,Queue) where import Control.Category import Data.TASequence +import Prelude hiding (id) data P c a b where (:*) :: c a w -> c w b -> P c a b @@ -60,13 +61,24 @@ instance TASequence Queue where tmap f (Q1 x) = Q1 (f x) tmap f (QN l m r) = QN (tmapb f l) (tmap (tmapp f) m) (tmapb f r) + tfoldMap f Q0 = id + tfoldMap f (Q1 x) = f x + tfoldMap f (QN l m r) = tfoldMapb f l >>> tfoldMap (tfoldMapp f) m >>> tfoldMapb f r + instance Category (Queue c) where id = tempty (.) = flip (><) tmapp :: (forall x y. c x y -> d x y) -> P c x y -> P d x y tmapp phi (a :* b) = phi a :* phi b - + +tfoldMapp :: Category d => (forall x y. c x y -> d x y) -> P c x y -> d x y +tfoldMapp phi (a :* b) = phi a >>> phi b + tmapb :: (forall x y. c x y -> d x y) -> B c x y -> B d x y tmapb phi (B1 c) = B1 (phi c) tmapb phi (B2 p) = B2 (tmapp phi p) + +tfoldMapb :: Category d => (forall x y. c x y -> d x y) -> B c x y -> d x y +tfoldMapb phi (B1 c) = phi c +tfoldMapb phi (B2 p) = tfoldMapp phi p diff --git a/Data/TASequence/SnocList.hs b/Data/TASequence/SnocList.hs index 1e9b118..702783a 100644 --- a/Data/TASequence/SnocList.hs +++ b/Data/TASequence/SnocList.hs @@ -18,6 +18,7 @@ module Data.TASequence.SnocList(module Data.TASequence,SnocList(..)) where import Control.Category import Data.TASequence +import Prelude hiding (id) data SnocList c x y where SNil :: SnocList c x x @@ -32,6 +33,9 @@ instance TASequence SnocList where tmap phi SNil = SNil tmap phi (Snoc s c) = Snoc (tmap phi s) (phi c) + tfoldMap phi SNil = id + tfoldMap phi (Snoc s c) = tfoldMap phi s >>> phi c + instance Category (SnocList c) where id = tempty (.) = flip (><) diff --git a/Data/TASequence/ToCatQueue.hs b/Data/TASequence/ToCatQueue.hs index 76f1c01..6ef1028 100644 --- a/Data/TASequence/ToCatQueue.hs +++ b/Data/TASequence/ToCatQueue.hs @@ -24,6 +24,7 @@ module Data.TASequence.ToCatQueue(module Data.TASequence,ToCatQueue) where import Control.Category import Data.TASequence +import Prelude hiding (id) -- | The catenable queue type. The first type argument is the -- type of the queue we use (|>) @@ -51,6 +52,9 @@ instance TASequence q => TASequence (ToCatQueue q) where tmap phi C0 = C0 tmap phi (CN c q) = CN (phi c) (tmap (tmap phi) q) + tfoldMap phi C0 = id + tfoldMap phi (CN c q) = phi c >>> tfoldMap (tfoldMap phi) q + instance TASequence q => Category (ToCatQueue q c) where id = tempty (.) = flip (><)