Instantiation for n-depth structures?
By n-depth structure
I mean some structure that embeds one kind of structure n
once, for example [[a]]
- a list of 2 depths.
I was looking for an instance by accident Functor
, Foldable
and Traversable
for a 3-deep list ( [[[a]]]
) today and found some pattern, as you can see below:
instance Functor [[[]]] where
fmap f n = fmap (fmap (fmap f)) n
instance Foldable [[[]]] where
foldMap f n = foldMap (foldMap (foldMap f)) n
instance Traversable [[[]]] where
sequenceA n =
let fz = \z -> sequenceA z
fy = \y -> sequenceA (fmap fz y)
fx = \x -> sequenceA (fmap fy x)
in fx n
I think this can be automated by types in some way not only for []
, but for any structures that have these instances (for example Vector
), not only 3-depths, but any depths if it is greater than zero.
I think something like data Depth = One | Succ Depth
will be used to calculate the compilation depth, but beyond that I have no idea how it goes. Do you think this is really possible? How do you implement it?
source to share
The other answers are pretty nice in that they represent a single (parameterized) data type that can handle structures of any depth; however, they use advanced system functions to achieve this. On the other hand, there are some pretty simple functions that can be used instead to achieve the same goal and with more flexibility. The basic idea is to define functor composition once and for all:
newtype Compose f g a = Compose { getComposition :: f (g a) }
instance (Functor f, Functor g) => Functor (Compose f g) where
fmap f (Compose v) = Compose (fmap (fmap f) v)
Similarly, you can define instances for Foldable
and Traversable
without extensions. Then you get a single, double and triple attachment, for example
type DepthOneList = []
type DepthTwoList = Compose [] [] -- = Compose [] DepthOneList
type DepthThreeList = Compose [] (Compose [] []) -- = Compose [] DepthTwoList
and they have the necessary operations Functor
, Foldable
and Traversable
. Also, you have a lot of flexibility here; you don't need to have the same functor at every depth, but can have, for example,
type Mixed = Compose [] (Compose Vector [])
no problem. If you really need to, you can happily unwrap sets of level types into this more structured level-level object (although of course this requires similar extensions to those used in other answers):
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
data Nat = Z | S Nat
type family IterCompose (n :: Nat) (f :: * -> *) :: * -> * where
IterCompose Z f = Identity
IterCompose (S n) f = Compose f (IterCompose n f)
But this level-level translation is in most cases less flexible, less useful, and less readable than just writing the written type by hand, so I would consider this part as a "dull" part in a way.
A pre-implemented function composition operation is available in Hackage in the TypeCompose package and, perhaps more canonically, in transformers .
source to share
What you are talking about is essentially the composition of functors (in particular, n-fold self-composition, but that doesn't really matter).
Indeed , such compositions can be made automatically instances of classes Functor
, Applicative
, Foldable
and Traversable
. Alternatively, you can have stacks of monad transformers (which are essentially an alternative approach to performer composition).
To make it n-fold with the same functor, you need a suitable wrapper.
{-# LANGUAGE DataKinds, KindSignatures, GADTs, FlexibleInstances, FlexibleContexts #-}
data Nat = Z | S Nat
data NCompose :: Nat -> (* -> *) -> * -> * where
Singly :: f x -> NCompose (S Z) f x
Multiplie :: NCompose n f (f x) -> NCompose (S n) f x
instance Functor (NCompose Z f) where
fmap _ _ = undefined -- safe, since there no constructor for `NCompose Z f x`
instance (Functor f, Functor (NCompose n f)) => Functor (NCompose (S n) f) where
fmap f (Singly q) = Singly $ fmap f q
fmap f (Multiplie q) = Multiplie $ fmap (fmap f) q
source to share
We can do this with the current GHC support for dependent typing. Qualifying:
{-# LANGUAGE DataKinds, TypeFamilies #-}
import Data.Singletons -- from "singletons" package
import Data.Nat -- from my "singleton-nats" package
From this Data.Nat
we get a natural number type that can be used at the extension type level DataKinds
. We also get its singleton type, which allows us to match patterns at Nat
runtime. We use designers Z
and S
level designers and the type SZ
and SS
level designers term for zero and subsequent designs, respectively.
We define iteration of type-family constructors:
type family Iterate n f x where
Iterate Z f x = x
Iterate (S n) f x = f (Iterate n f x)
For example, it Iterate (S (S Z)) [] Int
boils down to [[Int]]
.
We are not using instances here, as the desired functionality can be achieved by simply writing functions.
fmapN :: Functor f => Sing (S n) -> (a -> b) -> f (Iterate n f a) -> f (Iterate n f b)
fmapN (SS SZ) f = fmap f
fmapN (SS (SS n)) f = fmap (fmapN (SS n) f)
traverseN :: (Applicative f, Traversable t) => Sing (S n) -> (a -> f b) -> t (Iterate n t a) -> f (t (Iterate n t b))
traverseN (SS SZ) f = traverse f
traverseN (SS (SS n)) f = traverse (traverseN (SS n) f)
foldMapN :: (Monoid m, Foldable f) => Sing (S n) -> (a -> m) -> f (Iterate n f a) -> m
foldMapN (SS SZ) f = foldMap f
foldMapN (SS (SS n)) f = foldMap (foldMapN (SS n) f)
Some tests:
> traverseN (sing :: SLit 3) putStrLn [[["foo"]]]
foo
[[[()]]]
> fmapN (sing :: SLit 5) (+10) [[[[[0]]]]]
[[[[[10]]]]]
sing :: SLit n
is an abbreviation for singletons Nat
. sing
comes from Data.Singletons
, and it polymorphically creates singleton values based on the provided type annotations. SLit
is a synonym for the type from Data.Nat
, which uses the literary characters of the GHC.
We could also write out Nat
sugar-free singletons ; for example, SS (SS (SS SZ))
matches sing :: SLit 3
. In general, we can use a shorthand label Lit n
at the type level and sing :: SLit n
at the term level.
source to share