Boom/boom.hs

{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

class Solution n r | n -> r
   where solution :: n -> r
instance (InitList n l, Map BoomOrNum' l r)
   => Solution n r where solution = nil

data BoomOrNum'

nil = undefined

class EqNine d b | d -> b
instance (Equal d (S (S (S (S (S (S (S (S (S Z))))))))) r)
   => EqNine d r

class Inc l r | l -> r
instance (Reverse Nil l nl, Inc' True nl nr, Reverse Nil nr r)
   => Inc l r

class Inc1 b n r | b n -> r
instance Inc1 True d Z
instance (Add (S Z) d r)
   => Inc1 False d r

class Inc' c l r | c l -> r
instance Inc' False l l
instance Inc' True Nil (Cons (S Z) Nil)
instance (Inc1 nc x nx, EqNine x nc, Inc' nc xs r)
   => Inc' True (Cons x xs) (Cons nx r)

class InitList' t n l a | t n l -> a
instance InitList' Z n l (Cons n l)
instance (Inc n nn, InitList' x nn (Cons n l) a)
   => InitList' (S x) n l a

class InitList t l | t -> l
instance (InitList' t (Cons Z Nil) Nil a, Reverse Nil a l)
   => InitList t l

data Boom

class EqualThree x r | x -> r
instance (Equal x (S (S (S Z))) a)
   => EqualThree x a

data EqualThree'

class Apply f a r | f a -> r
instance (EqualThree x r)
   => Apply EqualThree' x r
instance (BoomOrNum x r)
   => Apply BoomOrNum' x r

class Map f xs ys | f xs -> ys
instance Map f Nil Nil
instance (Apply f x y, Map f xs ys)
   => Map f (Cons x xs) (Cons y ys)

class Boom' c n r | c n -> r
instance Boom' True n Boom
instance Boom' False n n

class BoomOrNum n r | n -> r
instance (Map EqualThree' n bs, AnyTrue bs a, Boom' a n r)
   => BoomOrNum n r

class AnyTrue list t | list -> t
instance AnyTrue Nil False
instance AnyTrue (Cons True more) True
instance (AnyTrue list t)
   => AnyTrue (Cons False list) t

data Nil
data Cons x xs

data True
data False

data Z
data S n

class Equal a b t | a b -> t
instance Equal Z Z True
instance Equal (S a) Z False
instance Equal Z (S b) False
instance (Equal a b t)
   => Equal (S a) (S b) t

class Add x y z | x y -> z
instance Add x Z x
instance Add Z y y
instance (Add (S x) y z)
   => Add x (S y) z

class Multiply x y a z | x y a -> z
instance Multiply Z y a a
instance Multiply x Z a a
instance (Add x a r, Multiply x y r z)
   => Multiply x (S y) a z 

class Reverse i l r | i l -> r
instance Reverse i Nil i
instance (Reverse (Cons x i) xs r)
   => Reverse i (Cons x xs) r