{-| Module  : FiniteCategories
Description : Lexer for parsers.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

Lexer for parsers. The keywords are ' -', '-> ', ' = ', "#", '<ID/>', '<SRC>', '</SRC>', '<TGT>', '</TGT>', ' => '
-}
module IO.Parsers.Lexer where
    import Data.Text (Text, cons, singleton, unpack, pack)
    
    -- | A token for a scg or fscg file.

    data Token = Name Text | BeginArrow | EndArrow | Equals | Identity | BeginSrc | EndSrc | BeginTgt | EndTgt | MapsTo deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)
    
    -- | Strip a token of unnecessary spaces.

    strip :: Token -> Token
    strip :: Token -> Token
strip (Name Text
txt) = Text -> Token
Name (String -> Text
pack(String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
forall a. [a] -> [a]
reverseShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
stripLeftShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
forall a. [a] -> [a]
reverseShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
stripLeft (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
str)
        where
            str :: String
str = Text -> String
unpack Text
txt
            stripLeft :: ShowS
stripLeft (Char
' ':String
s) = String
s 
            stripLeft String
s = String
s 
    strip Token
x = Token
x
        
    -- | Transforms a string into a list of tokens.

    parserLex :: String -> [Token]
    parserLex :: String -> [Token]
parserLex String
str = Token -> Token
strip (Token -> Token) -> [Token] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [Token]
parserLexHelper String
str
        where
            parserLexHelper :: String -> [Token]
parserLexHelper [] = [] 
            parserLexHelper (Char
'#':String
str) = []
            parserLexHelper (Char
' ':Char
'-':String
str) = Token
BeginArrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'-':Char
'>':Char
' ':String
str) = Token
EndArrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
' ':Char
'=':Char
' ':String
str) = Token
Equals Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'I':Char
'D':Char
'/':Char
'>':String
str) = Token
Identity Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'S':Char
'R':Char
'C':Char
'>':String
str) = Token
BeginSrc Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'T':Char
'G':Char
'T':Char
'>':String
str) = Token
BeginTgt Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'/':Char
'S':Char
'R':Char
'C':Char
'>':String
str) = Token
EndSrc Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
'<':Char
'/':Char
'T':Char
'G':Char
'T':Char
'>':String
str) = Token
EndTgt Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
' ':Char
'=':Char
'>':Char
' ':String
str) = Token
MapsTo Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
            parserLexHelper (Char
c:String
str) =  ([Token] -> [Token]
result [Token]
restLexed)
                where
                    restLexed :: [Token]
restLexed = (String -> [Token]
parserLexHelper String
str)
                    result :: [Token] -> [Token]
result (Name Text
txt:[Token]
xs) = (Text -> Token
Name (Char -> Text -> Text
cons Char
c Text
txt)Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
xs)
                    result [Token]
a = ((Text -> Token
Name (Char -> Text
singleton Char
c))Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
a)