    {-# 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

    -- | Adds a syntax definition to a syntax map,
    -- replacing any existing definition with the same name.
    addSyntaxDefinition :: Syntax -> SyntaxMap -> SyntaxMap
    addSyntaxDefinition :: Syntax -> SyntaxMap -> SyntaxMap
    addSyntaxDefinition 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

    -- | Scan a list of 'Syntax's and make sure that
    -- `IncludeRules` never asks for a syntax not in this
    -- list.  Produces a list of pairs where the first
    -- element is the including syntax name and the second
    -- element is the (missing) included syntax name.
    -- This is intended for sanity checks to avoid run-time
    -- errors.
    missingIncludes :: [Syntax] -> [(Text, Text)]
    missingIncludes :: [Syntax] -> [(Text, Text)]
    missingIncludes [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 (Text
    lang, Text
    _) <- (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 :: forall a. Ord a => [a] -> [a]
    ordNub [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 Set a
    _ [] = []
        go Set a
    s (a
    x:[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 [Char]
    " \n\t.():!+,-<=>%&*/;?[]^{|}~\\"

    defaultKeywordAttr :: KeywordAttr
    defaultKeywordAttr :: KeywordAttr
    defaultKeywordAttr = KeywordAttr { keywordCaseSensitive :: Bool
    keywordCaseSensitive = Bool
    True
                                     , keywordDelims :: Set Char
    keywordDelims = Set Char
    standardDelims }

    vBool :: Bool -> Text -> Bool
    vBool :: Bool -> Text -> Bool
    vBool Bool
    defaultVal Text
    value = case Text
    value of
                               Text
    "true"  -> Bool
    True
                               Text
    "yes"   -> Bool
    True
                               Text
    "1"     -> Bool
    True
                               Text
    "false" -> Bool
    False
                               Text
    "no"    -> Bool
    False
                               Text
    "0"     -> Bool
    False
                               Text
    _       -> Bool
    defaultVal

    -- | Parses a file containing a Kate XML syntax definition
    -- into a 'Syntax' description.
    parseSyntaxDefinition :: FilePath -> IO (Either String Syntax)
    parseSyntaxDefinition :: [Char] -> IO (Either [Char] Syntax)
    parseSyntaxDefinition [Char]
    fp = do
      bs <- [Char] -> IO ByteString
    BL.readFile [Char]
    fp
      case parseText def (toTextLazy bs) of
        Left SomeException
    e    -> Either [Char] Syntax -> IO (Either [Char] Syntax)
    forall a. a -> IO a
    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 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 ByteString
    bs =
             if ByteString
    "\xEF\xBB\xBF" ByteString -> ByteString -> Bool
    `BL.isPrefixOf` ByteString
    bs
                then Int64 -> ByteString -> ByteString
    BL.drop Int64
    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
    /=Char
    '\r')

    parseSyntaxDefinitionFromText ::
      FilePath -> TL.Text -> Either String Syntax
    parseSyntaxDefinitionFromText :: [Char] -> Text -> Either [Char] Syntax
    parseSyntaxDefinitionFromText [Char]
    fp Text
    xml =
        case ParseSettings -> Text -> Either SomeException Document
    parseText ParseSettings
    forall a. Default a => a
    def Text
    xml of
          Left 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 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

    -- | Resolve Keyword matchers that refer to lists; following up
    -- include directives in the syntax map and producing WordSets.
    resolveKeywords :: SyntaxMap -> Syntax -> Syntax
    resolveKeywords :: SyntaxMap -> Syntax -> Syntax
    resolveKeywords SyntaxMap
    sm = Syntax -> Syntax
    goSyntax
     where
       goSyntax :: Syntax -> Syntax
    goSyntax Syntax
    syntax = Syntax
    syntax{ sContexts = M.map (goContext (sLists syntax))
                                                     (sContexts syntax) }
       goContext :: Map Text (t ListItem) -> Context -> Context
    goContext Map Text (t ListItem)
    lists Context
    context = Context
    context{ cRules = map (goRule lists)
                                                     (cRules context) }
       goRule :: Map Text (t ListItem) -> Rule -> Rule
    goRule Map Text (t ListItem)
    lists Rule
    rule =
         case Rule -> Matcher
    rMatcher Rule
    rule of
            Keyword KeywordAttr
    kwattr (Left 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
                Maybe (t ListItem)
    Nothing -> Rule
    rule
                Just t ListItem
    lst -> Rule
    rule{ rMatcher =
                 Keyword kwattr (Right (makeWordSet (keywordCaseSensitive kwattr)
                                          (foldr goItem [] lst))) }
            Matcher
    _ -> Rule
    rule

       goItem :: ListItem -> [Text] -> [Text]
    goItem (Item Text
    t) [Text]
    ts = Text
    tText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    ts
       goItem (IncludeList (Text
    syntaxname,Text
    listname)) [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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
    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
           Maybe [ListItem]
    Nothing -> [Text]
    ts
           Just [ListItem]
    lst -> (ListItem -> [Text] -> [Text]) -> [Text] -> [ListItem] -> [Text]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ListItem -> [Text] -> [Text]
    goItem [Text]
    ts [ListItem]
    lst

    -- | Parses an XML 'Document' as a 'Syntax' description.
    documentToSyntax :: Monad m
                     => FilePath -- ^ used for short name
                     -> Document
                     -> ExceptT String m Syntax
    documentToSyntax :: forall (m :: * -> *).
    Monad m =>
    [Char] -> Document -> ExceptT [Char] m Syntax
    documentToSyntax [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
    == Name
    "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 a. [Char] -> ExceptT [Char] m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError [Char]
    "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 [Char]
    "casesensitive" Element
    rootEl

      hlEl <- case [Char] -> Element -> [Element]
    getElementsNamed [Char]
    "highlighting" Element
    rootEl of
                []      -> [Char] -> ExceptT [Char] m Element
    forall a. [Char] -> ExceptT [Char] m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError [Char]
    "No highlighting element"
                (Element
    hl:[Element]
    _)  -> Element -> ExceptT [Char] m Element
    forall a. a -> ExceptT [Char] m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Element
    hl

      lists <- M.fromList <$> mapM getList (getElementsNamed "list" hlEl)

      let itemDatas = Element -> ItemData
    getItemData Element
    hlEl

      let defKeywordAttr = Element -> KeywordAttr
    getKeywordAttrs Element
    rootEl

      let contextEls = [Char] -> Element -> [Element]
    getElementsNamed [Char]
    "contexts" Element
    hlEl [Element] -> (Element -> [Element]) -> [Element]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       [Char] -> Element -> [Element]
    getElementsNamed [Char]
    "context"

      let syntaxname = [Char] -> Element -> Text
    getAttrValue [Char]
    "name" Element
    rootEl

      contexts <- mapM
        (getContext casesensitive syntaxname itemDatas lists defKeywordAttr)
        contextEls

      startingContext <- case contexts of
                           (Context
    c:[Context]
    _) -> Text -> ExceptT [Char] m Text
    forall a. a -> ExceptT [Char] m a
    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 a. [Char] -> ExceptT [Char] m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError [Char]
    "No contexts"

      return Syntax{
                 sName       = getAttrValue "name" rootEl
               , sFilename   = filename
               , sShortname  = T.pack $ pathToLangName filename
               , sAuthor     = getAttrValue "author" rootEl
               , sVersion    = getAttrValue "version" rootEl
               , sLicense    = getAttrValue "license" rootEl
               , sExtensions = words $ map (\Char
    c -> if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ';' then Char
    ' ' else Char
    c)
                                     $ T.unpack
                                     $ getAttrValue "extensions" rootEl
               , sLists      = lists
               , sContexts   = M.fromList
                      [(cName c, c) | c <- contexts]
               , sStartingContext = startingContext
               }

    elementNamed :: String -> Node -> Bool
    elementNamed :: [Char] -> Node -> Bool
    elementNamed [Char]
    name (NodeElement 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 [Char]
    _ Node
    _ = Bool
    False

    getElementsNamed :: String -> Element -> [Element]
    getElementsNamed :: [Char] -> Element -> [Element]
    getElementsNamed [Char]
    name Element
    node =
      [Element
    el | NodeElement 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 [Char]
    key 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 Element
    el =
      [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat [Text
    t | NodeContent Text
    t <- Element -> [Node]
    elementNodes Element
    el]

    getList :: Monad m => Element -> ExceptT String m (Text, [ListItem])
    getList :: forall (m :: * -> *).
    Monad m =>
    Element -> ExceptT [Char] m (Text, [ListItem])
    getList Element
    el = do
      case Name -> Map Name Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    "name" (Element -> Map Name Text
    elementAttributes Element
    el) of
        Maybe Text
    Nothing   -> [Char] -> ExceptT [Char] m (Text, [ListItem])
    forall a. [Char] -> ExceptT [Char] m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError [Char]
    "No name attribute on list"
        Just 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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Element -> ExceptT [Char] m ListItem
    forall {m :: * -> *}. MonadError [Char] m => Element -> m ListItem
    toListItem [Element
    el' | NodeElement Element
    el' <- Element -> [Node]
    elementNodes Element
    el]
     where
       toListItem :: Element -> m ListItem
    toListItem Element
    el' = case Element -> Name
    elementName Element
    el' of
                          Name
    "item"    -> ListItem -> m ListItem
    forall a. a -> m a
    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'
                          Name
    "include" -> do
                            let (Text
    syntaxname, Text
    listname) =
                                    Text -> (Text, Text)
    splitContext (Element -> Text
    getTextContent Element
    el')
                            ListItem -> m ListItem
    forall a. a -> m a
    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)
                          Name
    x -> [Char] -> m ListItem
    forall a. [Char] -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError ([Char] -> m ListItem) -> [Char] -> m ListItem
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "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]
    ++
                                            [Char]
    " in list"

    splitContext :: Text -> (Text, Text)
    splitContext :: Text -> (Text, Text)
    splitContext Text
    t =
      case HasCallStack => Text -> Text -> (Text, Text)
    Text -> Text -> (Text, Text)
    T.breakOn Text
    "##" (Text -> Text
    T.strip Text
    t) of
        (Text
    x, Text
    y) | Text -> Bool
    T.null Text
    y  -> (Text
    "", Text
    x)
               | Bool
    otherwise -> (Int -> Text -> Text
    T.drop Int
    2 Text
    y, Text
    x)

    getParser :: Monad m
              => Bool -> Text -> ItemData -> M.Map Text [ListItem] -> KeywordAttr
              -> Text -> Element -> ExceptT String m Rule
    getParser :: 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
    cattr 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 [Char]
    "attribute" Element
    el
      let context :: Text
    context = [Char] -> Element -> Text
    getAttrValue [Char]
    "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]
    "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 [Char]
    "char1" Element
    el
      let str' :: Text
    str' = [Char] -> Element -> Text
    getAttrValue [Char]
    "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 [Char]
    "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 [Char]
    "includeAttrib" Element
    el
      let weakDelim :: Set Char
    weakDelim = [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 -> [Char]) -> Text -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Element -> Text
    getAttrValue [Char]
    "weakDeliminator" 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 [Char]
    "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 [Char]
    "firstNonSpace" Element
    el
      let column' :: Text
    column' = [Char] -> Element -> Text
    getAttrValue [Char]
    "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 [Char]
    "dynamic" Element
    el
      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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 Element
    e <- Element -> [Node]
    elementNodes Element
    el ]
      let tildeRegex = Text
    name Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "RegExpr" Bool -> Bool -> Bool
    && Int -> Text -> Text
    T.take Int
    1 Text
    str' Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "^"
      let str = if Bool
    tildeRegex then Int -> Text -> Text
    T.drop Int
    1 Text
    str' else Text
    str'
      let column = if Bool
    tildeRegex
                      then Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int
    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 (\[Char]
    _ -> 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 = RE -> Matcher
    RegExpr RE{ reString :: ByteString
    reString = Text -> ByteString
    TE.encodeUtf8 Text
    str
                         , reCaseSensitive :: Bool
    reCaseSensitive = Bool -> Bool
    not Bool
    insensitive }
      let (incsyntax, inccontext) =
              case T.breakOn "##" context of
                    (Text
    _,Text
    x) | Text -> Bool
    T.null Text
    x -> (Text
    syntaxname, Text
    context)
                    (Text
    cont, Text
    lang)     -> (Int -> Text -> Text
    T.drop Int
    2 Text
    lang, Text
    cont)
      matcher <- case name of
                     Text
    "DetectChar" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "Detect2Chars" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "AnyChar" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "RangeDetect" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "StringDetect" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "WordDetect" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "RegExpr" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "keyword" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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)
                     Text
    "Int" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "Float" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "HlCOct" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "HlCHex" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "HlCStringChar" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "HlCChar" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "LineContinue" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "IncludeRules" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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)
                     Text
    "DetectSpaces" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    "DetectIdentifier" -> Matcher -> ExceptT [Char] m Matcher
    forall a. a -> ExceptT [Char] m a
    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
                     Text
    _ -> [Char] -> ExceptT [Char] m Matcher
    forall a. [Char] -> ExceptT [Char] m a
    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
    $ [Char]
    "Unknown element " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    T.unpack Text
    name

      let contextSwitch = if Text
    name Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "IncludeRules"
                             then []  -- is this right?
                             else Text -> Text -> [ContextSwitch]
    parseContextSwitch Text
    incsyntax Text
    inccontext
      return $ Rule{ rMatcher = matcher
                   , rAttribute = fromMaybe NormalTok $
                        if T.null attribute
                           then M.lookup cattr itemdatas
                           else M.lookup attribute itemdatas
                   , rIncludeAttribute = includeAttrib
                   , rWeakDeliminators = weakDelim
                   , rDynamic = dynamic
                   , rCaseSensitive = not insensitive
                   , rChildren = children
                   , rContextSwitch = contextSwitch
                   , rLookahead = lookahead
                   , rFirstNonspace = firstNonSpace
                   , rColumn = column
                   }

    getContext :: Monad m
               => Bool
               -> Text
               -> ItemData
               -> M.Map Text [ListItem]
               -> KeywordAttr
               -> Element
               -> ExceptT String m Context
    getContext :: 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
    kwattr Element
    el = do
      let name :: Text
    name = [Char] -> Element -> Text
    getAttrValue [Char]
    "name" Element
    el
      let attribute :: Text
    attribute = [Char] -> Element -> Text
    getAttrValue [Char]
    "attribute" Element
    el
      let lineEmptyContext :: Text
    lineEmptyContext = [Char] -> Element -> Text
    getAttrValue [Char]
    "lineEmptyContext" Element
    el
      let lineEndContext :: Text
    lineEndContext = [Char] -> Element -> Text
    getAttrValue [Char]
    "lineEndContext" Element
    el
      let lineBeginContext :: Text
    lineBeginContext = [Char] -> Element -> Text
    getAttrValue [Char]
    "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 [Char]
    "fallthrough" Element
    el
      let fallthroughContext :: Text
    fallthroughContext = [Char] -> Element -> Text
    getAttrValue [Char]
    "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 [Char]
    "dynamic" Element
    el

      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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 Element
    e <- Element -> [Node]
    elementNodes Element
    el ]

      return $ Context {
                cName = name
              , cSyntax = syntaxname
              , cRules = parsers
              , cAttribute = fromMaybe NormalTok $ M.lookup attribute itemDatas
              , cLineEmptyContext =
                   parseContextSwitch syntaxname lineEmptyContext
              , cLineEndContext =
                   parseContextSwitch syntaxname lineEndContext
              , cLineBeginContext =
                   parseContextSwitch syntaxname lineBeginContext
              , cFallthrough = fallthrough
              , cFallthroughContext =
                   parseContextSwitch syntaxname fallthroughContext
              , cDynamic = dynamic
              }

    getItemData :: Element -> ItemData
    getItemData :: Element -> ItemData
    getItemData Element
    el = [(Text, Text)] -> ItemData
    toItemDataTable ([(Text, Text)] -> ItemData) -> [(Text, Text)] -> ItemData
    forall a b. (a -> b) -> a -> b
    $
      [([Char] -> Element -> Text
    getAttrValue [Char]
    "name" Element
    e, [Char] -> Element -> Text
    getAttrValue [Char]
    "defStyleNum" Element
    e)
        | Element
    e <- ([Char] -> Element -> [Element]
    getElementsNamed [Char]
    "itemDatas" Element
    el [Element] -> (Element -> [Element]) -> [Element]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Char] -> Element -> [Element]
    getElementsNamed [Char]
    "itemData")
      ]

    getKeywordAttrs :: Element -> KeywordAttr
    getKeywordAttrs :: Element -> KeywordAttr
    getKeywordAttrs Element
    el =
      case ([Char] -> Element -> [Element]
    getElementsNamed [Char]
    "general" Element
    el [Element] -> (Element -> [Element]) -> [Element]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Char] -> Element -> [Element]
    getElementsNamed [Char]
    "keywords") of
         []    -> KeywordAttr
    defaultKeywordAttr
         (Element
    x:[Element]
    _) ->
           let weakDelim :: [Char]
    weakDelim = Text -> [Char]
    T.unpack (Text -> [Char]) -> Text -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Element -> Text
    getAttrValue [Char]
    "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 [Char]
    "additionalDeliminator" Element
    x
            in 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 [Char]
    "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 Text
    syntaxname Text
    t =
      if Text -> Bool
    T.null Text
    t Bool -> Bool -> Bool
    || Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "#stay"
         then []
         else
           case Text -> Text -> Maybe Text
    T.stripPrefix Text
    "#pop" Text
    t of
             Just Text
    rest -> ContextSwitch
    Pop ContextSwitch -> [ContextSwitch] -> [ContextSwitch]
    forall a. a -> [a] -> [a]
    : Text -> Text -> [ContextSwitch]
    parseContextSwitch Text
    syntaxname Text
    rest
             Maybe Text
    Nothing   ->
               let (Text
    othersyntax, Text
    contextname) =
                      Text -> (Text, Text)
    splitContext ((Char -> Bool) -> Text -> Text
    T.dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '!') 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 (\(Text
    s,Text
    t) -> (Text
    s, Text -> TokenType
    toTokenType Text
    t))

    toTokenType :: Text -> TokenType
    toTokenType :: Text -> TokenType
    toTokenType Text
    t =
      case Text
    t of
        Text
    "dsNormal"         -> TokenType
    NormalTok
        Text
    "dsKeyword"        -> TokenType
    KeywordTok
        Text
    "dsDataType"       -> TokenType
    DataTypeTok
        Text
    "dsDecVal"         -> TokenType
    DecValTok
        Text
    "dsBaseN"          -> TokenType
    BaseNTok
        Text
    "dsFloat"          -> TokenType
    FloatTok
        Text
    "dsConstant"       -> TokenType
    ConstantTok
        Text
    "dsChar"           -> TokenType
    CharTok
        Text
    "dsSpecialChar"    -> TokenType
    SpecialCharTok
        Text
    "dsString"         -> TokenType
    StringTok
        Text
    "dsVerbatimString" -> TokenType
    VerbatimStringTok
        Text
    "dsSpecialString"  -> TokenType
    SpecialStringTok
        Text
    "dsImport"         -> TokenType
    ImportTok
        Text
    "dsComment"        -> TokenType
    CommentTok
        Text
    "dsDocumentation"  -> TokenType
    DocumentationTok
        Text
    "dsAnnotation"     -> TokenType
    AnnotationTok
        Text
    "dsCommentVar"     -> TokenType
    CommentVarTok
        Text
    "dsOthers"         -> TokenType
    OtherTok
        Text
    "dsFunction"       -> TokenType
    FunctionTok
        Text
    "dsVariable"       -> TokenType
    VariableTok
        Text
    "dsControlFlow"    -> TokenType
    ControlFlowTok
        Text
    "dsOperator"       -> TokenType
    OperatorTok
        Text
    "dsBuiltIn"        -> TokenType
    BuiltInTok
        Text
    "dsExtension"      -> TokenType
    ExtensionTok
        Text
    "dsPreprocessor"   -> TokenType
    PreprocessorTok
        Text
    "dsAttribute"      -> TokenType
    AttributeTok
        Text
    "dsRegionMarker"   -> TokenType
    RegionMarkerTok
        Text
    "dsInformation"    -> TokenType
    InformationTok
        Text
    "dsWarning"        -> TokenType
    WarningTok
        Text
    "dsAlert"          -> TokenType
    AlertTok
        Text
    "dsError"          -> TokenType
    ErrorTok
        Text
    _                  -> TokenType
    NormalTok

    -- Note, some xml files have "\\" for a backslash,
    -- others have "\".  Not sure what the rules are, but
    -- this covers both bases:
    readChar :: Text -> Char
    readChar :: Text -> Char
    readChar Text
    t = case Text -> [Char]
    T.unpack Text
    t of
                      [Char
    c] -> Char
    c
                      [Char]
    s   -> Char -> [Char] -> Char
    forall a. Read a => a -> [Char] -> a
    readDef Char
    '\xffff' ([Char] -> Char) -> [Char] -> Char
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "'" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "'"

    pathToLangName :: String -> String
    pathToLangName :: [Char] -> [Char]
    pathToLangName [Char]
    s = [Char] -> [Char]
    capitalize ([Char] -> [Char]
    camelize ([Char] -> [Char]
    takeBaseName [Char]
    s))

    camelize :: String -> String
    camelize :: [Char] -> [Char]
    camelize (Char
    d:Char
    c:[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 (Char
    c:[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 (Char
    c:[Char]
    cs) = Char -> Char
    toUpper Char
    c Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char]
    cs
    capitalize []     = []