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 (..))
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]
++ ")"
showCommentTokenStream :: [(Span, Token)] -> String
[] = "[]\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
(_, 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]
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]
++ ")"
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]
++ ")"
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]
++ ")"
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]
++ ")"
showToken :: Token -> String
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
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
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"
showToken (Token VSemicolon _) = "VSemicolon"
showToken (Token VRightBrace _) = "VRightBrace"
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"
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"
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"
showToken (Token SymDot _) = "SymDot"
showToken (Token SymMinus _) = "SymMinus"
showToken (Token SymStar _) = "SymStar"
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"
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
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
(+++) :: 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