{- |
    Module      :  $Header$
    Description :  Generating List of Tokens and Spans
    Copyright   :  (c) 2015 - 2016, Katharina Rahf
                       2015 - 2016, Björn Peemöller
                       2015 - 2016, Jan Tikovsky

    This module defines a function for writing the list of tokens
    and spans of a Curry source module into a separate file.
-}

module TokenStream (showTokenStream, showCommentTokenStream) where

import Data.List             (intercalate)

import Curry.Base.Position   (Position (..))
import Curry.Base.Span       (Span (..))
import Curry.Syntax          (Token (..), Category (..), Attributes (..))

-- |Show a list of 'Span' and 'Token' tuples.
-- The list is split into one tuple on each line to increase readability.
showTokenStream :: [(Span, Token)] -> String
showTokenStream :: [(Span, Token)] -> String
showTokenStream [] = "[]\n"
showTokenStream ts :: [(Span, Token)]
ts =
  "[ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n, " (((Span, Token) -> String) -> [(Span, Token)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Span, Token) -> String
showST [(Span, Token)]
filteredTs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n]\n"
  where filteredTs :: [(Span, Token)]
filteredTs     = ((Span, Token) -> Bool) -> [(Span, Token)] -> [(Span, Token)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Span, Token) -> Bool) -> (Span, Token) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span, Token) -> Bool
isVirtual) [(Span, Token)]
ts
        showST :: (Span, Token) -> String
showST (sp :: Span
sp, t :: Token
t) = "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Span -> String
showSpanAsPair Span
sp String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Token -> String
showToken Token
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"

-- |Show a list of 'Span' and 'Token' tuples filtered by CommentTokens.
-- The list is split into one tuple on each line to increase readability.
showCommentTokenStream :: [(Span, Token)] -> String
showCommentTokenStream :: [(Span, Token)] -> String
showCommentTokenStream [] = "[]\n"
showCommentTokenStream ts :: [(Span, Token)]
ts =
  "[ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n, " (((Span, Token) -> String) -> [(Span, Token)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Span, Token) -> String
showST [(Span, Token)]
filteredTs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n]\n"
  where filteredTs :: [(Span, Token)]
filteredTs     = ((Span, Token) -> Bool) -> [(Span, Token)] -> [(Span, Token)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Span, Token) -> Bool
isComment [(Span, Token)]
ts
        showST :: (Span, Token) -> String
showST (sp :: Span
sp, t :: Token
t) = "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Span -> String
showSpan Span
sp String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Token -> String
showToken Token
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"

isVirtual :: (Span, Token) -> Bool
isVirtual :: (Span, Token) -> Bool
isVirtual (_, Token cat :: Category
cat _) = Category
cat Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category
EOF, Category
VRightBrace, Category
VSemicolon]

isComment :: (Span, Token) -> Bool
isComment :: (Span, Token) -> Bool
isComment (_, Token cat :: Category
cat _) = Category
cat Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category
LineComment, Category
NestedComment]

-- show 'span' as "((startLine, startColumn), (endLine, endColumn))"
showSpanAsPair :: Span -> String
showSpanAsPair :: Span -> String
showSpanAsPair sp :: Span
sp =
  "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
showPosAsPair (Span -> Position
start Span
sp) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
showPos (Span -> Position
end Span
sp) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"

-- show 'span' as "(Span startPos endPos)"
showSpan :: Span -> String
showSpan :: Span -> String
showSpan NoSpan = "NoSpan"
showSpan Span { start :: Span -> Position
start = Position
s, end :: Span -> Position
end = Position
e } =
   "(Span " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
showPos Position
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
showPos Position
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"

-- show 'position' as "(Position line column)"
showPos :: Position -> String
showPos :: Position -> String
showPos NoPos = "NoPos"
showPos Position { line :: Position -> Int
line = Int
l, column :: Position -> Int
column = Int
c } =
  "(Position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lString -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"

-- show 'Position' as "(line, column)"
showPosAsPair :: Position -> String
showPosAsPair :: Position -> String
showPosAsPair p :: Position
p = "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Position -> Int
line Position
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Position -> Int
column Position
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"

