import System.Environment(getArgs,getEnvironment)
import System.FilePath(joinPath)
import System.Directory(createDirectoryIfMissing)
import System.IO
import Data.Time.Calendar

import Text.ParserCombinators.Parsec
import qualified Data.Map as Map
import qualified Text.XML.Light as X
import qualified Text.XML.Light.Output as X
import qualified Text.XML.Light.Input as X
import Control.Monad.State

import Balances
import Valuation
import HTML
import Actions
import XMLParse

type VarMap = Map.Map String String

substituteEnvVars :: VarMap -> String -> String
substituteEnvVars env s = subst s
  where
    subst "" = ""
    subst ('$':'(':cs) = case span (/=')') cs of
        (var,')':cs') -> case Map.lookup var env of
            Nothing -> "$(" ++ var ++ ")" ++ subst cs'
            (Just s) -> s ++ subst cs'
    subst (c:cs) = c:subst cs

-- Expand any environment variables of the form $(VARNAME) within the
-- text of the XML
substituteEnvVarsXML :: VarMap -> X.Element -> X.Element
substituteEnvVarsXML env xml = subst0 xml
  where
    subst0 (e@X.Element{X.elContent=content}) = e{X.elContent=map subst1 content }
    subst1 (X.Elem e) = X.Elem (substituteEnvVarsXML env e)
    subst1 (X.Text cd@(X.CData{X.cdData=s})) = X.Text cd{X.cdData=substituteEnvVars env s}
    subst1 c = c

-- Implement a very basic abstraction mechanism within the XML.
-- Elements like <ledger_def name="XXXX"> ... content ... </ledger_def>
-- are removed. Elements like <ledger_ref name="XXXX"/> are replaced with
-- the content from the corresponding <ledger_def> tag.

substituteDefinitionsXML :: X.Element -> X.Element
substituteDefinitionsXML xml = xml{X.elContent=walk Map.empty (X.elContent xml)}
  where
    walk :: Map.Map String [X.Content] -> [X.Content] -> [X.Content]

    walk _ [] = []

    walk m (X.Elem e:cs) | X.elName e == ledger_def =
        case X.findAttr name e of
            Nothing -> error "ledger_def tag has no name attribute"
            (Just s) -> walk (Map.insert s (walk m (X.elContent e)) m) cs
      
    walk m (X.Elem e:cs) | X.elName e == ledger_ref = 
        case X.findAttr name e of
          Nothing -> error "ledger_ref tag has no name attribute"
          (Just s) -> case (Map.lookup s m) of
              Nothing -> error ("ledger_ref tag refers to unknown defintion '" ++ s ++ "'")
              (Just cs1) -> cs1 ++ walk m cs

    walk m (X.Elem e:cs) = (X.Elem (walke m e)):walk m cs

    walk m (c:cs) = c:walk m cs

    walke m e@X.Element{X.elContent=cs} = e{X.elContent=walk m cs}

    ledger_def = X.blank_name{X.qName="ledger_def"}
    ledger_ref = X.blank_name{X.qName="ledger_ref"}
    name = X.blank_name{X.qName="name"}

replaceTemplates :: X.Element -> CIO X.Element
replaceTemplates el = case lookup (X.qName (X.elName el)) templates of
    (Just parser) -> case (evalXMLParser parser el) of
        (Left emesg) -> error emesg
        (Right el) -> el
    Nothing -> do
        cs <- mapM replaceContent (X.elContent el)
        return el{X.elContent=cs}
  where
    replaceContent :: X.Content -> CIO X.Content
    replaceContent (X.Elem el) = X.Elem `fmap` replaceTemplates el
    replaceContent c = return c

data Phases = Phases {
   substEnvVars :: Bool,
   substDefs :: Bool,
   substReports :: Bool
}

phases = Phases True True True

main = do
   [templatePath,outputPath] <- getArgs
   t <- readFile templatePath
   env <- Map.fromList `fmap` getEnvironment
   let mxml = X.parseXMLDoc t
   case mxml of
     Nothing -> error ("failed to parse contents of " ++ templatePath)
     (Just xml) -> do
         let xml1 = (if substEnvVars phases then substituteEnvVarsXML env else id) xml
         let xml2 = (if substDefs phases then substituteDefinitionsXML else id) xml1
         xml3 <- if substReports phases then evalCIO (replaceTemplates xml2) else return xml2
         writeFile outputPath (X.showElement xml3)
         putStrLn ("wrote output to " ++ outputPath)