content: -- | Internal module used to initialize the erb template daemon.
  module Puppet.Runner.Erb
    ( initTemplateDaemon,
      rubyEvaluate,
    )
  where
  
  import qualified Data.Either.Strict as S
  import qualified Data.FileCache as Cache
  import qualified Data.List as List
  import qualified Data.List.Split as List
  import qualified Data.Text as Text
  import qualified Data.Vector as Vector
  import Debug.Trace
  import Erb
  import Foreign.Ruby
  import qualified Foreign.Ruby.Bindings as FR
  import qualified Foreign.Ruby.Helpers as FR
  import GHC.Conc (labelThread)
  import Paths_language_puppet (getDataFileName)
  import Puppet.Interpreter.Helpers
  import Puppet.Interpreter.IO
  import Puppet.Interpreter.Resolve
  import Puppet.Interpreter.Types
  import Puppet.Runner.Erb.Evaluate
  import Puppet.Runner.Preferences
  import Puppet.Runner.Stats
  import System.Environment (getExecutablePath)
  import System.FilePath
  import System.Posix.Files
  import Text.Parsec hiding (string)
  import Text.Parsec.Error
  import Text.Parsec.Pos
  import XPrelude
  
  instance IsString TemplateParseError where
    fromString s = TemplateParseError $ newErrorMessage (Message s) (initialPos mempty)
  
  newtype TemplateParseError = TemplateParseError {tgetError :: ParseError}
  
  type TemplateQuery = (Chan TemplateAnswer, TemplateSource, InterpreterState, InterpreterReader IO)
  
  type TemplateAnswer = S.Either PrettyError Text
  
  showRubyError :: RubyError -> PrettyError
  showRubyError (Stack msg stk) = PrettyError $ dullred (ppstring msg) <> softline <> dullyellow (ppstring stk)
  showRubyError (WithOutput str _) = PrettyError $ dullred (ppstring str)
  showRubyError (OtherError rr) = PrettyError (dullred (pptext rr))
  
  -- | Parse and resolve erb files. Initializes a thread for the Ruby interpreter .
  initTemplateDaemon ::
    RubyInterpreter ->
    Preferences IO ->
    MStats ->
    IO (TemplateSource -> InterpreterState -> InterpreterReader IO -> IO (S.Either PrettyError Text))
  initTemplateDaemon rubyintp prefs mvstats = do
    controlchan <- newChan
    templatecache <- Cache.newFileCache
    let returnError rs = return $ \_ _ _ -> pure (S.Left (showRubyError rs))
    x <- runExceptT $ do
      liftIO (getRubyScriptPath "hrubyerb.rb") >>= ExceptT . loadFile rubyintp
      ExceptT (registerGlobalFunction4 rubyintp "varlookup" hrresolveVariable)
      ExceptT (registerGlobalFunction5 rubyintp "callextfunc" hrcallfunction)
      liftIO $
        void $
          forkIO $
            templateDaemon
              rubyintp
              (prefs ^. prefPuppetPaths . modulesPath)
              (prefs ^. prefPuppetPaths . templatesPath)
              controlchan
              mvstats
              templatecache
      pure $! templateQuery controlchan
    either returnError pure x
  
  templateQuery :: Chan TemplateQuery -> TemplateSource -> InterpreterState -> InterpreterReader IO -> IO (S.Either PrettyError Text)
  templateQuery qchan filename intpstate intpreader = do
    rchan <- newChan
    writeChan qchan (rchan, filename, intpstate, intpreader)
    readChan rchan
  
  templateDaemon :: RubyInterpreter -> FilePath -> FilePath -> Chan TemplateQuery -> MStats -> Cache.FileCacheR TemplateParseError [RubyStatement] -> IO ()
  templateDaemon rubyintp modpath templatepath qchan mvstats filecache = do
    let nameThread :: String -> IO ()
        nameThread n = myThreadId >>= flip labelThread n
    nameThread "RubyTemplateDaemon"
    (respchan, fileinfo, intpstate, intpreader) <- readChan qchan
    case fileinfo of
      Filename filename -> do
        let prts = List.splitOn "/" filename
            searchpathes
              | length prts > 1 =
                  [ modpath </> List.head prts </> "templates" </> List.intercalate "/" (List.tail prts),
                    templatepath </> filename
                  ]
              | otherwise = [templatepath </> filename]
        acceptablefiles <- filterM fileExist searchpathes
        if null acceptablefiles
          then writeChan respchan (S.Left $ PrettyError $ "Can't find template file for" <+> pptext filename <+> ", looked in" <+> list (map pptext searchpathes))
          else measure mvstats (toS filename) (computeTemplate rubyintp (Filename (List.head acceptablefiles)) intpstate intpreader mvstats filecache) >>= writeChan respchan
      Inline _ -> measure mvstats "inline" (computeTemplate rubyintp fileinfo intpstate intpreader mvstats filecache) >>= writeChan respchan
    templateDaemon rubyintp modpath templatepath qchan mvstats filecache
  
  computeTemplate :: RubyInterpreter -> TemplateSource -> InterpreterState -> InterpreterReader IO -> MStats -> Cache.FileCacheR TemplateParseError [RubyStatement] -> IO TemplateAnswer
  computeTemplate rubyintp srcinfo intpstate intpreader mstats filecache = do
    let (curcontext, fvariables) =
          case extractScope intpstate of
            Nothing -> (mempty, mempty)
            Just (c, v) -> (c, v)
        template_src = templateSrc srcinfo
        mkSafe a =
          makeSafe rubyintp a >>= \case
            Left err -> return (S.Left (showRubyError err))
            Right x -> return x
        encapsulateError = _Left %~ TemplateParseError
        variables = fvariables & traverse . scopeVariables . traverse . _1 . _1 %~ toStr
        toStr (PNumber n) = PString (scientific2text n)
        toStr x = x
    traceEventIO ("START template " <> template_src)
    parsed <- case srcinfo of
      Filename _ -> measure mstats ("parsing - " <> toS template_src) $ Cache.lazyQuery filecache template_src $ fmap encapsulateError (parseErbFile template_src)
      Inline s -> measure mstats ("parsing - " <> toS template_src) $ pure $ encapsulateError (runParser erbparser () "inline" (toS s))
    o <- case parsed of
      Left err -> do
        let !msg = "Template could not be parsed " <> show (tgetError err)
        -- if the haskell parser fails the ruby one will fallback.
        logInfoStr msg
        measure mstats ("ruby - " <> toS template_src) $ mkSafe $ computeTemplateWRuby srcinfo curcontext variables intpstate intpreader
      Right ast -> case rubyEvaluate variables curcontext ast of
        Right ev -> pure (S.Right ev)
        Left err -> do
          let !msg = "At " <> showPPos' (intpstate ^. curPos) <> " the evaluation of template '" <> template_src <> "' failed. " <> show err
          -- if the haskell evaluation fails the ruby one will fallback. It is likely that the reason for the failure is a real template issue.
          logErrorStr msg
          measure mstats ("ruby efail - " <> toS template_src) $ mkSafe $ computeTemplateWRuby srcinfo curcontext variables intpstate intpreader
    traceEventIO ("STOP template " <> template_src)
    pure o
  
  getRubyScriptPath :: String -> IO String
  getRubyScriptPath rubybin = do
    let checkpath :: FilePath -> IO FilePath -> IO FilePath
        checkpath fp = ifM (fileExist fp) (pure fp)
        withExecutablePath = do
          path <- fmap takeDirectory getExecutablePath
          let fullpath = path </> rubybin
          checkpath fullpath $ checkpath ("/usr/local/bin/" <> rubybin) (pure rubybin)
    cabalPath <- getDataFileName $ "ruby/" ++ rubybin :: IO FilePath
    checkpath cabalPath withExecutablePath
  
  -- This must be called from the proper thread. As this is callback, this should be ok.
  hrresolveVariable :: RValue -> RValue -> RValue -> RValue -> IO RValue
  -- Text -> Container PValue -> RValue -> RValue -> IO RValue
  hrresolveVariable _ rscp rvariables rtoresolve = do
    scope <- FR.extractHaskellValue rscp
    variables <- FR.extractHaskellValue rvariables
    toresolve <- FR.fromRuby rtoresolve
    let answer = case toresolve of
          Right "~g~e~t_h~a~s~h~" ->
            let getvars ctx = (variables ^. ix ctx . scopeVariables) & traverse %~ view (_1 . _1)
                vars = getvars "::" <> getvars scope
             in Right (PHash vars)
          Right t -> getVariable variables scope t
          Left err -> Left ("The variable name is not a string" <+> pptext err)
    case answer of
      Left _ -> getSymbol "undef"
      Right r -> FR.toRuby r
  
  hrcallfunction :: RValue -> RValue -> RValue -> RValue -> RValue -> IO RValue
  hrcallfunction _ rfname rargs rstt rrdr = do
    efname <- FR.fromRuby rfname
    eargs <- FR.fromRuby rargs
    rdr <- FR.extractHaskellValue rrdr
    stt <- FR.extractHaskellValue rstt
    let rubyerr :: String -> IO RValue
        rubyerr err = fmap (either snd identity) (FR.toRuby (Text.pack err) >>= FR.safeMethodCall "MyError" "new" . (: []))
    case (,) <$> efname <*> eargs of
      Right (fname, varray)
        | fname `elem` ["template", "inline_template"] -> do
            logWarning $ "Can't parse a call to the external ruby function '" <> fname <> "'  n an erb file.\n\tIt is not possible to call it from a Ruby function. It would stall (yes it sucks ...).\n\tChoosing to output \"undef\" !"
            getSymbol "undef"
        | otherwise -> do
            let args = case varray of
                  [PArray vargs] -> Vector.toList vargs
                  _ -> varray
            (x, _, _) <- interpretMonad rdr stt (resolveFunction' fname args)
            case x of
              Right o -> case o ^? _PValueNumber of
                Just n -> FR.toRuby n
                Nothing -> FR.toRuby o
              Left err -> rubyerr (show err)
      Left err -> rubyerr err
  
  computeTemplateWRuby :: TemplateSource -> Text -> Container ScopeInformation -> InterpreterState -> InterpreterReader IO -> IO TemplateAnswer
  computeTemplateWRuby fileinfo curcontext variables stt rdr = FR.freezeGC $ eitherDocIO $ do
    rscp <- FR.embedHaskellValue curcontext
    rvariables <- FR.embedHaskellValue variables
    rstt <- FR.embedHaskellValue stt
    rrdr <- FR.embedHaskellValue rdr
    let varlist = variables ^. ix curcontext . scopeVariables
    -- must be called from a "makeSafe" thingie
    contentinfo <- case fileinfo of
      Filename fname -> FR.toRuby (Text.pack fname)
      Inline _ -> FR.toRuby ("-" :: Text)
    let withBinding f =
          FR.safeMethodCall "ErbBinding" "new" [rscp, rvariables, rstt, rrdr, contentinfo] >>= \case
            Left x -> pure (Left x)
            Right v -> do
              forM_ (itoList varlist) $ \(varname, (varval :!: _) :!: _) -> FR.toRuby varval >>= FR.rb_iv_set v (toS varname)
              f v
    o <- case fileinfo of
      Filename fname -> do
        rfname <- FR.toRuby (Text.pack fname)
        withBinding $ \v -> FR.safeMethodCall "Controller" "runFromFile" [rfname, v]
      Inline content -> withBinding $ \v -> FR.toRuby content >>= FR.safeMethodCall "Controller" "runFromContent" . (: [v])
    FR.freeHaskellValue rrdr
    FR.freeHaskellValue rstt
    FR.freeHaskellValue rvariables
    FR.freeHaskellValue rscp
    case o of
      Left (err, _) ->
        pure (S.Left $ PrettyError (dullred (pptext err) <+> "in" <+> dullgreen (pptext (templateSrc fileinfo))))
      Right r ->
        FR.fromRuby r >>= \case
          Right result -> pure (S.Right result)
          Left err -> pure (S.Left $ PrettyError ("Could not deserialiaze ruby output" <+> pptext err))
  
  eitherDocIO :: IO (S.Either PrettyError a) -> IO (S.Either PrettyError a)
  eitherDocIO computation =
    (computation >>= check) `catch` (\e -> pure $ S.Left $ PrettyError $ dullred $ ppline $ show (e :: SomeException))
    where
      check (S.Left r) = pure (S.Left r)
      check (S.Right x) = pure (S.Right x)
  
  templateSrc :: TemplateSource -> String
  templateSrc = \case
    Inline _ -> "inline_template"
    Filename n -> n
  