├── README.md └── src ├── Concats.hs ├── FirstJust.hs ├── List.hs ├── Monoids.hs └── Printf.hs /README.md: -------------------------------------------------------------------------------- 1 | # Haskell-polyvariadic 2 | Examples of polyvariadic functions in Haskell. 3 | 4 | ## What are polyvariadic functions? 5 | Polyvariadic functions are functions which can take variable numbers of arguments, such as C's famous `printf` function, or the list construction function in many languages. 6 | 7 | In most programming languages it is trivial to implement polyvariadic functions. Take this example in Python: 8 | 9 | ```python 10 | def sum_args(*all): 11 | total = 0 12 | for i in all: 13 | total = total + i 14 | return total 15 | ``` 16 | 17 | In this case, all of these function calls are legal: 18 | 19 | ```python 20 | >>> sum_args(4,3,1) 21 | 8 22 | >>> sum_args(1,2,3,4,5) 23 | 15 24 | >>> sum_args() 25 | 0 26 | ``` 27 | 28 | However, in Haskell, this becomes trickier due to types: since every Haskell function's type only takes one argument, functions with many arguments return a new function with a different argument type, and does so until reaching a final type. 29 | 30 | However, we can't have a *variable* number of arguments in that way: the number of arguments is already decided. You might think of making the type return an `Either` type so as to describe the option of two return types, but that would lead to nasty syntax. 31 | 32 | ## How can we describe polyvariadic functions in Haskell? 33 | 34 | We can't quite create functions that are polyvariadic at runtime, but at compile-time it's certainly possible, via typeclasses. 35 | 36 | For instance, if we were to make a function, `str`, that chained `Char`s together into a string, we would begin by making a typeclass: 37 | 38 | ```Haskell 39 | {-# LANGUAGE FlexibleInstances #-} 40 | 41 | class StrReturnType r where 42 | retString :: String -> r 43 | ``` 44 | 45 | Then, we'd add instances for the possible return types, as so: 46 | 47 | ```Haskell 48 | instance StrReturnType String where 49 | retString = id 50 | 51 | instance (StrReturnType r) => StrReturnType (Char -> r) where 52 | retString s c = retString (s ++ [c]) 53 | ``` 54 | 55 | Then it's easy to make a function `str`: 56 | 57 | ```Haskell 58 | str :: (StrReturnType r) => r 59 | str = retString "" 60 | ``` 61 | 62 | And that's all! We need to write the type signature so as to constrain the type in GHCi: 63 | 64 | ```Haskell 65 | λ> str 'a' 'b' 'c' 'd' :: String 66 | "abcd" 67 | λ> str 'H' 'a' 's' 'k' 'e' 'l' 'l' :: String 68 | "Haskell" 69 | λ> str :: String 70 | "" 71 | ``` 72 | 73 | More information on making polyvariadic Haskell functions can be found [here](http://okmij.org/ftp/Haskell/polyvariadic.html). 74 | 75 | ## Notes 76 | 77 | ### Functional dependencies 78 | 79 | We can make our classes much more powerful with multiparameter typeclasses and functional dependencies, for instance, making the class above polymorphic to any list, like so: 80 | 81 | ```Haskell 82 | {-# LANGUAGE FlexibleInstances #-} 83 | {-# LANGUAGE FunctionalDependencies #-} 84 | 85 | class ListReturnType a r | r -> a where 86 | retList :: [a] -> r 87 | 88 | instance ListReturnType a [a] where 89 | retList = id 90 | 91 | instance (ListReturnType a r) => ListReturnType a (a -> r) where 92 | retList xs x = retList (xs ++ [x]) 93 | 94 | list :: (ListReturnType a r) => r 95 | list = retList [] 96 | ``` 97 | 98 | This can be applied to any datatype with a type variable. Notice the similarity to the original definition. 99 | 100 | ### Template Haskell method 101 | 102 | It's worth mentioning that this can be done similarly with Template Haskell. However, this requires more effort on the users part, because the number of arguments must be explicitly described before the arguments are passed. 103 | Here is an example of the use of a `printf` function written in Template Haskell: 104 | 105 | ```Haskell 106 | $(printf "Hello %s! This is a number: %d") "World" 12 107 | ``` 108 | 109 | The number of arguments to the function is determined in the splice (The `$( ... )` bit) rather than outside. Where in our `str` or `list` function we can implicitly describe the number of arguments, with Template Haskell, we'd describe it explicitly, something like this: 110 | 111 | ```Haskell 112 | $(list 5) 'H' 'e' 'l' 'l' 'o' 113 | ``` 114 | 115 | Even though we must define the number of arguments explictly, this does have the benefit of not needing explicit type signatures, which is an interesting payoff, but because Haskell supports type inference, I regard the original method as easier. 116 | 117 | In these examples, we will not be using Template Haskell, though I encourage you to experiment with it. 118 | 119 | More information about Template Haskell can be found [here](https://wiki.haskell.org/Template_Haskell). 120 | -------------------------------------------------------------------------------- /src/Concats.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | 4 | module Concats where 5 | 6 | class ConcatReturn a r | r -> a where 7 | fromDifflist :: ([a] -> [a]) -> r 8 | 9 | instance ConcatReturn a [a] where 10 | fromDifflist = ($ []) 11 | 12 | instance (ConcatReturn a r) => ConcatReturn a ([a] -> r) where 13 | fromDifflist a xs = fromDifflist (a . (++) xs) 14 | 15 | concats :: (ConcatReturn a r) => r 16 | concats = fromDifflist id 17 | 18 | -- Examples: 19 | --> concats [1,2,3] [] [4,5] [6] :: [Int] 20 | --> concats "Hello, " "world" "!" 21 | --> fromDifflist reverse "!" "dlrow" " ,olleH" 22 | -------------------------------------------------------------------------------- /src/FirstJust.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | 4 | module FirstJust where 5 | 6 | class FirstReturn a r | r -> a where 7 | fromMaybe :: Maybe a -> r 8 | 9 | instance FirstReturn a (Maybe a) where 10 | fromMaybe = id 11 | 12 | instance (FirstReturn a r) => FirstReturn a (Maybe a -> r) where 13 | fromMaybe Nothing a = fromMaybe a 14 | fromMaybe a _ = fromMaybe a 15 | 16 | firstJust :: (FirstReturn a r) => r 17 | firstJust = fromMaybe Nothing 18 | 19 | -- Examples: 20 | --> firstJust Nothing (Just 3) (Just 5) Nothing :: Maybe Int 21 | --> firstJust :: Maybe String 22 | --> firstJust (lookup a map) (lookup b map) (lookup c map) :: Maybe Something 23 | -------------------------------------------------------------------------------- /src/List.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | 4 | module List where 5 | 6 | class ListReturn a r | r -> a where 7 | fromDifflist :: ([a] -> [a]) -> r 8 | 9 | instance ListReturn a [a] where 10 | fromDifflist f = f [] 11 | 12 | instance (ListReturn a r) => ListReturn a (a -> r) where 13 | fromDifflist f x = fromDifflist (f . (:) x) 14 | 15 | list :: (ListReturn a r) => r 16 | list = fromDifflist id 17 | 18 | -- Examples: 19 | --> list 1 5 7 9 :: [Int] 20 | --> list 'G' 'H' 'C' 'i' :: String 21 | --> list [1,2,3] [] [4,5] :: [[Int]] 22 | -------------------------------------------------------------------------------- /src/Monoids.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | 4 | newtype Result a = Result {getResult :: a} 5 | deriving (Show, Read, Eq, Ord) 6 | 7 | class MonoidReturn m r | r -> m where 8 | fromMonoid :: m -> r 9 | 10 | instance MonoidReturn m (Result m) where 11 | fromMonoid = Result 12 | 13 | instance (Monoid m, MonoidReturn m r) => MonoidReturn m (m -> r) where 14 | fromMonoid a b = fromMonoid (a `mappend` b) 15 | 16 | 17 | appends :: (Monoid m, MonoidReturn m r) => r 18 | appends = fromMonoid mempty 19 | 20 | -- Examples: 21 | --> getResult $ appends [1,2,3] [4,5] [6,7,8] [] [9,10] :: [Int] 22 | --> (getResult $ appends reverse id) [1,2,3,4,5] :: [Int] 23 | --> getResult $ appends (EQ, [1,2]) (GT, []) (GT, [1,2,3]) :: (Ordering, [Int]) 24 | -------------------------------------------------------------------------------- /src/Printf.hs: -------------------------------------------------------------------------------- 1 | {-# LANGAUGE FlexibleInstances #-} 2 | 3 | module Printf where 4 | 5 | class PrintfType r where 6 | printf :: String -> r 7 | 8 | instance PrintfType String where 9 | printf = id 10 | 11 | instance PrintfType (IO ()) where 12 | printf = putStrLn 13 | 14 | instance (PrintfType r) => PrintfType (String -> r) where 15 | printf f s = printf (replaceString f s) 16 | 17 | instance (PrintfType r) => PrintfType (Int -> r) where 18 | printf f i = printf (replaceInt f i) 19 | 20 | replaceString :: String -> String -> String 21 | replaceString ('%':'%':xs) s = '%' : replaceString xs s 22 | replaceString ('%':'s':xs) s = s ++ xs 23 | replaceString (x:xs) s = x : replaceString xs s 24 | replaceString [] s = error "printf: No String placemarker." 25 | 26 | replaceInt :: String -> Int -> String 27 | replaceInt ('%':'%':xs) i = '%' : replaceInt xs i 28 | replaceInt ('%':'i':xs) i = show i ++ xs 29 | replaceInt (x:xs) i = x : replaceInt xs i 30 | replaceInt [] i = error "printf: No Int placemarker." 31 | 32 | -- Examples: 33 | --> printf "%i%% of the population are %s." (12 :: Int) "aliens" :: String 34 | --> printf "Hello, %s!" "World" :: IO () 35 | --> printf "This will fail %i times!" "sixteen point five" :: IO () 36 | --------------------------------------------------------------------------------