{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE StrictData        #-}
module Language.Cimple.DescribeAst
    ( HasLocation (..)
    , describeLexeme
    , describeNode
    ) where

import           Data.Fix                (Fix (..), foldFix)
import           Data.Text               (Text)
import qualified Data.Text               as Text
import           Language.Cimple.Ast     (Node, NodeF (..))
import qualified Language.Cimple.Flatten as Flatten
import           Language.Cimple.Lexer   (Lexeme, lexemeLine)


class HasLocation a where
    sloc :: FilePath -> a -> Text

instance HasLocation (Lexeme text) where
    sloc :: FilePath -> Lexeme text -> Text
sloc FilePath
file Lexeme text
l = FilePath -> Text
Text.pack FilePath
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Lexeme text -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme text
l))

instance HasLocation lexeme => HasLocation (Node lexeme) where
    sloc :: FilePath -> Node lexeme -> Text
sloc FilePath
file Node lexeme
n =
        case (NodeF lexeme [lexeme] -> [lexeme]) -> Node lexeme -> [lexeme]
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NodeF lexeme [lexeme] -> [lexeme]
forall lexeme. NodeF lexeme [lexeme] -> [lexeme]
Flatten.lexemes Node lexeme
n of
            []  -> FilePath -> Text
Text.pack FilePath
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":0:0"
            lexeme
l:[lexeme]
_ -> FilePath -> lexeme -> Text
forall a. HasLocation a => FilePath -> a -> Text
sloc FilePath
file lexeme
l


describeNode :: Show a => Node a -> String
describeNode :: Node a -> FilePath
describeNode Node a
node = case Node a -> NodeF a (Node a)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node a
node of
    PreprocIf{}     -> FilePath
"#if/#endif block"
    PreprocIfdef{}  -> FilePath
"#ifdef/#endif block"
    PreprocIfndef{} -> FilePath
"#ifndef/#endif block"
    NodeF a (Node a)
_               -> NodeF a FilePath -> FilePath
forall a. Show a => a -> FilePath
show (NodeF a FilePath -> FilePath) -> NodeF a FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> Node a -> FilePath
forall a b. a -> b -> a
const FilePath
ellipsis) (Node a -> FilePath) -> NodeF a (Node a) -> NodeF a FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node a -> NodeF a (Node a)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node a
node
  where
    ellipsis :: String
    ellipsis :: FilePath
ellipsis = FilePath
"..."

describeLexeme :: Show a => Lexeme a -> String
describeLexeme :: Lexeme a -> FilePath
describeLexeme = Lexeme a -> FilePath
forall a. Show a => a -> FilePath
show