{-| 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 ' -', '-> ', ' = ', "#", '', '', '', '', '', ' => '
-}
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 (Eq, Show)
-- | Strip a token of unnecessary spaces.
strip :: Token -> Token
strip (Name txt) = Name (pack.reverse.stripLeft.reverse.stripLeft $ str)
where
str = unpack txt
stripLeft (' ':s) = s
stripLeft s = s
strip x = x
-- | Transforms a string into a list of tokens.
parserLex :: String -> [Token]
parserLex str = strip <$> parserLexHelper str
where
parserLexHelper [] = []
parserLexHelper ('#':str) = []
parserLexHelper (' ':'-':str) = BeginArrow : (parserLexHelper str)
parserLexHelper ('-':'>':' ':str) = EndArrow : (parserLexHelper str)
parserLexHelper (' ':'=':' ':str) = Equals : (parserLexHelper str)
parserLexHelper ('<':'I':'D':'/':'>':str) = Identity : (parserLexHelper str)
parserLexHelper ('<':'S':'R':'C':'>':str) = BeginSrc : (parserLexHelper str)
parserLexHelper ('<':'T':'G':'T':'>':str) = BeginTgt : (parserLexHelper str)
parserLexHelper ('<':'/':'S':'R':'C':'>':str) = EndSrc : (parserLexHelper str)
parserLexHelper ('<':'/':'T':'G':'T':'>':str) = EndTgt : (parserLexHelper str)
parserLexHelper (' ':'=':'>':' ':str) = MapsTo : (parserLexHelper str)
parserLexHelper (c:str) = (result restLexed)
where
restLexed = (parserLexHelper str)
result (Name txt:xs) = (Name (cons c txt):xs)
result a = ((Name (singleton c)):a)