RangeDebug.hs

{-# LANGUAGE DefaultSignatures, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, TypeOperators #-}
-- | A module for displaying debug info about the source annotations of the syntax tree in different phases.
module Language.Haskell.Tools.Debug.RangeDebug where

import Control.Reference ()
import GHC.Generics
import Language.Haskell.Tools.AST (SourceInfo(..), Domain(..))
import Language.Haskell.Tools.BackendGHC ()
import Language.Haskell.Tools.PrettyPrint.Prepare ()

srcInfoDebug :: TreeDebug e dom st => e dom st -> String
srcInfoDebug = treeDebug' 0

class (SourceInfo st, Domain dom, Show (e dom st))
        => TreeDebug e dom st where
  treeDebug' :: Int -> e dom st -> String
  default treeDebug' :: (GTreeDebug (Rep (e dom st)), Generic (e dom st), Domain dom) => Int -> e dom st -> String
  treeDebug' i = gTreeDebug i . from

class GTreeDebug f where
  gTreeDebug :: Int -> f p -> String

instance GTreeDebug V1 where
  gTreeDebug _ = error "GTreeDebug V1"

instance GTreeDebug U1 where
  gTreeDebug _ U1 = ""

instance (GTreeDebug f, GTreeDebug g) => GTreeDebug (f :+: g) where
  gTreeDebug i (L1 x) = gTreeDebug i x
  gTreeDebug i (R1 x) = gTreeDebug i x

instance (GTreeDebug f, GTreeDebug g) => GTreeDebug (f :*: g) where
  gTreeDebug i (x :*: y) = gTreeDebug i x ++ gTreeDebug i y

instance {-# OVERLAPPING #-} TreeDebug e dom st => GTreeDebug (K1 i (e dom st)) where
  gTreeDebug i (K1 x) = treeDebug' i x

instance {-# OVERLAPPABLE #-} GTreeDebug (K1 i c) where
  gTreeDebug _ (K1 _) = ""

instance GTreeDebug f => GTreeDebug (M1 i t f) where
  gTreeDebug i (M1 x) = gTreeDebug i x