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

module Shew where

import GHC.Generics

import ADTs

class Shew a where
    shewsPrec :: Int -> a -> String -> String
    default shewsPrec :: (Generic a, GShew (Rep a)) => Int -> a -> String -> String
    shewsPrec n a s = gshewsPrec n (from a) s

shew :: Shew a => a -> String
shew a = shewsPrec 0 a ""

instance Shew Integer where
    shewsPrec n a = showsPrec n a

class GShew f where
    gshewsPrec :: Int -> f p -> String -> String

instance GShew V1 where
    gshewsPrec _ _ = showString "<bottom>"

instance GShew U1 where
    gshewsPrec _ _ = id

instance Shew c => GShew (K1 i c) where
    gshewsPrec n (K1 x) = shewsPrec n x

instance (GShew f, GShew g) => GShew ((:*:) f g) where
    gshewsPrec n (f :*: g) = gshewsPrec n f
                             . showChar ' '
                             . gshewsPrec n g

instance (GShew f, GShew g) => GShew ((:+:) f g) where
    gshewsPrec n (L1 x) = gshewsPrec n x
    gshewsPrec n (R1 x) = gshewsPrec n x

instance (Selector c, GShew f) => GShew (S1 c f) where
    gshewsPrec n m@(M1 x)
      | null fieldname = gshewsPrec n x
      | otherwise = showString fieldname
                    . showString " = "
                    . gshewsPrec 0 x
      where
        fieldname = selName m

instance (Constructor c, GShew f) => GShew (C1 c f) where
    gshewsPrec n m@(M1 x) = showString (conName m)
                            . gshewsPrec 10 x

instance GShew f => GShew (D1 c f) where
    gshewsPrec n (M1 x) = gshewsPrec n x


instance Shew Expr