    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    -- | This module provides routines to load syntax definitions from disk
    -- files.
    module Skylighting.Loader ( loadSyntaxFromFile
                              , loadSyntaxesFromDir
                              , loadValidSyntaxesFromDir
                              )
                              where

    import Control.Monad (filterM, foldM)
    import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
    import Control.Monad.IO.Class (liftIO)
    import System.Directory (listDirectory, doesFileExist)
    import System.FilePath ((</>), takeExtension)
    import Skylighting.Types (SyntaxMap, Syntax)
    import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition,
                               resolveKeywords)
    import qualified Data.Map as M
    #if !MIN_VERSION_base(4,11,0)
    import Data.Semigroup
    #endif

    syntaxFileExtension :: String
    syntaxFileExtension :: String
    syntaxFileExtension = String
    ".xml"

    isSyntaxFile :: FilePath -> Bool
    isSyntaxFile :: String -> Bool
    isSyntaxFile = (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    syntaxFileExtension) (String -> Bool) -> (String -> String) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    takeExtension

    -- | Loads a syntax definition from the specified file path. The file
    -- path must refer to a file containing an XML Kate syntax definition.
    loadSyntaxFromFile :: FilePath -> IO (Either String Syntax)
    loadSyntaxFromFile :: String -> IO (Either String Syntax)
    loadSyntaxFromFile String
    path = do
        result <- String -> IO (Either String Syntax)
    parseSyntaxDefinition String
    path
        case result of
            Left String
    e -> Either String Syntax -> IO (Either String Syntax)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String Syntax -> IO (Either String Syntax))
    -> Either String Syntax -> IO (Either String Syntax)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String Syntax
    forall a b. a -> Either a b
    Left (String -> Either String Syntax) -> String -> Either String Syntax
    forall a b. (a -> b) -> a -> b
    $ String
    "Error parsing file " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> String
    forall a. Show a => a -> String
    show String
    path String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    e
            Right Syntax
    s -> Either String Syntax -> IO (Either String Syntax)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String Syntax -> IO (Either String Syntax))
    -> Either String Syntax -> IO (Either String Syntax)
    forall a b. (a -> b) -> a -> b
    $ Syntax -> Either String Syntax
    forall a b. b -> Either a b
    Right Syntax
    s

    -- | Loads all syntax definitions from the specified directory by
    -- looking for files with an ".xml" extension. This function assumes
    -- such files are Kate XML syntax definitions, so XML files with
    -- unexpected contents will cause a parsing error returned as a 'Left'
    -- and syntax parsing will be aborted.
    loadSyntaxesFromDir :: FilePath -> IO (Either String SyntaxMap)
    loadSyntaxesFromDir :: String -> IO (Either String SyntaxMap)
    loadSyntaxesFromDir String
    path = ExceptT String IO SyntaxMap -> IO (Either String SyntaxMap)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT String IO SyntaxMap -> IO (Either String SyntaxMap))
    -> ExceptT String IO SyntaxMap -> IO (Either String SyntaxMap)
    forall a b. (a -> b) -> a -> b
    $ do
        files <- IO [String] -> ExceptT String IO [String]
    forall a. IO a -> ExceptT String IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [String] -> ExceptT String IO [String])
    -> IO [String] -> ExceptT String IO [String]
    forall a b. (a -> b) -> a -> b
    $ String -> IO [String]
    syntaxFiles String
    path

        let loadSyntax SyntaxMap
    sMap String
    file = do
                s <- IO (Either String Syntax) -> ExceptT String IO Syntax
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either String Syntax) -> ExceptT String IO Syntax)
    -> IO (Either String Syntax) -> ExceptT String IO Syntax
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Either String Syntax)
    loadSyntaxFromFile String
    file
                return $ addSyntaxDefinition s sMap

        sm <- foldM loadSyntax mempty files
        return $ M.map (resolveKeywords sm) sm

    syntaxFiles :: FilePath -> IO [FilePath]
    syntaxFiles :: String -> IO [String]
    syntaxFiles String
    dir = do
        entries <- String -> IO [String]
    listDirectory String
    dir
        let absEntries = (String
    dir String -> String -> String
    </>) (String -> String) -> [String] -> [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    isSyntaxFile [String]
    entries
        filterM doesFileExist absEntries

    -- | Loads all valid syntax definitions from the specified directory by looking
    -- for files with an ".xml" extension.  Any files that are not valid Kate XML
    -- syntax definitions will have an entry in the resulting error map; the returned
    -- SyntaxMap will be made up of only the files that could successfully be loaded
    -- and parsed.
    loadValidSyntaxesFromDir :: FilePath -> IO (LoadErrMap, SyntaxMap)
    loadValidSyntaxesFromDir :: String -> IO (LoadErrMap, SyntaxMap)
    loadValidSyntaxesFromDir String
    path = ((LoadErrMap, SyntaxMap) -> String -> IO (LoadErrMap, SyntaxMap))
    -> (LoadErrMap, SyntaxMap)
    -> [String]
    -> IO (LoadErrMap, SyntaxMap)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (LoadErrMap, SyntaxMap) -> String -> IO (LoadErrMap, SyntaxMap)
    go (LoadErrMap
    forall a. Monoid a => a
    mempty, SyntaxMap
    forall a. Monoid a => a
    mempty) ([String] -> IO (LoadErrMap, SyntaxMap))
    -> IO [String] -> IO (LoadErrMap, SyntaxMap)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> IO [String]
    syntaxFiles String
    path
      where
        go :: (LoadErrMap, SyntaxMap) -> String -> IO (LoadErrMap, SyntaxMap)
    go (LoadErrMap
    errMap, SyntaxMap
    syntaxMap) String
    file =
          String -> IO (Either String Syntax)
    loadSyntaxFromFile String
    file IO (Either String Syntax)
    -> (Either String Syntax -> IO (LoadErrMap, SyntaxMap))
    -> IO (LoadErrMap, SyntaxMap)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Right Syntax
    s -> (LoadErrMap, SyntaxMap) -> IO (LoadErrMap, SyntaxMap)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LoadErrMap
    errMap, Syntax -> SyntaxMap -> SyntaxMap
    addSyntaxDefinition Syntax
    s SyntaxMap
    syntaxMap)
            Left String
    e -> (LoadErrMap, SyntaxMap) -> IO (LoadErrMap, SyntaxMap)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> String -> LoadErrMap -> LoadErrMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert String
    file String
    e LoadErrMap
    errMap, SyntaxMap
    syntaxMap)

    -- | A map from a potential syntax file to the error encountered when trying to
    -- load that syntax file.
    type LoadErrMap = M.Map FilePath String