{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Erb.Compute(computeTemplate, getTemplateFile, initTemplateDaemon) where

import Puppet.Interpreter.Types
import Puppet.Init
import Puppet.Stats
import Puppet.Utils

import Control.Monad.Error
import Control.Concurrent
import System.Posix.Files
import Paths_language_puppet (getDataFileName)
import Erb.Parser
import Erb.Evaluate
import qualified Data.Map as Map
import Debug.Trace
import qualified System.Log.Logger as LOG
import qualified Data.Text as T
import Text.Parsec

#ifdef HRUBY
import Foreign
import Foreign.Ruby

type RegisteredGetvariable = RValue -> RValue -> RValue -> RValue -> IO RValue
foreign import ccall "wrapper" mkRegisteredGetvariable :: RegisteredGetvariable -> IO (FunPtr RegisteredGetvariable)

#else
import System.IO
import SafeProcess
import Data.List
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.Builder as T
import qualified Data.Text.Lazy.Builder.Int as T
import qualified Data.Foldable as F
#endif

type TemplateQuery = (Chan TemplateAnswer, Either T.Text T.Text, T.Text, Map.Map T.Text GeneralValue)
type TemplateAnswer = Either String T.Text



initTemplateDaemon :: Prefs -> MStats -> IO (Either T.Text T.Text -> T.Text -> Map.Map T.Text GeneralValue -> IO (Either String T.Text))
initTemplateDaemon (Prefs _ modpath templatepath _ _ ps _ _) mvstats = do
    controlchan <- newChan
#ifdef HRUBY
    initialize
    s <- (getRubyScriptPath "hrubyerb.rb" >>= \p -> rb_load_protect p 0)
    unless (s == 0) $ do
        msg <- showErrorStack
        error msg
    rubyResolveFunction <- mkRegisteredGetvariable hrresolveVariable
    rb_define_global_function "varlookup" rubyResolveFunction 3
    forkIO (templateDaemon modpath templatepath controlchan mvstats)
#else
    replicateM_ ps (forkIO (templateDaemon modpath templatepath controlchan mvstats))
#endif
    return (templateQuery controlchan)

templateQuery :: Chan TemplateQuery -> Either T.Text T.Text -> T.Text -> Map.Map T.Text GeneralValue -> IO (Either String T.Text)
templateQuery qchan filename scope variables = do
    rchan <- newChan
    writeChan qchan (rchan, filename, scope, variables)
    readChan rchan

templateDaemon :: T.Text -> T.Text -> Chan TemplateQuery -> MStats -> IO ()
templateDaemon modpath templatepath qchan mvstats = do
    (respchan, fileinfo, scope, variables) <- readChan qchan
    case fileinfo of
        Right filename -> do
            let parts = T.splitOn "/" filename
                searchpathes | length parts > 1 = [modpath <> "/" <> head parts <> "/templates/" <> T.intercalate "/" (tail parts), templatepath <> "/" <> filename]
                             | otherwise        = [templatepath <> "/" <> filename]
            acceptablefiles <- filterM (fileExist . T.unpack) searchpathes
            if null acceptablefiles
                then writeChan respchan (Left $ "Can't find template file for " ++ T.unpack filename ++ ", looked in " ++ show searchpathes)
                else measure mvstats ("total - " <> filename) (computeTemplate (Right (head acceptablefiles)) scope variables mvstats) >>= writeChan respchan
        Left _ -> measure mvstats "total - inline" (computeTemplate fileinfo scope variables mvstats) >>= writeChan respchan
    templateDaemon modpath templatepath qchan mvstats

computeTemplate :: Either T.Text T.Text -> T.Text -> Map.Map T.Text GeneralValue -> MStats -> IO TemplateAnswer
computeTemplate fileinfo curcontext variables mstats = do
    let (filename, ufilename) = case fileinfo of
                                    Left _ -> ("inline", "inline")
                                    Right x -> (x, T.unpack x)
    parsed <- case fileinfo of
                  Right _      -> measure mstats ("parsing - " <> filename) $ parseErbFile ufilename
                  Left content -> measure mstats ("parsing - " <> filename) (return (runParser erbparser () "inline" (T.unpack content)))
    case parsed of
        Left err -> do
            let !msg = "template " ++ ufilename ++ " could not be parsed " ++ show err
            traceEventIO msg
            LOG.debugM "Erb.Compute" msg
            measure mstats ("ruby - " <> filename) $ computeTemplateWRuby fileinfo curcontext variables
        Right ast -> case rubyEvaluate variables curcontext ast of
                Right ev -> return (Right ev)
                Left err -> do
                    let !msg = "template " ++ ufilename ++ " evaluation failed " ++ show err
                    traceEventIO msg
                    LOG.debugM "Erb.Compute" msg
                    measure mstats ("ruby efail - " <> filename) $ computeTemplateWRuby fileinfo curcontext variables

getTemplateFile :: T.Text -> CatalogMonad T.Text
getTemplateFile = throwError

getRubyScriptPath :: String -> IO String
getRubyScriptPath rubybin = do
    cabalPath <- getDataFileName $ "ruby/" ++ rubybin :: IO FilePath
    exists    <- fileExist cabalPath
    if exists
        then return cabalPath
        else do
            path <- fmap (T.unpack . takeDirectory . T.pack) mGetExecutablePath
            let fullpath = path <> "/" <> rubybin
            lexists <- fileExist cabalPath
            return $ if lexists
                         then fullpath
                         else rubybin

#ifdef HRUBY
hrresolveVariable :: RValue -> RValue -> RValue -> RValue -> IO RValue
-- T.Text -> Map.Map T.Text GeneralValue -> RValue -> RValue -> IO RValue
hrresolveVariable _ rscope rvariables rtoresolve = do
    scope <- extractHaskellValue rscope
    variables <- extractHaskellValue rvariables
    toresolve <- fromRuby rtoresolve
    let answer = case toresolve of
                     Just t -> getVariable variables scope t
                     _ -> Left "The variable name is not a string"
    case answer of
        Left _ -> getSymbol "undef"
        Right r -> toRuby r

computeTemplateWRuby :: Either T.Text T.Text -> T.Text -> Map.Map T.Text GeneralValue -> IO TemplateAnswer
computeTemplateWRuby fileinfo curcontext variables = freezeGC $ do
    rscope <- embedHaskellValue curcontext
    rvariables <- embedHaskellValue variables
    o <- case fileinfo of
             Right fname  -> do
                 rfname <- toRuby fname
                 safeMethodCall "Controller" "runFromFile" [rfname,rscope,rvariables]
             Left content -> toRuby content >>= safeMethodCall "Controller" "runFromContent" . (:[])
    freeHaskellValue rvariables
    freeHaskellValue rscope
    case o of
        Left (rr, _) -> return (Left rr)
        Right r -> fromRuby r >>= \x -> case x of
                                            Just result -> return (Right result)
                                            Nothing -> return (Left "Could not deserialiaze ruby output")

#else
saveTmpContent :: T.Text -> IO FilePath
saveTmpContent cnt = do
    (name, h) <- openTempFile "/tmp" "inline_template.erb"
    hClose h
    return name

computeTemplateWRuby :: Either T.Text T.Text -> T.Text -> Map.Map T.Text GeneralValue -> Maybe (FunPtr RegisteredGetvariable) -> IO TemplateAnswer
computeTemplateWRuby fileinfo curcontext variables = do
    (temp, filename) <- case fileinfo of
                            Right x  -> return (Nothing, x)
                            Left cnt -> do
                                tmpfile <- saveTmpContent cnt
                                return (Just tmpfile, "inline")
    let rubyvars = "{\n" <> mconcat (intersperse ",\n" (concatMap toRuby (Map.toList variables))) <> "\n}\n" :: T.Builder
        input = T.fromText curcontext <> "\n" <> T.fromText filename <> "\n" <> rubyvars :: T.Builder
        ufilename = T.unpack filename
    rubyscriptpath <- getRubyScriptPath "calcerb.rb"
    traceEventIO ("start running ruby" ++ ufilename)
    !ret <- safeReadProcessTimeout "ruby" [rubyscriptpath] (T.toLazyText input) 1000
    traceEventIO ("finished running ruby" ++ ufilename)
    F.forM_ temp removeLink
    case ret of
        Just (Right x) -> return $! Right x
        Just (Left er) -> do
            (tmpfilename, tmphandle) <- openTempFile "/tmp" "templatefail"
            TL.hPutStr tmphandle (T.toLazyText input)
            hClose tmphandle
            return $ Left $ er ++ " - for template " ++ ufilename ++ " input in " ++ tmpfilename
        Nothing -> return $ Left "Process did not terminate"

minterc :: T.Builder -> [T.Builder] -> T.Builder
minterc _ [] = mempty
minterc _ [a] = a
minterc !sep !(x:xs) = x <> foldl' minterc' mempty xs
    where
        minterc' !curbuilder !b  = curbuilder <> sep <> b

renderString :: T.Text -> T.Builder
renderString x = let !y = T.fromString (show x) in y

toRuby :: (T.Text, GeneralValue) -> [T.Builder]
toRuby (_, Left _) = []
toRuby (_, Right ResolvedUndefined) = []
toRuby (varname, Right varval) = ["\t" <> renderString varname <> " => " <> toRuby' varval]
toRuby' (ResolvedString str) = renderString str
toRuby' (ResolvedInt i) = "\'" <> T.decimal i <> "\'"
toRuby' (ResolvedBool True) = "true"
toRuby' (ResolvedBool False) = "false"
toRuby' (ResolvedArray rr) = "[" <> minterc ", " (map toRuby' rr) <> "]"
toRuby' (ResolvedHash hh) = "{ " <> minterc ", " (map (\(varname, varval) -> renderString varname <> " => " <> toRuby' varval) hh) <>  " }"
toRuby' ResolvedUndefined = ":undef"
toRuby' (ResolvedRReference rtype (ResolvedString rname)) = renderString ( rtype <> "[" <> rname <> "]" )
toRuby' x = T.fromString $ show x
#endif