bricoleur/src/Bricoleur/Commands/Splice.hs

{-# 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