[Haskell-cafe] Monad.Reader 8: Haskell, the new C++

[Pepe Iborra]

> For a taste, see Instant Insanity transliterated in this functional  
> language:
>
> http://hpaste.org/2689
>

I thought I'd better paste here the code for Instant Insanity with  
Type Families. Otherwise it will vanish in a short time.
I took the opportunity to clean it up a bit.

Although AT are not a supported feature, the code works in a 6.8.1  
snapshot.
But note that you cannot actually see the solution, as there is no  
way to ask
GHCi to display the normalized types.

My favorite bit is:
*>  type instance Map f Nil = Nil
*>  type instance Map f (x:::xs) = Apply f x ::: Map f xs

\begin{code}
   import Prelude hiding (all, flip, map, filter)
   u = undefined

   data R  -- Red
   data G  -- Green
   data B  -- Blue
   data W  -- White

   data Cube u f r b l d

   type CubeRed = Cube R R R R R R
   type CubeBlue = Cube B B B B B B
   type Cube1 = Cube B G W G B R
   type Cube2 = Cube W G B W R R
   type Cube3 = Cube G W R B R R
   type Cube4 = Cube B R G G W W

   data True
   data False

   type family And b1 b2
   type instance And True  True = True
   type instance And True  False= False
   type instance And False True = False
   type instance And False False= False

   data Nil
   data Cons x xs
   data x ::: xs
   infixr 5 :::

   type family ListConcat l1 l2
   type instance ListConcat Nil l = l
   type instance ListConcat (x:::xs) ys = x:::(ListConcat xs ys)

   type family Apply f a

   data Rotation
   data Twist
   data Flip
   type instance Apply Rotation (Cube u f r b l d) = Cube u r b l f d
   type instance Apply Twist    (Cube u f r b l d) = Cube f r u l d b
   type instance Apply Flip     (Cube u f r b l d) = Cube d l b r f u

   type family Map f xs
   type instance Map f Nil = Nil
   type instance Map f (x:::xs) = Apply f x ::: Map f xs

   type family Filter f xs
   type instance Filter f Nil = Nil
   type instance Filter f (x:::xs) = AppendIf (Apply f x) x (Filter f  
xs)

   type family AppendIf b x ys
   type instance AppendIf True x ys  = x ::: ys
   type instance AppendIf False x ys = ys

   type family MapAppend f xs
   type instance MapAppend f Nil = Nil
   type instance MapAppend f (x:::xs) = ListConcat (x:::xs) (Map f  
(x:::xs))

   type family MapAppend2 f xs
   type instance MapAppend2 f Nil = Nil
   type instance MapAppend2 f (x:::xs)  = ListConcat (x:::xs)  
(MapAppend f (Map f (x:::xs)))

   type family MapAppend3 f xs
   type instance MapAppend3 f Nil = Nil
   type instance MapAppend3 f (x:::xs) = ListConcat xs (MapAppend2 f  
(Map f (x:::xs)))


   data Orientations
   type instance Apply Orientations c = MapAppend3 Rotation (
                                        MapAppend2 Twist (
                                        MapAppend Flip (c:::Nil)))
   type family NE x y
   type instance NE R R = False
   type instance NE R G = True
   type instance NE R B = True
   type instance NE R W = True
   type instance NE G R = True
   type instance NE G G = False
   type instance NE G B = True
   type instance NE G W = True
   type instance NE B R = True
   type instance NE B G = True
   type instance NE B B = False
   type instance NE B W = True
   type instance NE W R = True
   type instance NE W G = True
   type instance NE W B = True
   type instance NE W W = False

   type family All l
   type instance All Nil = True
   type instance All (False ::: xs) = False
   type instance All (True ::: xs)  = All xs

   type family Compatible c1 c2
   type instance Compatible (Cube u1 f1 r1 b1 l1 d1) (Cube u2 f2 r2  
b2 l2 d2) =
       All (NE f1 f2 ::: NE r1 r2 ::: NE b1 b2 ::: NE l1 l2)

   type family Allowed c cs
   type instance Allowed c Nil = True
   type instance Allowed c (y ::: ys) = And (Compatible c y) (Allowed  
c ys)

   type family Solutions cs
   type instance Solutions Nil = (Nil ::: Nil)
   type instance Solutions (c ::: cs) = AllowedCombinations (Apply  
Orientations c) (Solutions cs)

   type family AllowedCombinations os sols
   type instance AllowedCombinations os Nil = Nil
   type instance AllowedCombinations os (s ::: sols) =
       ListConcat (AllowedCombinations os sols) (MatchingOrientations  
os s)

   type family MatchingOrientations os sol
   type instance MatchingOrientations Nil sol = Nil
   type instance MatchingOrientations (o ::: os) sol =
       AppendIf (Allowed o sol) (o:::sol) (MatchingOrientations os sol)

   type Cubes = (Cube1 ::: Cube2 ::: Cube3 ::: Cube4 ::: Nil)
   solution = u :: Solutions Cubes

\end{code}