{-# LANGUAGE CPP #-}
-- | This module provides routines to load syntax definitions from disk
-- files.
module Skylighting.Loader ( loadSyntaxFromFile
                          , loadSyntaxesFromDir
                          )
                          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 = (forall a. Eq a => a -> a -> Bool
== String
syntaxFileExtension) 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
    Either String Syntax
result <- String -> IO (Either String Syntax)
parseSyntaxDefinition String
path
    case Either String Syntax
result of
        Left String
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Error parsing file " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
path forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> String
e
        Right Syntax
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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'.
loadSyntaxesFromDir :: FilePath -> IO (Either String SyntaxMap)
loadSyntaxesFromDir :: String -> IO (Either String SyntaxMap)
loadSyntaxesFromDir String
path = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    [String]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
syntaxFiles String
path

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

    SyntaxMap
sm <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM SyntaxMap -> String -> ExceptT String IO SyntaxMap
loadSyntax forall a. Monoid a => a
mempty [String]
files
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (SyntaxMap -> Syntax -> Syntax
resolveKeywords SyntaxMap
sm) SyntaxMap
sm

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