{-# LANGUAGE OverloadedStrings #-}

module Bricoleur.Commands.Splice (runSplice) where

import Bricoleur.Config
import Bricoleur.Opts
import Bricoleur.Utils
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

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