    {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
    {-# OPTIONS -fno-warn-orphans #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.C.Analysis.Debug
    -- Copyright   :  (c) 2008 Benedikt Huber
    -- License     :  BSD-style
    -- Maintainer  :  benedikt.huber@gmail.com
    -- Stability   :  prototype
    -- Portability :  ghc
    --
    -- Pretty printing the semantic analysis representation.
    -- This is currently only intended for debugging purposes.
    -----------------------------------------------------------------------------
    module Language.C.Analysis.Debug (
    globalDeclStats,
    prettyAssocs, prettyAssocsWith,
    -- and many pretty instances
    )
    where
    import Language.C.Analysis.SemRep
    import Language.C.Analysis.Export

    import Language.C.Data
    import Language.C.Pretty
    import Language.C.Syntax

    import Data.Generics
    import Text.PrettyPrint.HughesPJ
    import Data.Map (Map) ; import qualified Data.Map as Map

    prettyAssocs :: (Pretty k, Pretty v) => String -> [(k,v)] -> Doc
    prettyAssocs label = prettyAssocsWith label pretty pretty
    prettyAssocsWith :: String -> (k -> Doc) -> (v -> Doc) -> [(k,v)] -> Doc
    prettyAssocsWith label prettyKey prettyVal theMap =
        text label $$ (nest 8) (vcat $ map prettyEntry theMap)
        where
        prettyEntry (k,v) = prettyKey k <+> text " ~> " <+> prettyVal v

    instance Pretty GlobalDecls where
        pretty gd = text "Global Declarations" $$ (nest 4 $ vcat declMaps)
            where
            declMaps = [ prettyMap "enumerators" theEnums, prettyMap "declarations" theDecls,
                         prettyMap "objects" theObjs,  prettyMap "functions" theFuns,
                         prettyMap "tags"    $ gTags gd,  prettyMap "typeDefs"  $ gTypeDefs gd ]
            prettyMap :: (Pretty t, Pretty k) => String -> Map k t -> Doc
            prettyMap label = prettyAssocs label . Map.assocs
            (theDecls, (theEnums, theObjs, theFuns)) = splitIdentDecls False (gObjs gd)

    globalDeclStats :: (FilePath -> Bool) -> GlobalDecls -> [(String,Int)]
    globalDeclStats file_filter gmap =
        [ ("Enumeration Constants",Map.size enumerators),
          ("Total Object/Function Declarations",Map.size all_decls),
          ("Object definitions", Map.size objDefs),
          ("Function Definitions", Map.size funDefs),
          ("Tag definitions", Map.size tagDefs),
          ("TypeDefs", Map.size typeDefs)
        ]
        where
        gmap' = filterGlobalDecls filterFile gmap
        (all_decls,(enumerators,objDefs,funDefs)) = splitIdentDecls True (gObjs gmap')
        (tagDefs,typeDefs) = (gTags gmap', gTypeDefs gmap')
        filterFile :: (CNode n) => n -> Bool
        filterFile = file_filter . posFile . posOfNode . nodeInfo

    instance Pretty (Either VarDecl ObjDef) where
        pretty = either pretty pretty
    instance Pretty (Either VarDecl FunDef) where
        pretty = either pretty pretty
    instance Pretty Ident where
        pretty = text . identToString
    instance Pretty SUERef where
        pretty ref = text (show ref)
    instance Pretty TagDef where
        pretty (CompDef compty) = pretty compty
        pretty (EnumDef enumty) = pretty enumty
    instance Pretty IdentDecl where
        pretty (Declaration decl) = pretty decl
        pretty (ObjectDef odef) = pretty odef
        pretty (FunctionDef fdef) = pretty fdef
        pretty (EnumeratorDef enumerator) = pretty enumerator
    instance Pretty Decl where
        pretty (Decl vardecl _) =
            text "declaration" <+>
            pretty vardecl
    instance Pretty TypeDef where
        pretty (TypeDef ident ty attrs _) =
            text "typedef" <+> pretty ident <+> text "as"  <+>
            pretty attrs <+> pretty ty
    instance Pretty ObjDef where
        pretty (ObjDef vardecl init_opt _) =
            text "object" <+>
            pretty vardecl <+> maybe empty (((text "=") <+>) . pretty) init_opt
    instance Pretty FunDef where
        pretty (FunDef vardecl _stmt _) =
            text "function" <+>
            pretty vardecl
    instance Pretty VarDecl where
        pretty (VarDecl name attrs ty) =
            ((hsep . punctuate (text " |")) [pretty name, pretty attrs, pretty ty])
    instance Pretty ParamDecl where
        pretty (ParamDecl (VarDecl name declattrs ty) _) =
            pretty declattrs <+> pretty name <+> text "::" <+> pretty ty
    instance Pretty DeclAttrs where
        pretty (DeclAttrs inline storage attrs) =
            (if inline then (text "inline") else empty) <+>
            (hsep $ [ pretty storage, pretty attrs])
    instance Pretty Type where
      pretty ty = pretty (exportTypeDecl ty)
    instance Pretty TypeQuals where
        pretty tyQuals = hsep $ map showAttr [ ("const",constant),("volatile",volatile),("restrict",restrict) ]
            where showAttr (str,select) | select tyQuals = text str
                                        | otherwise      = empty

    instance Pretty CompType where
        pretty (CompType sue_ref tag members attrs node) =
            (text.show) tag <+> pretty sue_ref <+>
            braces (terminateSemi members) <+>
            pretty attrs
    instance Pretty MemberDecl where
        pretty (MemberDecl (VarDecl name declattrs ty) bitfield _) =
            pretty declattrs <+> pretty name <+> text "::" <+> pretty ty <+>
            (maybe empty (\bf -> text ":" <+> pretty bf) bitfield)
        pretty (AnonBitField ty bitfield_sz _) =
            pretty ty <+> text ":" <+> pretty bitfield_sz

    instance Pretty EnumType where
        pretty (EnumType sue_ref enumerators attrs _) =
          text "enum" <+> pretty sue_ref <+> braces (terminateSemi_ $ map prettyEnr enumerators) <+> pretty attrs
          where
          prettyEnr (Enumerator ident expr enumty _) = pretty ident <+> text " = " <+> pretty expr

    instance Pretty Enumerator where
        pretty (Enumerator ident expr enumty _) = text "<" <> text "econst" <+> pretty (sueRef enumty) <> text ">" <+>
                                                  pretty ident <+> text " = " <+> pretty expr

    instance Pretty Storage where
        pretty NoStorage = empty
        pretty (Auto reg) = text$ if reg then "auto/register" else "auto"
        pretty (Static linkage thread_local) =
            (hcat . punctuate (text "/") $ [ text "static",pretty linkage ])
            <+> (if thread_local then text ", __thread" else empty)
        pretty (FunLinkage linkage) = text "function/" <> pretty linkage
    instance Pretty Linkage where
        pretty InternalLinkage = text "internal"
        pretty ExternalLinkage = text "external"
    instance Pretty VarName where
        pretty NoName = text "<anonymous>"
        pretty (VarName ident asmname_opt) = pretty ident <+> (maybe empty pAsmName asmname_opt)
            where pAsmName asmname = text "" <+> parens (text "asmname" <+> pretty asmname)
    instance Pretty Attributes where
        pretty = joinComma
    instance Pretty Attr where
        pretty (Attr ident es _) = pretty ident <+> (if null es then empty else text "(...)")

    joinComma :: (Pretty a) => [a] -> Doc
    joinComma = hsep . punctuate comma . map pretty
    terminateSemi :: (Pretty a) => [a] -> Doc
    terminateSemi = terminateSemi_ . map pretty
    terminateSemi_ :: [Doc] -> Doc
    terminateSemi_ = hsep . map (<> semi)