{-# 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 = ".xml"

isSyntaxFile :: FilePath -> Bool
isSyntaxFile = (== syntaxFileExtension) . 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 path = do
    result <- parseSyntaxDefinition path
    case result of
        Left e -> return $ Left $ "Error parsing file " <> show path <> ": " <> e
        Right s -> return $ Right 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 path = runExceptT $ do
    files <- liftIO $ syntaxFiles path

    let loadSyntax sMap file = do
            s <- ExceptT $ loadSyntaxFromFile file
            return $ addSyntaxDefinition s sMap

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

syntaxFiles :: FilePath -> IO [FilePath]
syntaxFiles dir = do
    entries <- listDirectory dir
    let absEntries = (dir </>) <$> filter isSyntaxFile entries
    filterM doesFileExist absEntries