{-# 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
    Either String Syntax
result <- String -> IO (Either String Syntax)
parseSyntaxDefinition String
path
    case Either String Syntax
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
    [String]
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 -> String -> ExceptT String IO SyntaxMap
loadSyntax SyntaxMap
sMap String
file = do
            Syntax
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
            SyntaxMap -> ExceptT String IO SyntaxMap
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxMap -> ExceptT String IO SyntaxMap)
-> SyntaxMap -> ExceptT String IO SyntaxMap
forall a b. (a -> b) -> a -> b
$ Syntax -> SyntaxMap -> SyntaxMap
addSyntaxDefinition Syntax
s SyntaxMap
sMap

    SyntaxMap
sm <- (SyntaxMap -> String -> ExceptT String IO SyntaxMap)
-> SyntaxMap -> [String] -> ExceptT String IO SyntaxMap
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 SyntaxMap
forall a. Monoid a => a
mempty [String]
files
    SyntaxMap -> ExceptT String IO SyntaxMap
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxMap -> ExceptT String IO SyntaxMap)
-> SyntaxMap -> ExceptT String IO SyntaxMap
forall a b. (a -> b) -> a -> b
$ (Syntax -> Syntax) -> SyntaxMap -> SyntaxMap
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
</>) (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
    (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [String]
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