{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

module PrefixShow where

import GHC.Generics

import ADTs

class PrefixShow a where
    prefixShows :: a -> [String] -> [String]
    default prefixShows :: (Generic a, GPrefixShow (Rep a)) => a -> [String] -> [String]
    prefixShows a = gprefixShows (from a)

prefixShow :: PrefixShow a => a -> [String]
prefixShow a = prefixShows a []

class GPrefixShow f where
    gprefixShows :: f p -> [String] -> [String]

instance GPrefixShow V1 where
    gprefixShows _ = ("<bottom>" :)

instance GPrefixShow U1 where
    gprefixShows _ = id

instance PrefixShow c => GPrefixShow (K1 i c) where
    gprefixShows (K1 x) = prefixShows x

instance (GPrefixShow f, GPrefixShow g) => GPrefixShow ((:*:) f g) where
    gprefixShows (f :*: g) = gprefixShows f
                         . gprefixShows g

instance (GPrefixShow f, GPrefixShow g) => GPrefixShow ((:+:) f g) where
    gprefixShows (L1 x) = gprefixShows x
    gprefixShows (R1 x) = gprefixShows x

instance GPrefixShow f => GPrefixShow (S1 c f) where
    gprefixShows (M1 x) = gprefixShows x

instance (Constructor c, GPrefixShow f) => GPrefixShow (C1 c f) where
    gprefixShows m@(M1 x) = (conName m :) . gprefixShows x

instance GPrefixShow f => GPrefixShow (D1 c f) where
    gprefixShows (M1 x) = gprefixShows x


instance PrefixShow Integer where
    prefixShows a = (show a :)

instance PrefixShow Expr