In Haskell if I want to repeatedly apply an endomorphism a -> a to a value of type a I can just use iterate.
What about a function that is not an endomorphisms, but generic enough to work correctly on its return type?
Consider for example Just :: a -> Maybe a; I can write
Just . Just . Just ...
as many times as I want. Is there a way to write this shortly with something like
iterate' 3 Just :: a -> Maybe (Maybe (Maybe a))
or do we need something like dependent types to do this?
It is possible with a minor tweak to the syntax you proposed: iterate' #3 Just instead of iterate' 3 Just.
This is because the result type depends on the number, so the number has to be a type literal, not a value literal. As you correctly note, doing this with arbitrary numbers would require dependent types[1], which Haskell doesn't have.
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE TypeFamilies, KindSignatures, DataKinds,
FlexibleInstances, UndecidableInstances, ScopedTypeVariables,
FunctionalDependencies, TypeApplications, RankNTypes, FlexibleContexts,
AllowAmbiguousTypes #-}
import qualified GHC.TypeLits as Lit
-- from type-natural
import Data.Type.Natural
import Data.Type.Natural.Builtin
class Iterate (n :: Nat) (f :: * -> *) (a :: *) (r :: *)
| n f a -> r
where
iterate_peano :: Sing n -> (forall b . b -> f b) -> a -> r
instance Iterate 'Z f a a where
iterate_peano SZ _ = id
instance Iterate n f (f a) r => Iterate ('S n) f a r where
iterate_peano (SS n) f x = iterate_peano n f (f x)
iterate'
:: forall (n :: Lit.Nat) f a r .
(Iterate (ToPeano n) f a r, SingI n)
=> (forall b . b -> f b) -> a -> r
iterate' f a = iterate_peano (sToPeano (sing :: Sing n)) f a
If you load this in ghci, you can say
*Main> :t iterate' #3 Just
iterate' #3 Just :: a -> Maybe (Maybe (Maybe a))
*Main> iterate' #3 Just True
Just (Just (Just True))
This code uses two different type-level naturals: the built-in Nat from GHC.TypeLits and the classic Peano numerals from Data.Type.Natural. The former are needed to provide the nice iterate' #3 syntax, the latter are needed to perform the recursion (which happens in the Iterate class). I used Data.Type.Natural.Builtin to convert from a literal to the corresponding Peano numeral.
[1] However, given a specific way to consume the iterated values (e.g. if you know in advance that you'll only want to show them), you probably could adapt this code to work even for dynamic values of n. There's nothing in the type of iterate' that requires a statically known Nat; the only challenge is to prove that the result of the iteration satisfies the constraints you need.
You can do it with template haskell, if you know the number at compile time (but unless the number is pretty large I don't think it's worth the hassle). If you don't know the number yet at compile time, you need to correctly model the return type, which we can do using a non-regular type:
data Iter f a = Iter0 a | IterS (Iter f (f a))
iterate' :: Int -> (forall x. x -> f x) -> a -> Iter f a
iterate' 0 f x = Iter0 x
iterate' n f x = IterS (iterate' (n-1) f (f x))
Iter is essentially a way of expressing the data type a | f a | f (f a) | f (f (f a)) | .... To use the result you need to recurse on Iter. Also the function has to be of the form a -> f a for some type constructor f, so you may need to do some newtype wrapping to get there. So... it's kind of a pain either way.
You can do this without Template Haskell or type-level Nats. The kind of variable-depth recursive type you are building actually fits perfectly into the model of a free monad. We can use the unfold function from the free package to build up a Free structure and short-circuit when our counter reaches 0.
-- This extension is enabled so we can have nice type annotations
{-# Language ScopedTypeVariables #-}
import Control.Monad.Free (Free)
import qualified Control.Monad.Free as Free
iterate' :: forall f a. Functor f => Int -> (a -> f a) -> a -> Free f a
iterate' counter0 f x0 = Free.unfold run (counter0, x0)
where
-- If counter is 0, short circuit with current result
-- Otherwise, continue computation with modified counter
run :: (Int, a) -> Either a (f (Int, a))
run (0 , x) = Left x
run (counter, x) = Right (countDown counter <$> f x)
countDown :: Int -> a -> (Int, a)
countDown counter x = (counter - 1, x)
Now, it's easy to create and digest these types of values for any Functor.
> iterate' 3 Just True
Free (Just (Free (Just (Free (Just (Pure True))))))
> let f i = if i == 1 then Left "abort" else Right (i+1)
> iterate' 0 f 0
Pure 0
> iterate' 1 f 0
Free (Right (Pure 1))
> iterate' 2 f 0
Free (Right (Free (Left "abort")))
If your Functor also happens to be a Monad, you can use retract to collapse the recursive structure.
> Free.retract (iterate' 3 Just True)
Just True
> Free.retract (iterate' 0 f 0)
Right 0
> Free.retract (iterate' 1 f 0)
Right 1
> Free.retract (iterate' 2 f 0)
Left "abort"
I suggest reading the docs for Control.Monad.Free so you can get an idea for how these structures are created/consumed.
(Just as an aside, a -> Maybe a is an endomorphism, but it's an endomorphism in the Kleisli category of Maybe.)
Related
Shouldn’t this definition be allowed in a lazy language like Haskell in which functions are curried?
apply f [] = f
apply f (x:xs) = apply (f x) xs
It’s basically a function that applies the given function to the given list of arguments and is very easily done in Lisp for example.
Are there any workarounds?
It is hard to give a static type to the apply function, since its type depends on the type of the (possibly heterogeneous) list argument. There are at least two ways one way to write this function in Haskell that I can think of:
Using reflection
We can defer type checking of the application until runtime:
import Data.Dynamic
import Data.Typeable
apply :: Dynamic -> [Dynamic] -> Dynamic
apply f [] = f
apply f (x:xs) = apply (f `dynApp` x) xs
Note that now the Haskell program may fail with a type error at runtime.
Via type class recursion
Using the semi-standard Text.Printf trick (invented by augustss, IIRC), a solution can be coded up in this style (exercise). It may not be very useful though, and still requires some trick to hide the types in the list.
Edit: I couldn't come up with a way to write this, without using dynamic types or hlists/existentials. Would love to see an example
I like Sjoerd Visscher's reply, but the extensions -- especially IncoherentInstances, used in this case to make partial application possible -- might be a bit daunting. Here's a solution that doesn't require any extensions.
First, we define a datatype of functions that know what to do with any number of arguments. You should read a here as being the "argument type", and b as being the "return type".
data ListF a b = Cons b (ListF a (a -> b))
Then we can write some (Haskell) functions that munge these (variadic) functions. I use the F suffix for any functions that happen to be in the Prelude.
headF :: ListF a b -> b
headF (Cons b _) = b
mapF :: (b -> c) -> ListF a b -> ListF a c
mapF f (Cons v fs) = Cons (f v) (mapF (f.) fs)
partialApply :: ListF a b -> [a] -> ListF a b
partialApply fs [] = fs
partialApply (Cons f fs) (x:xs) = partialApply (mapF ($x) fs) xs
apply :: ListF a b -> [a] -> b
apply f xs = headF (partialApply f xs)
For example, the sum function could be thought of as a variadic function:
sumF :: Num a => ListF a a
sumF = Cons 0 (mapF (+) sumF)
sumExample = apply sumF [3, 4, 5]
However, we also want to be able to deal with normal functions, which don't necessarily know what to do with any number of arguments. So, what to do? Well, like Lisp, we can throw an exception at runtime. Below, we'll use f as a simple example of a non-variadic function.
f True True True = 32
f True True False = 67
f _ _ _ = 9
tooMany = error "too many arguments"
tooFew = error "too few arguments"
lift0 v = Cons v tooMany
lift1 f = Cons tooFew (lift0 f)
lift2 f = Cons tooFew (lift1 f)
lift3 f = Cons tooFew (lift2 f)
fF1 = lift3 f
fExample1 = apply fF1 [True, True, True]
fExample2 = apply fF1 [True, False]
fExample3 = apply (partialApply fF1 [True, False]) [False]
Of course, if you don't like the boilerplate of defining lift0, lift1, lift2, lift3, etc. separately, then you need to enable some extensions. But you can get quite far without them!
Here is how you can generalize to a single lift function. First, we define some standard type-level numbers:
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeFamilies, UndecidableInstances #-}
data Z = Z
newtype S n = S n
Then introduce the typeclass for lifting. You should read the type I n a b as "n copies of a as arguments, then a return type of b".
class Lift n a b where
type I n a b :: *
lift :: n -> I n a b -> ListF a b
instance Lift Z a b where
type I Z a b = b
lift _ b = Cons b tooMany
instance (Lift n a (a -> b), I n a (a -> b) ~ (a -> I n a b)) => Lift (S n) a b where
type I (S n) a b = a -> I n a b
lift (S n) f = Cons tooFew (lift n f)
And here's the examples using f from before, rewritten using the generalized lift:
fF2 = lift (S (S (S Z))) f
fExample4 = apply fF2 [True, True, True]
fExample5 = apply fF2 [True, False]
fExample6 = apply (partialApply fF2 [True, False]) [False]
No, it cannot. f and f x are different types. Due to the statically typed nature of haskell, it can't take any function. It has to take a specific type of function.
Suppose f is passed in with type a -> b -> c. Then f x has type b -> c. But a -> b -> c must have the same type as a -> b. Hence a function of type a -> (b -> c) must be a function of type a -> b. So b must be the same as b -> c, which is an infinite type b -> b -> b -> ... -> c. It cannot exist. (continue to substitute b -> c for b)
Here's one way to do it in GHC. You'll need some type annotations here and there to convince GHC that it's all going to work out.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE IncoherentInstances #-}
class Apply f a r | f -> a r where
apply :: f -> [a] -> r
instance Apply f a r => Apply (a -> f) a r where
apply f (a:as) = apply (f a) as
instance Apply r a r where
apply r _ = r
test = apply ((+) :: Int -> Int -> Int) [1::Int,2]
apply' :: (a -> a -> a) -> [a] -> a
apply' = apply
test' = apply' (+) [1,2]
This code is a good illustration of the differences between static and dynamic type-checking. With static type-checking, the compiler can't be sure that apply f really is being passed arguments that f expects, so it rejects the program. In lisp, the checking is done at runtime and the program might fail then.
I am not sure how much this would be helpful as I am writing this in F# but I think this can be easily done in Haskell too:
type 'a RecFunction = RecFunction of ('a -> 'a RecFunction)
let rec apply (f: 'a RecFunction) (lst: 'a list) =
match (lst,f) with
| ([],_) -> f
| ((x::xs), RecFunction z) -> apply (z x) xs
In this case the "f" in question is defined using a discriminated union which allows recursive data type definition. This can be used to solved the mentioned problem I guess.
With the help and input of some others I defined a way to achieve this (well, sort of, with a custom list type) which is a bit different from the previous answers. This is an old question, but it seems to still be visited so I will add the approach for completeness.
We use one extension (GADTs), with a list type a bit similar to Daniel Wagner's, but with a tagging function type rather than a Peano number. Let's go through the code in pieces. First we set the extension and define the list type. The datatype is polymorphic so in this formulation arguments don't have to have the same type.
{-# LANGUAGE GADTs #-}
-- n represents function type, o represents output type
data LApp n o where
-- no arguments applied (function and output type are the same)
End :: LApp o o
-- intentional similarity to ($)
(:$) :: a -> LApp m o -> LApp (a -> m) o
infixr 5 :$ -- same as :
Let's define a function that can take a list like this and apply it to a function. There is some type trickery here: the function has type n, a call to listApply will only compile if this type matches the n tag on our list type. By leaving our output type o unspecified, we leave some freedom in this (when creating the list we don't have to immediately entirely fix the kind of function it can be applied to).
-- the apply function
listApply :: n -> LApp n o -> o
listApply fun End = fun
listApply fun (p :$ l) = listApply (fun p) l
That's it! We can now apply functions to arguments stored in our list type. Expected more? :)
-- showing off the power of AppL
main = do print . listApply reverse $ "yrruC .B lleksaH" :$ End
print . listApply (*) $ 1/2 :$ pi :$ End
print . listApply ($) $ head :$ [1..] :$ End
print $ listApply True End
Unfortunately we are kind of locked in to our list type, we can't just convert normal lists to use them with listApply. I suspect this is a fundamental issue with the type checker (types end up depending on the value of a list) but to be honest I'm not entirely sure.
-- Can't do this :(
-- listApply (**) $ foldr (:$) End [2, 32]
If you feel uncomfortable about using a heterogeneous list, all you have to do is add an extra parameter to the LApp type, e.g:
-- Alternative definition
-- data FList n o a where
-- Nil :: FList o o a
-- Cons :: a -> FList f o a -> FList (a -> f) o a
Here a represents the argument type, where the function which is applied to will also have to accept arguments of all the same type.
This isn't precisely an answer to your original question, but I think it might be an answer to your use-case.
pure f <*> [arg] <*> [arg2] ...
-- example
λ>pure (\a b c -> (a*b)+c) <*> [2,4] <*> [3] <*> [1]
[7,13]
λ>pure (+) <*> [1] <*> [2]
[3]
The applicative instance of list is a lot broader than this super narrow use-case though...
λ>pure (+1) <*> [1..10]
[2,3,4,5,6,7,8,9,10,11]
-- Or, apply (+1) to items 1 through 10 and collect the results in a list
λ>pure (+) <*> [1..5] <*> [1..5]
[2,3,4,5,6,3,4,5,6,7,4,5,6,7,8,5,6,7,8,9,6,7,8,9,10]
{- The applicative instance of list gives you every possible combination of
elements from the lists provided, so that is every possible sum of pairs
between one and five -}
λ>pure (\a b c -> (a*b)+c) <*> [2,4] <*> [4,3] <*> [1]
[9,7,17,13]
{- that's - 2*4+1, 2*3+1, 4*4+1, 4*3+1
Or, I am repeating argC when I call this function twice, but a and b are
different -}
λ>pure (\a b c -> show (a*b) ++ c) <*> [1,2] <*> [3,4] <*> [" look mah, other types"]
["3 look mah, other types","4 look mah, other types","6 look mah, other types","8 look mah, other types"]
So it's not the same concept, precisely, but it a lot of those compositional use-cases, and adds a few more.
Is there a name for a recursion scheme that's like a catamorphism, but that allows peeking at the final result while it's still running? Here's a slighly contrived example:
toPercents :: Floating a => [a] -> [a]
toPercents xs = result
where
(total, result) = foldr go (0, []) xs
go x ~(t, r) = (x + t, 100*x/total:r)
{-
>>> toPercents [1,2,3]
[16.666666666666668,33.333333333333336,50.0]
-}
This example uses total at each step of the fold, even though its value isn't known until the end. (Obviously, this relies on laziness to work.)
Though this is not necessarily what you were looking for, we can encode the laziness trick with a hylomorphism:
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
import Data.Functor.Foldable
import Data.Functor.Foldable.TH
data CappedList c a = Cap c | CCons a (CappedList c a)
deriving (Eq, Show, Ord, Functor, Foldable, Traversable)
makeBaseFunctor ''CappedList
-- The seq here has no counterpart in the implementation in the question.
-- It improves performance quite noticeably. Other seqs might be added for
-- some of the other "s", as well as for the percentage; the returns, however,
-- are diminishing.
toPercents :: Floating a => [a] -> [a]
toPercents = snd . hylo percAlg sumCal . (0,)
where
sumCal = \case
(s, []) -> CapF s
(s, a : as) -> s `seq` CConsF a (s + a, as)
percAlg = \case
CapF s -> (s, [])
CConsF a (s, as) -> (s, (a * 100 / s) : as)
This corresponds to the laziness trick because, thanks to hylo fusion, the intermediate CappedList never actually gets built, and toPercents consumes the input list in a single pass. The point of using CappedList is, as moonGoose puts it, placing the sum at the bottom of the (virtual) intermediate structure, so that the list rebuilding being done with percAlg can have access to it from the start.
(It is perhaps worth noting that, even though it is done in a single pass, it seems difficult to get nice-and-constant memory usage from this trick, be it with my version or with yours. Suggestions on this front are welcome.)
I don't think there's explicitly a scheme for allowing function 1 to peek at each step at the end result of function 2. It seems like a somewhat odd one to want though. I think that in the end, it's going to boil down to either 1) running function 2, then running function 1 with the known result of function 2 (ie. two passes, which I think is the only way to get constant memory in your example) or 2) running them side-by-side, creating a function thunk (or relying on laziness) to combine them at the end.
The lazy foldr version you gave of course translates naturally into a catamorphism. Here's the functionalized catamorphism version,
{-# LANGUAGE LambdaCase #-}
import Data.Functor.Foldable
toPercents :: Floating a => [a] -> [a]
toPercents = uncurry ($) . cata alg
where
alg = \case
Nil -> (const [], 0)
Cons x (f,s) -> (\t -> 100*x / t : f t, s + x)
It doesn't seem nice stylistically to have to hand-parallelize the two catamorphisms though, particularly as then it doesn't encode the fact that neither stepwise-relies on the other. Hoogle finds bicotraverse, but it's unnecessarily general, so let's write our algebra-parallelization operator (&&&&),
import Control.Arrow
(&&&&) :: Functor f => (f a -> c) -> (f b -> d) -> f (a,b) -> (c,d)
f1 &&&& f2 = (f1 . fmap fst &&& f2 . fmap snd)
toPercents' :: Floating a => [a] -> [a]
toPercents' = uncurry ($) . cata (algList &&&& algSum)
algSum :: (Num a) => ListF a a -> a
algSum = \case
Nil -> fromInteger 0
Cons x !s -> s + x
algList :: (Fractional a) => ListF a (a -> [a]) -> (a -> [a])
algList = \case
Nil -> const []
Cons x s -> (\t -> 100*x / t : s t)
Just crazy experiment. I think we can fuse smth.
Also fix = hylo (\(Cons f a) -> f a) (join Cons) and we can replace on fix
toPercents :: Floating a => [a] -> [a]
toPercents xs = result
where
(_, result) = hylo (\(Cons f a) -> f a) (join Cons) $ \(~(total, _)) ->
let
alg Nil = (0, [])
alg (Cons x (a, as)) = (x + a, 100 * x / total: as)
in
cata alg xs
I'm trying to parse dates such as 09/10/2015 17:20:52:
{-# LANGUAGE FlexibleContexts #-}
import Text.Parsec
import Text.Parsec.String
import Text.Read
import Control.Applicative hiding (many, (<|>))
data Day = Day
{ mo :: Int
, dy :: Int
, yr :: Int
} deriving (Show)
data Time = Time
{ hr :: Int
, min :: Int
, sec :: Int
} deriving (Show)
day = listUncurry Day <$> (sepCount 3 (char '/') $ read <$> many digit)
time = listUncurry Time <$> (sepCount 3 (char ':') $ dign 2 )
dign :: (Stream s m Char, Read b) => Int -> ParsecT s u m b
dign = (read <$>) . flip count digit
-- how generalize to n?
listUncurry h [x1,x2,x3] = h x1 x2 x3
sepCount n sep p = (:) <$> p <*> (count (n-1) $ sep *> p)
I have a hunch that some kind of zipWithN would generalize listUncurry. Maybe some kind of foldl ($)?
As a side question (out of curiosity), can parsec parsers be used generatively?
Actually, you only need Functor:
listUncurry :: Functor f => (a -> a -> a -> r) -> f [a] -> f r
listUncurry h p =
(\[x, y, z] -> h x y z) <$> p
To me, a hint that only Functor is necessary is when you have a code pattern like:
do x <- m
return (f ...)
This is equivalent to
m >>= (\x -> return (f ...))
which is the same as
fmap (\x -> f ...) m
This is because the monad laws imply this identity:
fmap f xs = xs >>= return . f
Polyvariadic listUncurry
I don't really recommend this in most circumstances since it turns what would be compile time errors into runtime errors, but this is how you could implement a polyvariadic listUncurry:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
class ListUncurry a x r where
listUncurry :: a -> [x] -> r
instance ListUncurry k a r => ListUncurry (a -> k) a r where
listUncurry f (x:xs) = listUncurry (f x) xs
listUncurry _ _ = error "listUncurry: Too few arguments given"
instance ListUncurry r a r where
listUncurry r [] = r
listUncurry _ _ = error "listUncurry: Too many arguments given"
You will need a lot of explicit type annotations if you use it too. There is probably a way to use a type family or functional dependency to help with that, but I can't think of it off the top of my head at the moment. Since that is probably solvable (to an extent at least), in my mind the bigger problem is the type errors being changed from compile time errors to runtime errors.
Sample usage:
ghci> listUncurry ord ['a'] :: Int
97
ghci> listUncurry ((==) :: Int -> Int -> Bool) [1,5::Int] :: Bool
False
ghci> listUncurry ((==) :: Char -> Char -> Bool) ['a'] :: Bool
*** Exception: listUncurry: Too few arguments given
ghci> listUncurry ((==) :: Char -> Char -> Bool) ['a','b','c'] :: Bool
*** Exception: listUncurry: Too many arguments given
A safer listUncurry
If you change the class to
class ListUncurry a x r where
listUncurry :: a -> [x] -> Maybe r
and change the error cases in the instances appropriately, you will at least get a better interface to handling the errors. You could also replace the Maybe with a type that differentiates between the "too many" and "too few" argument errors if you wanted to retain that information.
I feel that this would be a bit better of an approach, although you will need to add a bit more error handling (Maybe's Functor, Applicative and Monad interfaces will make this fairly nice though).
Comparing the two approaches
It ultimately depends on what sort of error this would represent. If the program execution can no longer continue in any meaningful way if it runs into such an error, then the first approach (or something like it) might be more appropriate than the second. If there is any way to recover from the error, the second approach would be better than the first.
Whether or not a polyvariadic technique should be used in the first place is a different question. It might be better to restructure the program to avoid the additional complexity of the polyvariadic stuff.
also i'm sure i shouldn't be snocing a list -- what's the right way to do this?
The following implementation of sepCount is more efficient:
-- | #sepCount n sep p# applies #n# (>=1) occurrences of #p#,
-- separated by #sep#. Returns a list of the values returned by #p#.
sepCount n sep p = p <:> count (n - 1) (sep *> p)
where (<:>) = liftA2 (:)
I'm generalizing this n-ary complement to an n-ary compose, but I'm having trouble making the interface nice. Namely, I can't figure out how to use numeric literals at the type level while still being able to pattern match on successors.
Rolling my own nats
Using roll-my-own nats, I can make n-ary compose work, but I can only pass n as an iterated successor, not as a literal:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module RollMyOwnNats where
import Data.List (genericIndex)
-- import Data.Proxy
data Proxy (n::Nat) = Proxy
----------------------------------------------------------------
-- Stuff that works.
data Nat = Z | S Nat
class Compose (n::Nat) b b' t t' where
compose :: Proxy n -> (b -> b') -> t -> t'
instance Compose Z b b' b b' where
compose _ f x = f x
instance Compose n b b' t t' => Compose (S n) b b' (a -> t) (a -> t') where
compose _ g f x = compose (Proxy::Proxy n) g (f x)
-- Complement a binary relation.
compBinRel :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (Proxy::Proxy (S (S Z))) not
----------------------------------------------------------------
-- Stuff that does not work.
instance Num Nat where
fromInteger n = iterate S Z `genericIndex` n
-- I now have 'Nat' literals:
myTwo :: Nat
myTwo = 2
-- But GHC thinks my type-level nat literal is a 'GHC.TypeLits.Nat',
-- even when I say otherwise:
compBinRel' :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel' = compose (Proxy::Proxy (2::Nat)) not
{-
Kind mis-match
An enclosing kind signature specified kind `Nat',
but `2' has kind `GHC.TypeLits.Nat'
In an expression type signature: Proxy (2 :: Nat)
In the first argument of `compose', namely
`(Proxy :: Proxy (2 :: Nat))'
In the expression: compose (Proxy :: Proxy (2 :: Nat)) not
-}
Using GHC.TypeLits.Nat
Using GHC.TypeLits.Nat, I get type-level nat literals, but there is no successor constructor that I can find, and using the type function (1 +) doesn't work, because GHC (7.6.3) can't reason about injectivity of type functions:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module UseGHCTypeLitsNats where
import GHC.TypeLits
-- import Data.Proxy
data Proxy (t::Nat) = Proxy
----------------------------------------------------------------
-- Stuff that works.
class Compose (n::Nat) b b' t t' where
compose :: Proxy n -> (b -> b') -> t -> t'
instance Compose 0 b b' b b' where
compose _ f x = f x
instance (Compose n b b' t t' , sn ~ (1 + n)) => Compose sn b b' (a -> t) (a -> t') where
compose _ g f x = compose (Proxy::Proxy n) g (f x)
----------------------------------------------------------------
-- Stuff that does not work.
-- Complement a binary relation.
compBinRel , compBinRel' :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (Proxy::Proxy 2) not
{-
Couldn't match type `1 + (1 + n)' with `2'
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
In the expression: compose (Proxy :: Proxy 2) not
In an equation for `compBinRel':
compBinRel = compose (Proxy :: Proxy 2) not
-}
{-
No instance for (Compose n Bool Bool Bool Bool)
arising from a use of `compose'
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Note: there is a potential instance available:
instance Compose 0 b b' b b'
-}
compBinRel' = compose (Proxy::Proxy (1+(1+0))) not
{-
Couldn't match type `1 + (1 + 0)' with `1 + (1 + n)'
NB: `+' is a type function, and may not be injective
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Expected type: Proxy (1 + (1 + 0))
Actual type: Proxy (1 + (1 + n))
In the first argument of `compose', namely
`(Proxy :: Proxy (1 + (1 + 0)))'
-}
I agree that semantic editor combinators are more elegant and more general here -- and concretely, it will always be easy enough to write (.) . (.) . ... (n times) instead of compose (Proxy::Proxy n) -- but I'm frustrated that I can't make the n-ary composition work as well as I expected. Also, it seems I would run into similar problems for other uses of GHC.TypeLits.Nat, e.g. when trying to define a type function:
type family T (n::Nat) :: *
type instance T 0 = ...
type instance T (S n) = ...
UPDATE: Summary and adaptation of the accepted answer
There's a lot of interesting stuff going on in the accepted answer,
but the key for me is the Template Haskell trick in the GHC 7.6
solution: that effectively lets me add type-level literals to my GHC
7.6.3 version, which already had injective successors.
Using my types above, I define literals via TH:
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
module RollMyOwnLiterals where
import Language.Haskell.TH
data Nat = Z | S Nat
nat :: Integer -> Q Type
nat 0 = [t| Z |]
nat n = [t| S $(nat (n-1)) |]
where I've moved my Nat declaration into the new module to avoid an
import loop. I then modify my RollMyOwnNats module:
+import RollMyOwnLiterals
...
-data Nat = Z | S Nat
...
+compBinRel'' :: (a -> a -> Bool) -> (a -> a -> Bool)
+compBinRel'' = compose (Proxy::Proxy $(nat 2)) not
Unfortunately your question cannot be answered in principle in the currently released version of GHC (GHC 7.6.3) because of a consistency problem pointed out in the recent message
http://www.haskell.org/pipermail/haskell-cafe/2013-December/111942.html
Although type-level numerals look like numbers they are not guaranteed to behave like numbers at all (and they don't). I have seen Iavor Diatchki and colleagues have implemented proper type level arithmetic in GHC (which as as sound as the SMT solver used as a back end -- that is, we can trust it). Until that version is released, it is best to avoid type level numeric literals, however cute they may seem.
EDIT: Rewrote answer. It was getting a little bulky (and a little buggy).
GHC 7.6
Since type level Nats are somewhat... incomplete (?) in GHC 7.6, the least verbose way of achieving what you want is a combination of GADTs and type families.
{-# LANGUAGE GADTs, TypeFamilies #-}
module Nats where
-- Type level nats
data Zero
data Succ n
-- Value level nats
data N n f g where
Z :: N Zero (a -> b) a
S :: N n f g -> N (Succ n) f (a -> g)
type family Compose n f g
type instance Compose Zero (a -> b) a = b
type instance Compose (Succ n) f (a -> g) = a -> Compose n f g
compose :: N n f g -> f -> g -> Compose n f g
compose Z f x = f x
compose (S n) f g = compose n f . g
The advantage of this particular implementation is that it doesn't use type classes, so applications of compose aren't subject to the monomorphism restriction. For example, compBinRel = compose (S (S Z)) not will type check without type annotations.
We can make this nicer with a little Template Haskell:
{-# LANGUAGE TemplateHaskell #-}
module Nats.TH where
import Language.Haskell.TH
nat :: Integer -> Q Exp
nat 0 = conE 'Z
nat n = appE (conE 'S) (nat (n - 1))
Now we can write compBinRel = compose $(nat 2) not, which is much more pleasant for larger numbers. Some may consider this "cheating", but seeing as we're just implementing a little syntactic sugar, I think it's alright :)
GHC 7.8
The following works on GHC 7.8:
-- A lot more extensions.
{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, PolyKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Nats where
import GHC.TypeLits
data N = Z | S N
data P n = P
type family Index n where
Index 0 = Z
Index n = S (Index (n - 1))
-- Compose is defined using Z/S instead of 0, 1, ... in order to avoid overlapping.
class Compose n f r where
type Return n f r
type Replace n f r
compose' :: P n -> (Return n f r -> r) -> f -> Replace n f r
instance Compose Z a b where
type Return Z a b = a
type Replace Z a b = b
compose' _ f x = f x
instance Compose n f r => Compose (S n) (a -> f) r where
type Return (S n) (a -> f) r = Return n f r
type Replace (S n) (a -> f) r = a -> Replace n f r
compose' x f g = compose' (prev x) f . g
where
prev :: P (S n) -> P n
prev P = P
compose :: Compose (Index n) f r => P n -> (Return (Index n) f r -> r) -> f -> Replace (Index n) f r
compose x = compose' (convert x)
where
convert :: P n -> P (Index n)
convert P = P
-- This does not type check without a signature due to the monomorphism restriction.
compBinRel :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (P::P 2) not
-- This is an example where we compose over higher order functions.
-- Think of it as composing (a -> (b -> c)) and ((b -> c) -> c).
-- This will not typecheck without signatures, despite the fact that it has arguments.
-- However, it will if we use the first solution.
appSnd :: b -> (a -> b -> c) -> a -> c
appSnd x f = compose (P::P 1) ($ x) f
However, this implementation has a few downsides, as annotated in the source.
I attempted (and failed) to use closed type families to infer the composition index automatically. It might have been possible to infer higher order functions like this:
-- Given r and f, where f = x1 -> x2 -> ... -> xN -> r, Infer r f returns N.
type family Infer r f where
Infer r r = Zero
Infer r (a -> f) = Succ (Infer r f)
However, Infer won't work for higher order functions with polymorphic arguments. For example:
ghci> :kind! forall a b. Infer a (b -> a)
forall a b. Infer a (b -> a) :: *
= forall a b. Infer a (b -> a)
GHC can't expand Infer a (b -> a) because it doesn't perform an occurs check when matching closed family instances. GHC won't match the second case of Infer on the off chance that a and b are instantiated such that a unifies with b -> a.
First, I started with some typical type-level natural number stuff.
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
data Nat = Z | S Nat
type family Plus (n :: Nat) (m :: Nat) :: Nat
type instance Plus Z m = m
type instance Plus (S n) m = S (Plus n m)
So I wanted to create a data type representing an n-dimensional grid. (A generalization of what is found at Evaluating cellular automata is comonadic.)
data U (n :: Nat) x where
Point :: x -> U Z x
Dimension :: [U n x] -> U n x -> [U n x] -> U (S n) x
The idea is that the type U num x is the type of a num-dimensional grid of xs, which is "focused" on a particular point in the grid.
So I wanted to make this a comonad, and I noticed that there's this potentially useful function I can make:
ufold :: (x -> U m r) -> U n x -> U (Plus n m) r
ufold f (Point x) = f x
ufold f (Dimension ls mid rs) =
Dimension (map (ufold f) ls) (ufold f mid) (map (ufold f) rs)
We can now implement a "dimension join" that turns an n-dimensional grid of m-dimensional grids into an (n+m)-dimensional grid, in terms of this combinator. This will come in handy when dealing with the result of cojoin which will produce grids of grids.
dimJoin :: U n (U m x) -> U (Plus n m) x
dimJoin = ufold id
So far so good. I also noticed that the Functor instance can be written in terms of ufold.
instance Functor (U n) where
fmap f = ufold (\x -> Point (f x))
However, this results in a type error.
Couldn't match type `n' with `Plus n 'Z'
But if we whip up some copy pasta, then the type error goes away.
instance Functor (U n) where
fmap f (Point x) = Point (f x)
fmap f (Dimension ls mid rs) =
Dimension (map (fmap f) ls) (fmap f mid) (map (fmap f) rs)
Well I hate the taste of copy pasta, so my question is this. How can I tell the type system that Plus n Z is equal to n? And the catch is this: you can't make a change to the type family instances that would cause dimJoin to produce a similar type error.
What you need is a nice propositional equality type:
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
data Nat = Z | S Nat
type family Plus (n :: Nat) (m :: Nat) :: Nat
type instance Plus Z m = m
type instance Plus (S n) m = S (Plus n m)
data (:=) :: k -> k -> * where
Refl :: a := a
data Natural (n :: Nat) where
Zero :: Natural Z
Suc :: Natural n -> Natural (S n)
plusZero :: Natural n -> n := (n `Plus` Z)
plusZero Zero = Refl
plusZero (Suc n) | Refl <- plusZero n = Refl
This allows you to prove arbitrary things about your types and bring that knowledge into scope locally by pattern matching on the Refl.
One annoying thing is that my plusZero proof requires induction over the natural in question, which you won't be able to do by default (since it doesn't exist at runtime). A typeclass for generating Natural witnesses would be easy, though.
Another option for your particular case might be just to invert the arguments to plus in your type definition so that you get the Z on the left and it reduces automagically. It's often a good first step to make sure your types are as simple as you can make them, but then you'll often need propositional equality for more complicated things, regardless.