Improved Type-Level FizzBuzz
This is a slight improvment of the code in my previous post A Preliminary Attempt at Type-Level FizzBuzz. The credit goes to my friend Shulhi Sapli. He took a look at my code and came up with a cleaner solution. This part should be straightforward if you were able to folow the code from the previous post.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Kind (Type)
import Data.Proxy (Proxy(..))
import GHC.TypeLits
type family IsZero (a :: Nat) :: Bool where
IsZero 0 = 'True
IsZero _ = 'False
type family ModRemainderIsZero (a :: Nat) (b :: Nat) where
ModRemainderIsZero a b = IsZero (Mod a b)
type family FizzBuzz' (a :: Bool) (b :: Bool) c where
FizzBuzz' 'True 'True _ = "FizzBuzz"
FizzBuzz' _ 'True _ = "Fizz"
FizzBuzz' 'True _ _ = "Buzz"
FizzBuzz' _ _ c = NatToSym c
ConcatSymbols
is a type-level function to concat each Symbol
with a line break in between each value. That way we can transform a list of Nat
with NatToSym
and ConcatSymbols
into a single Symbol
, turn it into a String
and print it.
type family ConcatSymbols xs where
ConcatSymbols '[] = ""
ConcatSymbols (x ': xs) = AppendSymbol x (AppendSymbol "\n" (ConcatSymbols xs))
The nicest part is he found a solution to type-level function mapping. He got the idea from (Thinking with Types Type-Level Programming in Haskell)[http://thinkingwithtypes.com/] in chapter 10. This type-level technique is called defunctionalization, which allows for higher order type-level functions in Haskell.
type Exp a = a -> Type
type family Eval (e :: Exp a) :: a
data MapList :: (a -> Exp b) -> [a] -> Exp [b]
type instance Eval (MapList f '[]) = '[]
type instance Eval (MapList f (a ': as)) = Eval (f a) ': Eval (MapList f as)
data FizzBuzz :: Nat -> Exp Symbol
type instance Eval (FizzBuzz n) = FizzBuzz' (ModRemainderIsZero n 3) (ModRemainderIsZero n 5) n
Now we just need a list of Nat
s and we can map FizzBuzz
and ConcatSymbols
to get a Symbol
. Much cleaner than the previous version.
type Nums = '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
type Result = ConcatSymbols (Eval (MapList FizzBuzz Nums))
main :: IO ()
main = putStr $ symbolVal (Proxy :: Proxy Result)
One thing I have not been able to do is create a working Range
type-level function that takes two Nat
and returns all the numbers between them in a list. The following compiles.
type family IfThenElse cond a b where
IfThenElse 'True a _ = a
IfThenElse 'False _ b = b
type family Append xs y where
Append '[] y = '[y]
Append (x ': xs) y = x ': (Append xs y)
type family OrderToBool x where
OrderToBool 'EQ = 'True
OrderToBool _ = 'False
type family Range (x :: Nat) (y :: Nat) (zs :: [Nat]) :: [Nat] where
Range x y zs =
IfThenElse
(OrderToBool (CmpNat x y))
zs
(Range (x + 1) y (Append zs x))
I want to compile and run the following, but it seems to get caught an infinite loop. The compiler suggest using the GHC flag -freduction-depth=0
, but it does not seem to help. Even for small values it gets stuck.