github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-23 14:54:16 +03:00
Code Issues Projects Releases Wiki Activity

📝 Data.Functor.Listable.

Browse Source
This commit is contained in:
Rob Rix 2017-01-10 16:10:07 -05:00
parent 9a0845c72a
commit 34d6c36b0c
1 changed files with 19 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Data/Functor/Listable.hs
View File

@ -28,34 +28,53 @@ import Test.LeanCheck
type Tier a = [a]
-- | Lifting of 'Listable' to @* -> *@.
class Listable1 l where
-- | The tiers for @l :: * -> *@, parameterized by the tiers for @a :: *@.
liftTiers :: [[a]] -> [[l a]]
-- | A suitable definition of 'tiers' for 'Listable1' type constructors parameterized by 'Listable' types.
tiers1 :: (Listable a, Listable1 l) => [[l a]]
tiers1 = liftTiers tiers
-- | Lifting of 'Listable' to @* -> * -> *@.
class Listable2 l where
-- | The tiers for @l :: * -> * -> *@, parameterized by the tiers for @a :: *@ & @b :: *@.
liftTiers2 :: [[a]] -> [[b]] -> [[l a b]]
-- | A suitable definition of 'tiers' for 'Listable2' type constructors parameterized by 'Listable' types.
tiers2 :: (Listable a, Listable b, Listable2 l) => [[l a b]]
tiers2 = liftTiers2 tiers tiers
-- | Lifts a unary constructor to a list of tiers, given a list of tiers for its argument.
--
-- Commonly used in the definition of 'Listable1' and 'Listable2' instances.
liftCons1 :: [[a]] -> (a -> b) -> [[b]]
liftCons1 tiers f = mapT f tiers `addWeight` 1
-- | Lifts a binary constructor to a list of tiers, given lists of tiers for its arguments.
--
-- Commonly used in the definition of 'Listable1' and 'Listable2' instances.
liftCons2 :: [[a]] -> [[b]] -> (a -> b -> c) -> [[c]]
liftCons2 tiers1 tiers2 f = mapT (uncurry f) (productWith (,) tiers1 tiers2) `addWeight` 1
-- | Lifts a ternary constructor to a list of tiers, given lists of tiers for its arguments.
--
-- Commonly used in the definition of 'Listable1' and 'Listable2' instances.
liftCons3 :: [[a]] -> [[b]] -> [[c]] -> (a -> b -> c -> d) -> [[d]]
liftCons3 tiers1 tiers2 tiers3 f = mapT (uncurry3 f) (productWith (\ x (y, z) -> (x, y, z)) tiers1 (liftCons2 tiers2 tiers3 (,)) ) `addWeight` 1
where uncurry3 f (a, b, c) = f a b c
-- | Lifts a quaternary constructor to a list of tiers, given lists of tiers for its arguments.
--
-- Commonly used in the definition of 'Listable1' and 'Listable2' instances.
liftCons4 :: [[a]] -> [[b]] -> [[c]] -> [[d]] -> (a -> b -> c -> d -> e) -> [[e]]
liftCons4 tiers1 tiers2 tiers3 tiers4 f = mapT (uncurry4 f) (productWith (\ x (y, z, w) -> (x, y, z, w)) tiers1 (liftCons3 tiers2 tiers3 tiers4 (,,)) ) `addWeight` 1
where uncurry4 f (a, b, c, d) = f a b c d
-- | Convenient wrapper for 'Listable1' type constructors and 'Listable' types, where a 'Listable' instance would necessarily be orphaned.
newtype ListableF f a = ListableF { unListableF :: f a }
deriving Show