12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697 |
- {-# LANGUAGE OverloadedStrings #-}
- module Bricoleur.Commands.Splice(runSplice) where
- import Control.Monad (foldM)
- import qualified Data.Map as M
- import qualified Data.Text as T
- import qualified Data.Text.Lazy as TL
- import qualified Data.Text.Lazy.IO as TL
- import System.FilePath ((</>))
- import qualified System.FilePath as Sys
- import Bricoleur.Config
- import Bricoleur.Opts
- import Bricoleur.Utils
- findFragmentIdentifiers :: TL.Text -> [T.Text]
- findFragmentIdentifiers t
- | (_, rs) <- TL.break (== '«') t
- , (f, rs') <- TL.break (== '»') (TL.drop 1 rs)
- , not (TL.null f) = TL.toStrict f : findFragmentIdentifiers rs'
- | otherwise = []
- newtype Fragment = Fragment [T.Text] deriving (Eq, Show)
- toIdent :: T.Text -> TL.Text
- toIdent = TL.fromStrict . T.cons '«' . flip T.snoc '»'
- findFragments :: FilePath -> T.Text -> [Source] -> Either TL.Text (IO TL.Text)
- findFragments root s sources = case (T.splitOn "/" s) of
- [] -> throw "Invalid empty fragment name!"
- (x:rs) -> case [ src
- | src@Source { sourceName = n } <- sources
- , n == x
- ] of
- [src] -> go src rs (sourceExpose src)
- [] -> throw ("Unable to find source named " % stext) x
- _ -> throw ("Ambiguous source name: " % stext) x
- where
- go q [] (ExposeFile path) =
- return (cOpenFile "file source" (root </> sourceDir q </> path))
- go _ [] ExposeSections{} =
- throw ("Splice identifier «" % stext %
- "» matches a file with sections") s
- go _ [] NamedMap{} =
- throw ("Splice identifier «" % stext %
- "» matches a map, but does not specify a key!") s
- go q [section] (ExposeSections path) =
- return (readSection (root </> sourceDir q </> path) section)
- go _ (_:_) (ExposeSections path) =
- throw ("Splice identifier «" % stext %
- "» indexes too far into the path " % string % "!")
- s path
- go _ (_:_) (ExposeFile path) =
- throw ("Splice identifier «" % stext %
- "» indexes too far into the file " % string % "!")
- s path
- go q (k:rs) (NamedMap m)
- | Just e <- M.lookup k m = go q rs e
- | otherwise = throw
- ("Splice identifier «" % stext %
- "» references a key " % stext %
- " which cannot be found.") s k
- doReplacements :: FilePath -> [Source] -> TL.Text -> IO TL.Text
- doReplacements root e original =
- foldM doReplace original (findFragmentIdentifiers original)
- where
- doReplace file frag = do
- new <- case findFragments root frag e of
- Left err -> cDie ("Fragment error: " % text) err
- Right x -> x
- return (TL.replace (toIdent frag) new file)
- readSection :: FilePath -> T.Text -> IO TL.Text
- readSection path f = do
- contents <- cOpenFile "section source" path
- case TL.breakOn (toIdent f) contents of
- (_, "") -> cDie ("Unable to find section " % shown %
- " in file " % string) f path
- (_, rs) ->
- let (_, skipLine) = TL.breakOn "\n" rs
- (section, _) = TL.breakOn "«end»" (TL.drop 1 skipLine)
- (skipLine', _) = TL.breakOnEnd "\n" section
- in return (TL.init skipLine')
- runSplice :: Config -> Options -> IO ()
- runSplice conf opts = do
- let root = Sys.takeDirectory (optFile opts)
- f <- cOpenFile "document" (root </> confDocument conf)
- rs <- doReplacements root (confSources conf) f
- TL.putStrLn rs
|