ShowChord.hs

{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE OverlappingInstances     #-}

module MIR.HarmGram.ShowChord (ShowChord(..), showChordDefault, paren) where

import Generics.Instant.Base

-- Generic show for chords on Representable (worker)
class ShowChord a where
  showChord :: a -> ShowS

instance ShowChord U where
  {- INLINE showChord #-}
  showChord U = showString ""
  
instance (ShowChord a, ShowChord b) => ShowChord (a :+: b) where
  {- INLINE showChord #-}
  showChord (L x) = showChord x
  showChord (R x) = showChord x
  
instance (ShowChord a, ShowChord b) => ShowChord (a :*: b) where
  {- INLINE showChord #-}
  showChord (a :*: b) = showChord a . showChord b
  
instance (ShowChord a, Constructor c) => ShowChord (C c a) where
  {- INLINE showChord #-}
  -- showChord c@(C a) = paren $ showString (takeWhile (/= '_') (conName c)) . showChord a
  showChord c@(C a) = paren $ showString (conName c) . showChord a

instance ShowChord a => ShowChord (Var a) where
  {- INLINE showChord #-}
  showChord (Var x) = showChord x

instance ShowChord a => ShowChord (Rec a) where
  {- INLINE showChord #-}
  showChord (Rec x) = showChord x


-- Dispatcher
{- INLINE showChordDefault #-}
showChordDefault :: (Representable a, ShowChord (Rep a)) => a -> ShowS
showChordDefault = showChord . from


-- Adhoc instances
instance ShowChord Int      where 
  {- INLINE showChord #-}
  showChord = shows
instance ShowChord Integer  where 
  {- INLINE showChord #-}
  showChord = shows
instance ShowChord Float    where 
  {- INLINE showChord #-}
  showChord = shows
instance ShowChord Double   where 
  {- INLINE showChord #-}
  showChord = shows
instance ShowChord Char     where 
  {- INLINE showChord #-}
  showChord = shows
instance ShowChord Bool     where 
  {- INLINE showChord #-}
  showChord = shows


instance ShowChord a => ShowChord [a] where
  {- INLINE showChord #-}
  showChord = paren . foldr (.) id . map showChord
  
instance ShowChord [Char] where
  {- INLINE showChord #-}
  showChord = showString

instance (ShowChord a) => ShowChord (Maybe a) where
  {- INLINE showChord #-}
  showChord Nothing  = id
  showChord (Just a) = showChord a

-- Utilities
paren :: ShowS -> ShowS
paren x = showChar '[' . x . showChar ']'