{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
module Skylighting.Parser ( parseSyntaxDefinition
, parseSyntaxDefinitionFromText
, addSyntaxDefinition
, resolveKeywords
, missingIncludes
) where
import qualified Data.String as String
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Char (isAlphaNum, toUpper)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.Text.Read as TR
import qualified Data.Text.Encoding as TE
import Safe
import Skylighting.Regex
import Skylighting.Types
import System.FilePath
import Text.XML
import qualified Control.Exception as E
import Control.Monad.Trans.Except
import Control.Monad.Error.Class
import Control.Monad.Identity
#if MIN_VERSION_mtl(2,3,0)
import Control.Monad
#endif
addSyntaxDefinition :: Syntax -> SyntaxMap -> SyntaxMap
addSyntaxDefinition :: Syntax -> SyntaxMap -> SyntaxMap
addSyntaxDefinition s :: Syntax
s = Text -> Syntax -> SyntaxMap -> SyntaxMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Syntax -> Text
sName Syntax
s) Syntax
s
missingIncludes :: [Syntax] -> [(Text, Text)]
missingIncludes :: [Syntax] -> [(Text, Text)]
missingIncludes syns :: [Syntax]
syns = [(Text, Text)] -> [(Text, Text)]
forall a. Ord a => [a] -> [a]
ordNub
[(Syntax -> Text
sName Syntax
s, Text
lang)
| Syntax
s <- [Syntax]
syns
, Context
c <- Map Text Context -> [Context]
forall k a. Map k a -> [a]
M.elems (Syntax -> Map Text Context
sContexts Syntax
s)
, IncludeRules (lang :: Text
lang, _) <- (Rule -> Matcher) -> [Rule] -> [Matcher]
forall a b. (a -> b) -> [a] -> [b]
map Rule -> Matcher
rMatcher (Context -> [Rule]
cRules Context
c)
, Bool -> Bool
not (Text
lang Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
syntaxNames)]
where syntaxNames :: Set Text
syntaxNames = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (Syntax -> Text) -> [Syntax] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Syntax -> Text
sName [Syntax]
syns
ordNub :: (Ord a) => [a] -> [a]
ordNub :: [a] -> [a]
ordNub l :: [a]
l = Set a -> [a] -> [a]
forall a. Ord a => Set a -> [a] -> [a]
go Set a
forall a. Set a
Set.empty [a]
l
where
go :: Set a -> [a] -> [a]
go _ [] = []
go s :: Set a
s (x :: a
x:xs :: [a]
xs) = if a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s then Set a -> [a] -> [a]
go Set a
s [a]
xs
else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
s) [a]
xs
standardDelims :: Set.Set Char
standardDelims :: Set Char
standardDelims = [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList " \n\t.():!+,-<=>%&*/;?[]^{|}~\\"
defaultKeywordAttr :: KeywordAttr
defaultKeywordAttr :: KeywordAttr
defaultKeywordAttr = $WKeywordAttr :: Bool -> Set Char -> KeywordAttr
KeywordAttr { keywordCaseSensitive :: Bool
keywordCaseSensitive = Bool
True
, keywordDelims :: Set Char
keywordDelims = Set Char
standardDelims }
vBool :: Bool -> Text -> Bool
vBool :: Bool -> Text -> Bool
vBool defaultVal :: Bool
defaultVal value :: Text
value = case Text
value of
"true" -> Bool
True
"yes" -> Bool
True
"1" -> Bool
True
"false" -> Bool
False
"no" -> Bool
False
"0" -> Bool
False
_ -> Bool
defaultVal
parseSyntaxDefinition :: FilePath -> IO (Either String Syntax)
parseSyntaxDefinition :: [Char] -> IO (Either [Char] Syntax)
parseSyntaxDefinition fp :: [Char]
fp = do
ByteString
bs <- [Char] -> IO ByteString
BL.readFile [Char]
fp
case ParseSettings -> Text -> Either SomeException Document
parseText ParseSettings
forall a. Default a => a
def (ByteString -> Text
toTextLazy ByteString
bs) of
Left e :: SomeException
e -> Either [Char] Syntax -> IO (Either [Char] Syntax)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Syntax -> IO (Either [Char] Syntax))
-> Either [Char] Syntax -> IO (Either [Char] Syntax)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] Syntax
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Syntax) -> [Char] -> Either [Char] Syntax
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall e. Exception e => e -> [Char]
E.displayException SomeException
e
Right doc :: Document
doc -> ExceptT [Char] IO Syntax -> IO (Either [Char] Syntax)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ([Char] -> Document -> ExceptT [Char] IO Syntax
forall (m :: * -> *).
Monad m =>
[Char] -> Document -> ExceptT [Char] m Syntax
documentToSyntax [Char]
fp Document
doc)
where
toTextLazy :: ByteString -> Text
toTextLazy = ByteString -> Text
TLE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
filterCRs (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropBOM
dropBOM :: ByteString -> ByteString
dropBOM bs :: ByteString
bs =
if "\xEF\xBB\xBF" ByteString -> ByteString -> Bool
`BL.isPrefixOf` ByteString
bs
then Int64 -> ByteString -> ByteString
BL.drop 3 ByteString
bs
else ByteString
bs
filterCRs :: ByteString -> ByteString
filterCRs = (Char -> Bool) -> ByteString -> ByteString
BL.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='\r')
parseSyntaxDefinitionFromText ::
FilePath -> TL.Text -> Either String Syntax
parseSyntaxDefinitionFromText :: [Char] -> Text -> Either [Char] Syntax
parseSyntaxDefinitionFromText fp :: [Char]
fp xml :: Text
xml =
case ParseSettings -> Text -> Either SomeException Document
parseText ParseSettings
forall a. Default a => a
def Text
xml of
Left e :: SomeException
e -> [Char] -> Either [Char] Syntax
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Syntax) -> [Char] -> Either [Char] Syntax
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall e. Exception e => e -> [Char]
E.displayException SomeException
e
Right doc :: Document
doc -> Identity (Either [Char] Syntax) -> Either [Char] Syntax
forall a. Identity a -> a
runIdentity (Identity (Either [Char] Syntax) -> Either [Char] Syntax)
-> Identity (Either [Char] Syntax) -> Either [Char] Syntax
forall a b. (a -> b) -> a -> b
$ ExceptT [Char] Identity Syntax -> Identity (Either [Char] Syntax)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] Identity Syntax -> Identity (Either [Char] Syntax))
-> ExceptT [Char] Identity Syntax
-> Identity (Either [Char] Syntax)
forall a b. (a -> b) -> a -> b
$ [Char] -> Document -> ExceptT [Char] Identity Syntax
forall (m :: * -> *).
Monad m =>
[Char] -> Document -> ExceptT [Char] m Syntax
documentToSyntax [Char]
fp Document
doc
resolveKeywords :: SyntaxMap -> Syntax -> Syntax
resolveKeywords :: SyntaxMap -> Syntax -> Syntax
resolveKeywords sm :: SyntaxMap
sm = Syntax -> Syntax
goSyntax
where
goSyntax :: Syntax -> Syntax
goSyntax syntax :: Syntax
syntax = Syntax
syntax{ sContexts :: Map Text Context
sContexts = (Context -> Context) -> Map Text Context -> Map Text Context
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Map Text [ListItem] -> Context -> Context
forall (t :: * -> *).
Foldable t =>
Map Text (t ListItem) -> Context -> Context
goContext (Syntax -> Map Text [ListItem]
sLists Syntax
syntax))
(Syntax -> Map Text Context
sContexts Syntax
syntax) }
goContext :: Map Text (t ListItem) -> Context -> Context
goContext lists :: Map Text (t ListItem)
lists context :: Context
context = Context
context{ cRules :: [Rule]
cRules = (Rule -> Rule) -> [Rule] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
map (Map Text (t ListItem) -> Rule -> Rule
forall (t :: * -> *).
Foldable t =>
Map Text (t ListItem) -> Rule -> Rule
goRule Map Text (t ListItem)
lists)
(Context -> [Rule]
cRules Context
context) }
goRule :: Map Text (t ListItem) -> Rule -> Rule
goRule lists :: Map Text (t ListItem)
lists rule :: Rule
rule =
case Rule -> Matcher
rMatcher Rule
rule of
Keyword kwattr :: KeywordAttr
kwattr (Left listname :: Text
listname) ->
case Text -> Map Text (t ListItem) -> Maybe (t ListItem)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
listname Map Text (t ListItem)
lists of
Nothing -> Rule
rule
Just lst :: t ListItem
lst -> Rule
rule{ rMatcher :: Matcher
rMatcher =
KeywordAttr -> Either Text (WordSet Text) -> Matcher
Keyword KeywordAttr
kwattr (WordSet Text -> Either Text (WordSet Text)
forall a b. b -> Either a b
Right (Bool -> [Text] -> WordSet Text
forall a. (FoldCase a, Ord a) => Bool -> [a] -> WordSet a
makeWordSet (KeywordAttr -> Bool
keywordCaseSensitive KeywordAttr
kwattr)
((ListItem -> [Text] -> [Text]) -> [Text] -> t ListItem -> [Text]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ListItem -> [Text] -> [Text]
goItem [] t ListItem
lst))) }
_ -> Rule
rule
goItem :: ListItem -> [Text] -> [Text]
goItem (Item t :: Text
t) ts :: [Text]
ts = Text
tText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ts
goItem (IncludeList (syntaxname :: Text
syntaxname,listname :: Text
listname)) ts :: [Text]
ts =
case Text -> SyntaxMap -> Maybe Syntax
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
syntaxname SyntaxMap
sm Maybe Syntax -> (Syntax -> Maybe [ListItem]) -> Maybe [ListItem]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Map Text [ListItem] -> Maybe [ListItem]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
listname (Map Text [ListItem] -> Maybe [ListItem])
-> (Syntax -> Map Text [ListItem]) -> Syntax -> Maybe [ListItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Syntax -> Map Text [ListItem]
sLists of
Nothing -> [Text]
ts
Just lst :: [ListItem]
lst -> (ListItem -> [Text] -> [Text]) -> [Text] -> [ListItem] -> [Text]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ListItem -> [Text] -> [Text]
goItem [Text]
ts [ListItem]
lst
documentToSyntax :: Monad m
=> FilePath
-> Document
-> ExceptT String m Syntax
documentToSyntax :: [Char] -> Document -> ExceptT [Char] m Syntax
documentToSyntax fp :: [Char]
fp Document{ documentRoot :: Document -> Element
documentRoot = Element
rootEl } = do
Bool -> ExceptT [Char] m () -> ExceptT [Char] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Element -> Name
elementName Element
rootEl Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== "language") (ExceptT [Char] m () -> ExceptT [Char] m ())
-> ExceptT [Char] m () -> ExceptT [Char] m ()
forall a b. (a -> b) -> a -> b
$
[Char] -> ExceptT [Char] m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "Root element is not language"
let filename :: [Char]
filename = [Char] -> [Char]
takeFileName [Char]
fp
let casesensitive :: Bool
casesensitive = Bool -> Text -> Bool
vBool Bool
True (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "casesensitive" Element
rootEl
Element
hlEl <- case [Char] -> Element -> [Element]
getElementsNamed "highlighting" Element
rootEl of
[] -> [Char] -> ExceptT [Char] m Element
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "No highlighting element"
(hl :: Element
hl:_) -> Element -> ExceptT [Char] m Element
forall (m :: * -> *) a. Monad m => a -> m a
return Element
hl
Map Text [ListItem]
lists <- [(Text, [ListItem])] -> Map Text [ListItem]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, [ListItem])] -> Map Text [ListItem])
-> ExceptT [Char] m [(Text, [ListItem])]
-> ExceptT [Char] m (Map Text [ListItem])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> ExceptT [Char] m (Text, [ListItem]))
-> [Element] -> ExceptT [Char] m [(Text, [ListItem])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> ExceptT [Char] m (Text, [ListItem])
forall (m :: * -> *).
Monad m =>
Element -> ExceptT [Char] m (Text, [ListItem])
getList ([Char] -> Element -> [Element]
getElementsNamed "list" Element
hlEl)
let itemDatas :: ItemData
itemDatas = Element -> ItemData
getItemData Element
hlEl
let defKeywordAttr :: KeywordAttr
defKeywordAttr = Element -> KeywordAttr
getKeywordAttrs Element
rootEl
let contextEls :: [Element]
contextEls = [Char] -> Element -> [Element]
getElementsNamed "contexts" Element
hlEl [Element] -> (Element -> [Element]) -> [Element]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
[Char] -> Element -> [Element]
getElementsNamed "context"
let syntaxname :: Text
syntaxname = [Char] -> Element -> Text
getAttrValue "name" Element
rootEl
[Context]
contexts <- (Element -> ExceptT [Char] m Context)
-> [Element] -> ExceptT [Char] m [Context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(Bool
-> Text
-> ItemData
-> Map Text [ListItem]
-> KeywordAttr
-> Element
-> ExceptT [Char] m Context
forall (m :: * -> *).
Monad m =>
Bool
-> Text
-> ItemData
-> Map Text [ListItem]
-> KeywordAttr
-> Element
-> ExceptT [Char] m Context
getContext Bool
casesensitive Text
syntaxname ItemData
itemDatas Map Text [ListItem]
lists KeywordAttr
defKeywordAttr)
[Element]
contextEls
Text
startingContext <- case [Context]
contexts of
(c :: Context
c:_) -> Text -> ExceptT [Char] m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExceptT [Char] m Text) -> Text -> ExceptT [Char] m Text
forall a b. (a -> b) -> a -> b
$ Context -> Text
cName Context
c
[] -> [Char] -> ExceptT [Char] m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "No contexts"
Syntax -> ExceptT [Char] m Syntax
forall (m :: * -> *) a. Monad m => a -> m a
return $WSyntax :: Text
-> [Char]
-> Text
-> Map Text [ListItem]
-> Map Text Context
-> Text
-> Text
-> Text
-> [[Char]]
-> Text
-> Syntax
Syntax{
sName :: Text
sName = [Char] -> Element -> Text
getAttrValue "name" Element
rootEl
, sFilename :: [Char]
sFilename = [Char]
filename
, sShortname :: Text
sShortname = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
pathToLangName [Char]
filename
, sAuthor :: Text
sAuthor = [Char] -> Element -> Text
getAttrValue "author" Element
rootEl
, sVersion :: Text
sVersion = [Char] -> Element -> Text
getAttrValue "version" Element
rootEl
, sLicense :: Text
sLicense = [Char] -> Element -> Text
getAttrValue "license" Element
rootEl
, sExtensions :: [[Char]]
sExtensions = [Char] -> [[Char]]
words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ';' then ' ' else Char
c)
([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack
(Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "extensions" Element
rootEl
, sLists :: Map Text [ListItem]
sLists = Map Text [ListItem]
lists
, sContexts :: Map Text Context
sContexts = [(Text, Context)] -> Map Text Context
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[(Context -> Text
cName Context
c, Context
c) | Context
c <- [Context]
contexts]
, sStartingContext :: Text
sStartingContext = Text
startingContext
}
elementNamed :: String -> Node -> Bool
elementNamed :: [Char] -> Node -> Bool
elementNamed name :: [Char]
name (NodeElement el :: Element
el) = Element -> Name
elementName Element
el Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Name
forall a. IsString a => [Char] -> a
String.fromString [Char]
name
elementNamed _ _ = Bool
False
getElementsNamed :: String -> Element -> [Element]
getElementsNamed :: [Char] -> Element -> [Element]
getElementsNamed name :: [Char]
name node :: Element
node =
[Element
el | NodeElement el :: Element
el <- (Node -> Bool) -> [Node] -> [Node]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> Node -> Bool
elementNamed [Char]
name) (Element -> [Node]
elementNodes Element
node)]
getAttrValue :: String -> Element -> Text
getAttrValue :: [Char] -> Element -> Text
getAttrValue key :: [Char]
key el :: Element
el = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ([Char] -> Name
forall a. IsString a => [Char] -> a
String.fromString [Char]
key)
(Map Name Text -> Maybe Text) -> Map Name Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Element -> Map Name Text
elementAttributes Element
el
getTextContent :: Element -> Text
getTextContent :: Element -> Text
getTextContent el :: Element
el =
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
t | NodeContent t :: Text
t <- Element -> [Node]
elementNodes Element
el]
getList :: Monad m => Element -> ExceptT String m (Text, [ListItem])
getList :: Element -> ExceptT [Char] m (Text, [ListItem])
getList el :: Element
el = do
case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "name" (Element -> Map Name Text
elementAttributes Element
el) of
Nothing -> [Char] -> ExceptT [Char] m (Text, [ListItem])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError "No name attribute on list"
Just name :: Text
name -> (Text
name,) ([ListItem] -> (Text, [ListItem]))
-> ExceptT [Char] m [ListItem]
-> ExceptT [Char] m (Text, [ListItem])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Element -> ExceptT [Char] m ListItem)
-> [Element] -> ExceptT [Char] m [ListItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> ExceptT [Char] m ListItem
forall (m :: * -> *). MonadError [Char] m => Element -> m ListItem
toListItem [Element
el' | NodeElement el' :: Element
el' <- Element -> [Node]
elementNodes Element
el]
where
toListItem :: Element -> m ListItem
toListItem el' :: Element
el' = case Element -> Name
elementName Element
el' of
"item" -> ListItem -> m ListItem
forall (m :: * -> *) a. Monad m => a -> m a
return (ListItem -> m ListItem) -> ListItem -> m ListItem
forall a b. (a -> b) -> a -> b
$ Text -> ListItem
Item (Text -> ListItem) -> Text -> ListItem
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
getTextContent Element
el'
"include" -> do
let (syntaxname :: Text
syntaxname, listname :: Text
listname) =
Text -> (Text, Text)
splitContext (Element -> Text
getTextContent Element
el')
ListItem -> m ListItem
forall (m :: * -> *) a. Monad m => a -> m a
return (ListItem -> m ListItem) -> ListItem -> m ListItem
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> ListItem
IncludeList (Text
syntaxname, Text
listname)
x :: Name
x -> [Char] -> m ListItem
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> m ListItem) -> [Char] -> m ListItem
forall a b. (a -> b) -> a -> b
$ "Unknown element " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
forall a. Show a => a -> [Char]
show Name
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
" in list"
splitContext :: Text -> (Text, Text)
splitContext :: Text -> (Text, Text)
splitContext t :: Text
t =
case Text -> Text -> (Text, Text)
T.breakOn "##" (Text -> Text
T.strip Text
t) of
(x :: Text
x, y :: Text
y) | Text -> Bool
T.null Text
y -> ("", Text
x)
| Bool
otherwise -> (Int -> Text -> Text
T.drop 2 Text
y, Text
x)
getParser :: Monad m
=> Bool -> Text -> ItemData -> M.Map Text [ListItem] -> KeywordAttr
-> Text -> Element -> ExceptT String m Rule
getParser :: Bool
-> Text
-> ItemData
-> Map Text [ListItem]
-> KeywordAttr
-> Text
-> Element
-> ExceptT [Char] m Rule
getParser casesensitive :: Bool
casesensitive syntaxname :: Text
syntaxname itemdatas :: ItemData
itemdatas lists :: Map Text [ListItem]
lists kwattr :: KeywordAttr
kwattr cattr :: Text
cattr el :: Element
el = do
let name :: Text
name = Name -> Text
nameLocalName (Name -> Text) -> (Element -> Name) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$ Element
el
let attribute :: Text
attribute = [Char] -> Element -> Text
getAttrValue "attribute" Element
el
let context :: Text
context = [Char] -> Element -> Text
getAttrValue "context" Element
el
let char0 :: Char
char0 = Text -> Char
readChar (Text -> Char) -> Text -> Char
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "char" Element
el
let char1 :: Char
char1 = Text -> Char
readChar (Text -> Char) -> Text -> Char
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "char1" Element
el
let str' :: Text
str' = [Char] -> Element -> Text
getAttrValue "String" Element
el
let insensitive :: Bool
insensitive = Bool -> Text -> Bool
vBool (Bool -> Bool
not Bool
casesensitive) (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "insensitive" Element
el
let includeAttrib :: Bool
includeAttrib = Bool -> Text -> Bool
vBool Bool
False (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "includeAttrib" Element
el
let lookahead :: Bool
lookahead = Bool -> Text -> Bool
vBool Bool
False (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "lookAhead" Element
el
let firstNonSpace :: Bool
firstNonSpace = Bool -> Text -> Bool
vBool Bool
False (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "firstNonSpace" Element
el
let column' :: Text
column' = [Char] -> Element -> Text
getAttrValue "column" Element
el
let dynamic :: Bool
dynamic = Bool -> Text -> Bool
vBool Bool
False (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "dynamic" Element
el
[Rule]
children <- (Element -> ExceptT [Char] m Rule)
-> [Element] -> ExceptT [Char] m [Rule]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Text
-> ItemData
-> Map Text [ListItem]
-> KeywordAttr
-> Text
-> Element
-> ExceptT [Char] m Rule
forall (m :: * -> *).
Monad m =>
Bool
-> Text
-> ItemData
-> Map Text [ListItem]
-> KeywordAttr
-> Text
-> Element
-> ExceptT [Char] m Rule
getParser Bool
casesensitive
Text
syntaxname ItemData
itemdatas Map Text [ListItem]
lists KeywordAttr
kwattr Text
attribute)
[Element
e | NodeElement e :: Element
e <- Element -> [Node]
elementNodes Element
el ]
let tildeRegex :: Bool
tildeRegex = Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "RegExpr" Bool -> Bool -> Bool
&& Int -> Text -> Text
T.take 1 Text
str' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "^"
let str :: Text
str = if Bool
tildeRegex then Int -> Text -> Text
T.drop 1 Text
str' else Text
str'
let column :: Maybe Int
column = if Bool
tildeRegex
then Int -> Maybe Int
forall a. a -> Maybe a
Just (0 :: Int)
else ([Char] -> Maybe Int)
-> ((Int, Text) -> Maybe Int)
-> Either [Char] (Int, Text)
-> Maybe Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\_ -> Maybe Int
forall a. Maybe a
Nothing) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ((Int, Text) -> Int) -> (Int, Text) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst) (Either [Char] (Int, Text) -> Maybe Int)
-> Either [Char] (Int, Text) -> Maybe Int
forall a b. (a -> b) -> a -> b
$
Reader Int
forall a. Integral a => Reader a
TR.decimal Text
column'
let re :: Matcher
re = RE -> Matcher
RegExpr RE :: ByteString -> Bool -> RE
RE{ reString :: ByteString
reString = Text -> ByteString
TE.encodeUtf8 Text
str
, reCaseSensitive :: Bool
reCaseSensitive = Bool -> Bool
not Bool
insensitive }
let (incsyntax :: Text
incsyntax, inccontext :: Text
inccontext) =
case Text -> Text -> (Text, Text)
T.breakOn "##" Text
context of
(_,x :: Text
x) | Text -> Bool
T.null Text
x -> (Text
syntaxname, Text
context)
(cont :: Text
cont, lang :: Text
lang) -> (Int -> Text -> Text
T.drop 2 Text
lang, Text
cont)
Matcher
matcher <- case Text
name of
"DetectChar" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Char -> Matcher
DetectChar Char
char0
"Detect2Chars" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Matcher
Detect2Chars Char
char0 Char
char1
"AnyChar" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Set Char -> Matcher
AnyChar (Set Char -> Matcher) -> Set Char -> Matcher
forall a b. (a -> b) -> a -> b
$ [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList ([Char] -> Set Char) -> [Char] -> Set Char
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
str
"RangeDetect" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Matcher
RangeDetect Char
char0 Char
char1
"StringDetect" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Text -> Matcher
StringDetect Text
str
"WordDetect" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Text -> Matcher
WordDetect Text
str
"RegExpr" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
re
"keyword" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ KeywordAttr -> Either Text (WordSet Text) -> Matcher
Keyword KeywordAttr
kwattr (Text -> Either Text (WordSet Text)
forall a b. a -> Either a b
Left Text
str)
"Int" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
Int
"Float" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
Float
"HlCOct" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
HlCOct
"HlCHex" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
HlCHex
"HlCStringChar" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
HlCStringChar
"HlCChar" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
HlCChar
"LineContinue" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
LineContinue
"IncludeRules" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$
(Text, Text) -> Matcher
IncludeRules (Text
incsyntax, Text
inccontext)
"DetectSpaces" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
DetectSpaces
"DetectIdentifier" -> Matcher -> ExceptT [Char] m Matcher
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ExceptT [Char] m Matcher)
-> Matcher -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ Matcher
DetectIdentifier
_ -> [Char] -> ExceptT [Char] m Matcher
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> ExceptT [Char] m Matcher)
-> [Char] -> ExceptT [Char] m Matcher
forall a b. (a -> b) -> a -> b
$ "Unknown element " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
name
let contextSwitch :: [ContextSwitch]
contextSwitch = if Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "IncludeRules"
then []
else Text -> Text -> [ContextSwitch]
parseContextSwitch Text
incsyntax Text
inccontext
Rule -> ExceptT [Char] m Rule
forall (m :: * -> *) a. Monad m => a -> m a
return (Rule -> ExceptT [Char] m Rule) -> Rule -> ExceptT [Char] m Rule
forall a b. (a -> b) -> a -> b
$ $WRule :: Matcher
-> TokenType
-> Bool
-> Bool
-> Bool
-> [Rule]
-> Bool
-> Bool
-> Maybe Int
-> [ContextSwitch]
-> Rule
Rule{ rMatcher :: Matcher
rMatcher = Matcher
matcher
, rAttribute :: TokenType
rAttribute = TokenType -> Maybe TokenType -> TokenType
forall a. a -> Maybe a -> a
fromMaybe TokenType
NormalTok (Maybe TokenType -> TokenType) -> Maybe TokenType -> TokenType
forall a b. (a -> b) -> a -> b
$
if Text -> Bool
T.null Text
attribute
then Text -> ItemData -> Maybe TokenType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
cattr ItemData
itemdatas
else Text -> ItemData -> Maybe TokenType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
attribute ItemData
itemdatas
, rIncludeAttribute :: Bool
rIncludeAttribute = Bool
includeAttrib
, rDynamic :: Bool
rDynamic = Bool
dynamic
, rCaseSensitive :: Bool
rCaseSensitive = Bool -> Bool
not Bool
insensitive
, rChildren :: [Rule]
rChildren = [Rule]
children
, rContextSwitch :: [ContextSwitch]
rContextSwitch = [ContextSwitch]
contextSwitch
, rLookahead :: Bool
rLookahead = Bool
lookahead
, rFirstNonspace :: Bool
rFirstNonspace = Bool
firstNonSpace
, rColumn :: Maybe Int
rColumn = Maybe Int
column
}
getContext :: Monad m
=> Bool
-> Text
-> ItemData
-> M.Map Text [ListItem]
-> KeywordAttr
-> Element
-> ExceptT String m Context
getContext :: Bool
-> Text
-> ItemData
-> Map Text [ListItem]
-> KeywordAttr
-> Element
-> ExceptT [Char] m Context
getContext casesensitive :: Bool
casesensitive syntaxname :: Text
syntaxname itemDatas :: ItemData
itemDatas lists :: Map Text [ListItem]
lists kwattr :: KeywordAttr
kwattr el :: Element
el = do
let name :: Text
name = [Char] -> Element -> Text
getAttrValue "name" Element
el
let attribute :: Text
attribute = [Char] -> Element -> Text
getAttrValue "attribute" Element
el
let lineEmptyContext :: Text
lineEmptyContext = [Char] -> Element -> Text
getAttrValue "lineEmptyContext" Element
el
let lineEndContext :: Text
lineEndContext = [Char] -> Element -> Text
getAttrValue "lineEndContext" Element
el
let lineBeginContext :: Text
lineBeginContext = [Char] -> Element -> Text
getAttrValue "lineBeginContext" Element
el
let fallthrough :: Bool
fallthrough = Bool -> Text -> Bool
vBool Bool
False (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "fallthrough" Element
el
let fallthroughContext :: Text
fallthroughContext = [Char] -> Element -> Text
getAttrValue "fallthroughContext" Element
el
let dynamic :: Bool
dynamic = Bool -> Text -> Bool
vBool Bool
False (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "dynamic" Element
el
[Rule]
parsers <- (Element -> ExceptT [Char] m Rule)
-> [Element] -> ExceptT [Char] m [Rule]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Text
-> ItemData
-> Map Text [ListItem]
-> KeywordAttr
-> Text
-> Element
-> ExceptT [Char] m Rule
forall (m :: * -> *).
Monad m =>
Bool
-> Text
-> ItemData
-> Map Text [ListItem]
-> KeywordAttr
-> Text
-> Element
-> ExceptT [Char] m Rule
getParser Bool
casesensitive
Text
syntaxname ItemData
itemDatas Map Text [ListItem]
lists KeywordAttr
kwattr Text
attribute)
[Element
e | NodeElement e :: Element
e <- Element -> [Node]
elementNodes Element
el ]
Context -> ExceptT [Char] m Context
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> ExceptT [Char] m Context)
-> Context -> ExceptT [Char] m Context
forall a b. (a -> b) -> a -> b
$ $WContext :: Text
-> Text
-> [Rule]
-> TokenType
-> [ContextSwitch]
-> [ContextSwitch]
-> [ContextSwitch]
-> Bool
-> [ContextSwitch]
-> Bool
-> Context
Context {
cName :: Text
cName = Text
name
, cSyntax :: Text
cSyntax = Text
syntaxname
, cRules :: [Rule]
cRules = [Rule]
parsers
, cAttribute :: TokenType
cAttribute = TokenType -> Maybe TokenType -> TokenType
forall a. a -> Maybe a -> a
fromMaybe TokenType
NormalTok (Maybe TokenType -> TokenType) -> Maybe TokenType -> TokenType
forall a b. (a -> b) -> a -> b
$ Text -> ItemData -> Maybe TokenType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
attribute ItemData
itemDatas
, cLineEmptyContext :: [ContextSwitch]
cLineEmptyContext =
Text -> Text -> [ContextSwitch]
parseContextSwitch Text
syntaxname Text
lineEmptyContext
, cLineEndContext :: [ContextSwitch]
cLineEndContext =
Text -> Text -> [ContextSwitch]
parseContextSwitch Text
syntaxname Text
lineEndContext
, cLineBeginContext :: [ContextSwitch]
cLineBeginContext =
Text -> Text -> [ContextSwitch]
parseContextSwitch Text
syntaxname Text
lineBeginContext
, cFallthrough :: Bool
cFallthrough = Bool
fallthrough
, cFallthroughContext :: [ContextSwitch]
cFallthroughContext =
Text -> Text -> [ContextSwitch]
parseContextSwitch Text
syntaxname Text
fallthroughContext
, cDynamic :: Bool
cDynamic = Bool
dynamic
}
getItemData :: Element -> ItemData
getItemData :: Element -> ItemData
getItemData el :: Element
el = [(Text, Text)] -> ItemData
toItemDataTable ([(Text, Text)] -> ItemData) -> [(Text, Text)] -> ItemData
forall a b. (a -> b) -> a -> b
$
[([Char] -> Element -> Text
getAttrValue "name" Element
e, [Char] -> Element -> Text
getAttrValue "defStyleNum" Element
e)
| Element
e <- ([Char] -> Element -> [Element]
getElementsNamed "itemDatas" Element
el [Element] -> (Element -> [Element]) -> [Element]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Element -> [Element]
getElementsNamed "itemData")
]
getKeywordAttrs :: Element -> KeywordAttr
getKeywordAttrs :: Element -> KeywordAttr
getKeywordAttrs el :: Element
el =
case ([Char] -> Element -> [Element]
getElementsNamed "general" Element
el [Element] -> (Element -> [Element]) -> [Element]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Element -> [Element]
getElementsNamed "keywords") of
[] -> KeywordAttr
defaultKeywordAttr
(x :: Element
x:_) ->
let weakDelim :: [Char]
weakDelim = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "weakDeliminator" Element
x
additionalDelim :: [Char]
additionalDelim = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "additionalDeliminator" Element
x
in $WKeywordAttr :: Bool -> Set Char -> KeywordAttr
KeywordAttr { keywordCaseSensitive :: Bool
keywordCaseSensitive =
Bool -> Text -> Bool
vBool Bool
True (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Element -> Text
getAttrValue "casesensitive" Element
x
, keywordDelims :: Set Char
keywordDelims = Set Char -> Set Char -> Set Char
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Char
standardDelims
([Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList [Char]
additionalDelim)
Set Char -> Set Char -> Set Char
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList [Char]
weakDelim }
parseContextSwitch :: Text -> Text -> [ContextSwitch]
parseContextSwitch :: Text -> Text -> [ContextSwitch]
parseContextSwitch syntaxname :: Text
syntaxname t :: Text
t =
if Text -> Bool
T.null Text
t Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "#stay"
then []
else
case Text -> Text -> Maybe Text
T.stripPrefix "#pop" Text
t of
Just rest :: Text
rest -> ContextSwitch
Pop ContextSwitch -> [ContextSwitch] -> [ContextSwitch]
forall a. a -> [a] -> [a]
: Text -> Text -> [ContextSwitch]
parseContextSwitch Text
syntaxname Text
rest
Nothing ->
let (othersyntax :: Text
othersyntax, contextname :: Text
contextname) =
Text -> (Text, Text)
splitContext ((Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='!') Text
t)
syntaxname' :: Text
syntaxname' = if Text -> Bool
T.null Text
othersyntax
then Text
syntaxname
else Text
othersyntax
in [(Text, Text) -> ContextSwitch
Push (Text
syntaxname', Text
contextname)]
type ItemData = M.Map Text TokenType
toItemDataTable :: [(Text, Text)] -> ItemData
toItemDataTable :: [(Text, Text)] -> ItemData
toItemDataTable = [(Text, TokenType)] -> ItemData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, TokenType)] -> ItemData)
-> ([(Text, Text)] -> [(Text, TokenType)])
-> [(Text, Text)]
-> ItemData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (Text, TokenType))
-> [(Text, Text)] -> [(Text, TokenType)]
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: Text
s,t :: Text
t) -> (Text
s, Text -> TokenType
toTokenType Text
t))
toTokenType :: Text -> TokenType
toTokenType :: Text -> TokenType
toTokenType t :: Text
t =
case Text
t of
"dsNormal" -> TokenType
NormalTok
"dsKeyword" -> TokenType
KeywordTok
"dsDataType" -> TokenType
DataTypeTok
"dsDecVal" -> TokenType
DecValTok
"dsBaseN" -> TokenType
BaseNTok
"dsFloat" -> TokenType
FloatTok
"dsConstant" -> TokenType
ConstantTok
"dsChar" -> TokenType
CharTok
"dsSpecialChar" -> TokenType
SpecialCharTok
"dsString" -> TokenType
StringTok
"dsVerbatimString" -> TokenType
VerbatimStringTok
"dsSpecialString" -> TokenType
SpecialStringTok
"dsImport" -> TokenType
ImportTok
"dsComment" -> TokenType
CommentTok
"dsDocumentation" -> TokenType
DocumentationTok
"dsAnnotation" -> TokenType
AnnotationTok
"dsCommentVar" -> TokenType
CommentVarTok
"dsOthers" -> TokenType
OtherTok
"dsFunction" -> TokenType
FunctionTok
"dsVariable" -> TokenType
VariableTok
"dsControlFlow" -> TokenType
ControlFlowTok
"dsOperator" -> TokenType
OperatorTok
"dsBuiltIn" -> TokenType
BuiltInTok
"dsExtension" -> TokenType
ExtensionTok
"dsPreprocessor" -> TokenType
PreprocessorTok
"dsAttribute" -> TokenType
AttributeTok
"dsRegionMarker" -> TokenType
RegionMarkerTok
"dsInformation" -> TokenType
InformationTok
"dsWarning" -> TokenType
WarningTok
"dsAlert" -> TokenType
AlertTok
"dsError" -> TokenType
ErrorTok
_ -> TokenType
NormalTok
readChar :: Text -> Char
readChar :: Text -> Char
readChar t :: Text
t = case Text -> [Char]
T.unpack Text
t of
[c :: Char
c] -> Char
c
s :: [Char]
s -> Char -> [Char] -> Char
forall a. Read a => a -> [Char] -> a
readDef '\xffff' ([Char] -> Char) -> [Char] -> Char
forall a b. (a -> b) -> a -> b
$ "'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "'"
pathToLangName :: String -> String
pathToLangName :: [Char] -> [Char]
pathToLangName s :: [Char]
s = [Char] -> [Char]
capitalize ([Char] -> [Char]
camelize ([Char] -> [Char]
takeBaseName [Char]
s))
camelize :: String -> String
camelize :: [Char] -> [Char]
camelize (d :: Char
d:c :: Char
c:cs :: [Char]
cs) | Bool -> Bool
not (Char -> Bool
isAlphaNum Char
d) = Char -> Char
toUpper Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
camelize [Char]
cs
camelize (c :: Char
c:cs :: [Char]
cs) = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
camelize [Char]
cs
camelize [] = []
capitalize :: String -> String
capitalize :: [Char] -> [Char]
capitalize (c :: Char
c:cs :: [Char]
cs) = Char -> Char
toUpper Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs
capitalize [] = []