-- |Show tokens and their value if needed
showToken :: Token -> String
-- literals
showToken :: Token -> String
showToken (Token CharTok        a :: Attributes
a) = "CharTok"   String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
showToken (Token IntTok         a :: Attributes
a) = "IntTok"    String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
showToken (Token FloatTok       a :: Attributes
a) = "FloatTok"  String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
showToken (Token StringTok      a :: Attributes
a) = "StringTok" String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
-- identifiers
showToken (Token Id             a :: Attributes
a) = "Id"        String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
showToken (Token QId            a :: Attributes
a) = "QId"       String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
showToken (Token Sym            a :: Attributes
a) = "Sym"       String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
showToken (Token QSym           a :: Attributes
a) = "QSym"      String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
-- punctuation symbols
showToken (Token LeftParen      _) = "LeftParen"
showToken (Token RightParen     _) = "RightParen"
showToken (Token Semicolon      _) = "Semicolon"
showToken (Token LeftBrace      _) = "LeftBrace"
showToken (Token RightBrace     _) = "RightBrace"
showToken (Token LeftBracket    _) = "LeftBracket"
showToken (Token RightBracket   _) = "RightBracket"
showToken (Token Comma          _) = "Comma"
showToken (Token Underscore     _) = "Underscore"
showToken (Token Backquote      _) = "Backquote"
-- layout
showToken (Token VSemicolon     _) = "VSemicolon"
showToken (Token VRightBrace    _) = "VRightBrace"
-- reserved keywords
showToken (Token KW_case        _) = "KW_case"
showToken (Token KW_class       _) = "KW_class"
showToken (Token KW_data        _) = "KW_data"
showToken (Token KW_default     _) = "KW_default"
showToken (Token KW_deriving    _) = "KW_deriving"
showToken (Token KW_do          _) = "KW_do"
showToken (Token KW_else        _) = "KW_else"
showToken (Token KW_external    _) = "KW_external"
showToken (Token KW_fcase       _) = "KW_fcase"
showToken (Token KW_free        _) = "KW_free"
showToken (Token KW_if          _) = "KW_if"
showToken (Token KW_import      _) = "KW_import"
showToken (Token KW_in          _) = "KW_in"
showToken (Token KW_infix       _) = "KW_infix"
showToken (Token KW_infixl      _) = "KW_infixl"
showToken (Token KW_infixr      _) = "KW_infixr"
showToken (Token KW_instance    _) = "KW_instance"
showToken (Token KW_let         _) = "KW_let"
showToken (Token KW_module      _) = "KW_module"
showToken (Token KW_newtype     _) = "KW_newtype"
showToken (Token KW_of          _) = "KW_of"
showToken (Token KW_then        _) = "KW_then"
showToken (Token KW_type        _) = "KW_type"
showToken (Token KW_where       _) = "KW_where"
-- reserved operators
showToken (Token At             _) = "At"
showToken (Token Colon          _) = "Colon"
showToken (Token DotDot         _) = "DotDot"
showToken (Token DoubleColon    _) = "DoubleColon"
showToken (Token Equals         _) = "Equals"
showToken (Token Backslash      _) = "Backslash"
showToken (Token Bar            _) = "Bar"
showToken (Token LeftArrow      _) = "LeftArrow"
showToken (Token RightArrow     _) = "RightArrow"
showToken (Token Tilde          _) = "Tilde"
showToken (Token DoubleArrow    _) = "DoubleArrow"
-- special identifiers
showToken (Token Id_as          _) = "Id_as"
showToken (Token Id_ccall       _) = "Id_ccall"
showToken (Token Id_forall      _) = "Id_forall"
showToken (Token Id_hiding      _) = "Id_hiding"
showToken (Token Id_interface   _) = "Id_interface"
showToken (Token Id_primitive   _) = "Id_primitive"
showToken (Token Id_qualified   _) = "Id_qualified"
-- special operators
showToken (Token SymDot         _) = "SymDot"
showToken (Token SymMinus       _) = "SymMinus"
-- special symbols
showToken (Token SymStar        _) = "SymStar"
-- pragmas
showToken (Token PragmaLanguage _) = "PragmaLanguage"
showToken (Token PragmaOptions  a :: Attributes
a) = "PragmaOptions" String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
showToken (Token PragmaHiding   _) = "PragmaHiding"
showToken (Token PragmaMethod   _) = "PragmaMethod"
showToken (Token PragmaModule   _) = "PragmaModule"
showToken (Token PragmaEnd      _) = "PragmaEnd"
-- comments
showToken (Token LineComment    a :: Attributes
a) = "LineComment"   String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
showToken (Token NestedComment  a :: Attributes
a) = "NestedComment" String -> String -> String
+++ Attributes -> String
showAttributes Attributes
a
-- end-of-file token
showToken (Token EOF            _) = "EOF"

showAttributes :: Attributes -> String
showAttributes :: Attributes -> String
showAttributes NoAttributes            = ""
showAttributes (CharAttributes    c :: Char
c _) = Char -> String
forall a. Show a => a -> String
show Char
c
showAttributes (IntAttributes     i :: Integer
i _) = Integer -> String
forall a. Show a => a -> String
show Integer
i
showAttributes (FloatAttributes   f :: Double
f _) = Double -> String
forall a. Show a => a -> String
show Double
f
showAttributes (StringAttributes  s :: String
s _) = String -> String
forall a. Show a => a -> String
show String
s
showAttributes (IdentAttributes   m :: [String]
m i :: String
i) = String -> String
forall a. Show a => a -> String
show (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "." ([String]
m [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
i])
showAttributes (OptionsAttributes t :: Maybe String
t a :: String
a) = "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
forall a. Show a => a -> String
show String
a

-- Concatenate two 'String's with a smart space in between,
-- which is only added if both 'String's are non-empty
(+++) :: String -> String -> String
[] +++ :: String -> String -> String
+++ t :: String
t  = String
t
s :: String
s  +++ [] = String
s
s :: String
s  +++ t :: String
t  = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ ' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
t