-- |
-- Mostly effectful functions to assemble artifacts.
module B9.Artifact.Readable.Interpreter
  ( buildArtifacts,
    assemble,
    getArtifactOutputFiles,
    runArtifactGenerator,
    runArtifactAssembly,
    InstanceGenerator (..),
    runInstanceGenerator,
    InstanceSources (..),
  )
where

import B9.Artifact.Content
import B9.Artifact.Content.Readable
import B9.Artifact.Content.StringTemplate
import B9.Artifact.Readable
import B9.B9Config
import B9.B9Error
import B9.B9Exec
import B9.B9Logging
import B9.B9Monad
import B9.BuildInfo
import B9.DiskImageBuilder
import B9.Environment
import B9.Text
import B9.Vm
import B9.VmBuilder
import Control.Arrow
import Control.Eff as Eff
import Control.Eff.Reader.Lazy as Eff
import Control.Eff.Writer.Lazy as Eff
import Control.Exception
  ( SomeException,
    displayException,
  )
import Control.Monad
import Control.Monad.IO.Class
import Data.Data
import Data.Generics.Aliases
import Data.Generics.Schemes
import Data.List
import Data.String
import System.Directory
import System.FilePath
import System.IO.B9Extras
  ( ensureDir,
    getDirectoryFiles,
  )
import Text.Printf
import Text.Show.Pretty (ppShow)

-- | Execute an 'ArtifactGenerator' and return a 'B9Invocation' that returns
-- the build id obtained by 'getBuildId'.
buildArtifacts :: ArtifactGenerator -> B9 String
buildArtifacts artifactGenerator = do
  traceL . ("CWD: " ++) =<< liftIO getCurrentDirectory
  infoL "BUILDING ARTIFACTS"
  getConfig >>= traceL . printf "USING BUILD CONFIGURATION: %v" . ppShow
  _ <- assemble artifactGenerator
  getBuildId

-- | Return a list of relative paths for the /local/ files to be generated
-- by the ArtifactGenerator. This excludes 'Shared' and Transient image targets.
getArtifactOutputFiles :: ArtifactGenerator -> Either SomeException [FilePath]
getArtifactOutputFiles g =
  concatMap getOutputs
    <$> runArtifactGenerator mempty "no build-id" "no build-date" g
  where
    getOutputs (IG _ sgs a) =
      let toOutFile (AssemblyGeneratesOutputFiles fs) = fs
          toOutFile (AssemblyCopiesSourcesToDirectory pd) =
            let sourceFiles = textFileWriterOutputFile <$> sgs
             in (pd </>) <$> sourceFiles
       in getAssemblyOutput a >>= toOutFile

-- | Run an artifact generator to produce the artifacts.
assemble :: ArtifactGenerator -> B9 [AssembledArtifact]
assemble artGen = do
  b9cfgEnvVars <- askEnvironment
  buildId <- getBuildId
  buildDate <- getBuildDate
  runArtifactSourcesReader (InstanceSources b9cfgEnvVars mempty) $ do
    is <- evalArtifactGenerator buildId buildDate artGen
    createAssembledArtifacts is

-- | Interpret an 'ArtifactGenerator' into a list of simple commands, i.e. 'InstanceGenerator's
--
-- @since 0.5.65
runArtifactGenerator ::
  Environment ->
  String ->
  String ->
  ArtifactGenerator ->
  Either SomeException [InstanceGenerator [TextFileWriter]]
runArtifactGenerator initialEnvironment buildId buildData generator =
  Eff.run
    ( runExcB9
        ( runEnvironmentReader
            initialEnvironment
            ( runArtifactSourcesReader
                (InstanceSources initialEnvironment mempty)
                (evalArtifactGenerator buildId buildData generator)
            )
        )
    )

-- | Evaluate an 'ArtifactGenerator' into a list of low-level build instructions
-- that can be built with 'createAssembledArtifacts'.
evalArtifactGenerator ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  String ->
  String ->
  ArtifactGenerator ->
  Eff
    (ArtifactSourcesReader ': e)
    [InstanceGenerator [TextFileWriter]]
evalArtifactGenerator buildId buildDate artGen =
  withSubstitutedStringBindings
    [(buildDateKey, buildDate), (buildIdKey, buildId)]
    (runArtifactInterpreter (interpretGenerator artGen))
    `catchB9Error` ( throwB9Error
                       . printf "Failed to eval:\n%s\nError: %s" (ppShow artGen)
                       . displayException
                   )

type ArtifactSourcesReader = Reader [ArtifactSource]

runArtifactSourcesReader ::
  Member EnvironmentReader e =>
  InstanceSources ->
  Eff (ArtifactSourcesReader ': e) a ->
  Eff e a
runArtifactSourcesReader x y =
  runReader (isSources x) (localEnvironment (const (isEnv x)) y)

-- | Monad for creating Instance generators.
type ArtifactInterpreter e =
  Writer [InstanceGenerator InstanceSources] : ArtifactSourcesReader : e

runArtifactInterpreter ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  Eff (ArtifactInterpreter e) () ->
  Eff (ArtifactSourcesReader : e) [InstanceGenerator [TextFileWriter]]
runArtifactInterpreter ai = do
  ((), igs) <- runMonoidWriter ai
  traverse toFileInstanceGenerator igs

-- | Parse an 'ArtifactGenerator' inside the 'ArtifactInterpreter' effect.
interpretGenerator ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  ArtifactGenerator ->
  Eff (ArtifactInterpreter e) ()
interpretGenerator generatorIn = case generatorIn of
  Sources sources generators ->
    withArtifactSources sources (mapM_ interpretGenerator generators)
  Let bindings generators ->
    withSubstitutedStringBindings bindings (mapM_ interpretGenerator generators)
  LetX bindings generators ->
    withXBindings bindings (mapM_ interpretGenerator generators)
  EachT keySet valueSets generators -> do
    allBindings <- eachBindingSetT generatorIn keySet valueSets
    sequence_
      ( flip withSubstitutedStringBindings (mapM_ interpretGenerator generators)
          <$> allBindings
      )
  Each kvs generators -> do
    allBindings <- eachBindingSet generatorIn kvs
    sequence_ $ do
      b <- allBindings
      return
        (withSubstitutedStringBindings b (mapM_ interpretGenerator generators))
  Artifact iid assembly -> interpretAssembly iid assembly
  EmptyArtifact -> return ()
  where
    withArtifactSources ::
      (Member ExcB9 e, Member EnvironmentReader e) =>
      [ArtifactSource] ->
      Eff (ArtifactInterpreter e) s ->
      Eff (ArtifactInterpreter e) s
    withArtifactSources sources = local (++ sources)
    withXBindings ::
      (Member ExcB9 e, Member EnvironmentReader e) =>
      [(String, [String])] ->
      Eff (ArtifactInterpreter e) () ->
      Eff (ArtifactInterpreter e) ()
    withXBindings bindings cp =
      (`withSubstitutedStringBindings` cp)
        `mapM_` allXBindings bindings
      where
        allXBindings ((k, vs) : rest) =
          [(k, v) : c | v <- vs, c <- allXBindings rest]
        allXBindings [] = [[]]
    eachBindingSetT ::
      (Member ExcB9 e) =>
      ArtifactGenerator ->
      [String] ->
      [[String]] ->
      Eff (ArtifactInterpreter e) [[(String, String)]]
    eachBindingSetT g vars valueSets =
      if all ((== length vars) . length) valueSets
        then return (zip vars <$> valueSets)
        else
          throwB9Error
            ( printf
                "Error in 'Each' binding during artifact generation in:\n '%s'.\n\nThe variable list\n%s\n has %i entries, but this binding set\n%s\n\nhas a different number of entries!\n"
                (ppShow g)
                (ppShow vars)
                (length vars)
                (ppShow (head (dropWhile ((== length vars) . length) valueSets)))
            )
    eachBindingSet ::
      (Member ExcB9 e) =>
      ArtifactGenerator ->
      [(String, [String])] ->
      Eff (ArtifactInterpreter e) [[(String, String)]]
    eachBindingSet g kvs = do
      checkInput
      return bindingSets
      where
        bindingSets = transpose [repeat k `zip` vs | (k, vs) <- kvs]
        checkInput =
          when
            (1 /= length (nub $ length . snd <$> kvs))
            ( throwB9Error
                ( printf
                    "Error in 'Each' binding: \n%s\nAll value lists must have the same length!"
                    (ppShow g)
                )
            )

interpretAssembly ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  InstanceId ->
  ArtifactAssembly ->
  Eff (ArtifactInterpreter e) ()
interpretAssembly (IID iidStrTemplate) assembly = do
  iid@(IID iidStr) <- IID <$> substStr iidStrTemplate
  env <- InstanceSources <$> askEnvironment <*> ask
  withSubstitutedStringBindings
    [(fromString instanceIdKey, fromString iidStr)]
    (tell [IG iid env assembly])

-- | Internal data structure. Only exposed for unit testing.
data InstanceSources
  = InstanceSources
      { isEnv :: Environment,
        isSources :: [ArtifactSource]
      }
  deriving (Show, Eq)

data InstanceGenerator e
  = IG
      InstanceId
      e
      ArtifactAssembly
  deriving (Read, Show, Typeable, Data, Eq)

toFileInstanceGenerator ::
  Member ExcB9 e =>
  InstanceGenerator InstanceSources ->
  Eff e (InstanceGenerator [TextFileWriter])
toFileInstanceGenerator (IG iid (InstanceSources env sources) assembly) =
  runEnvironmentReader env $ do
    assembly' <- substAssembly assembly
    sourceGenerators <- join <$> traverse toSourceGen sources
    pure (IG iid sourceGenerators assembly')

substAssembly ::
  forall e.
  (Member ExcB9 e, Member EnvironmentReader e) =>
  ArtifactAssembly ->
  Eff e ArtifactAssembly
substAssembly = everywhereM gsubst
  where
    gsubst :: Data a => a -> Eff e a
    gsubst = mkM substAssembly_ `extM` substImageTarget `extM` substVmScript
    substAssembly_ (CloudInit ts f) = CloudInit ts <$> substStr f
    substAssembly_ vm = pure vm

toSourceGen ::
  (Member ExcB9 e, Member EnvironmentReader e) =>
  ArtifactSource ->
  Eff e [TextFileWriter]
toSourceGen src = do
  env <- askEnvironment
  case src of
    FromFile t (Source conv f) -> do
      t' <- substStr t
      f' <- substStr f
      return
        [ MkTextFileWriter
            env
            (ExternalFiles [Source conv f'])
            KeepPermissions
            t'
        ]
    FromContent t c -> do
      t' <- substStr t
      return [MkTextFileWriter env (StaticContent c) KeepPermissions t']
    SetPermissions o g a src' -> do
      sgs <- join <$> mapM toSourceGen src'
      traverse (setFilePermissionAction o g a) sgs
    FromDirectory fromDir src' -> do
      sgs <- join <$> mapM toSourceGen src'
      fromDir' <- substStr fromDir
      return (prefixExternalSourcesPaths fromDir' <$> sgs)
    IntoDirectory toDir src' -> do
      sgs <- join <$> mapM toSourceGen src'
      toDir' <- substStr toDir
      return (prefixOutputFilePaths toDir' <$> sgs)

createAssembledArtifacts ::
  IsB9 e => [InstanceGenerator [TextFileWriter]] -> Eff e [AssembledArtifact]
createAssembledArtifacts igs = do
  buildDir <- getBuildDir
  let outDir = buildDir </> "artifact-instances"
  ensureDir (outDir ++ "/")
  generated <- generateSources outDir `mapM` igs
  runInstanceGenerator `mapM` generated

generateSources ::
  IsB9 e =>
  FilePath ->
  InstanceGenerator [TextFileWriter] ->
  Eff e (InstanceGenerator FilePath)
generateSources outDir (IG iid sgs assembly) = do
  uiid@(IID uiidStr) <- generateUniqueIID iid
  dbgL (printf "generating sources for %s" uiidStr)
  let instanceDir = outDir </> uiidStr
  traceL (printf "generating sources for %s:\n%s\n" uiidStr (ppShow sgs))
  generateSourceTo instanceDir `mapM_` sgs
  return (IG uiid instanceDir assembly)

-- | Run an
runInstanceGenerator ::
  IsB9 e => InstanceGenerator FilePath -> Eff e AssembledArtifact
runInstanceGenerator (IG uiid@(IID uiidStr) instanceDir assembly) = do
  targets <- runArtifactAssembly uiid instanceDir assembly
  dbgL (printf "assembled artifact %s" uiidStr)
  return (AssembledArtifact uiid targets)

generateUniqueIID :: IsB9 e => InstanceId -> Eff e InstanceId
generateUniqueIID (IID iid) = IID . printf "%s-%s" iid <$> getBuildId

generateSourceTo :: IsB9 e => FilePath -> TextFileWriter -> Eff e ()
generateSourceTo instanceDir (MkTextFileWriter env sgSource p to) =
  localEnvironment (const env) $ do
    let toAbs = instanceDir </> to
    ensureDir toAbs
    result <- case sgSource of
      ExternalFiles froms -> do
        sources <- mapM readTemplateFile froms
        return (mconcat sources)
      StaticContent c -> toContentGenerator c
    traceL (printf "rendered: \n%s\n" result)
    liftIO (writeTextFile toAbs result)
    runFilePermissionAction toAbs p

runFilePermissionAction ::
  IsB9 e => FilePath -> FilePermissionAction -> Eff e ()
runFilePermissionAction _ KeepPermissions = return ()
runFilePermissionAction f (ChangePermissions (o, g, a)) =
  cmd (printf "chmod 0%i%i%i '%s'" o g a f)

-- | Internal data type simplifying the rather complex source generation by
--   boiling down 'ArtifactSource's to a flat list of uniform 'TextFileWriter's.
data TextFileWriter
  = MkTextFileWriter
      Environment
      TextFileWriterInput
      FilePermissionAction
      FilePath
  deriving (Show, Eq)

-- | Return the (internal-)output file of the source file that is generated.
textFileWriterOutputFile :: TextFileWriter -> FilePath
textFileWriterOutputFile (MkTextFileWriter _ _ _ f) = f

data TextFileWriterInput
  = ExternalFiles [SourceFile]
  | StaticContent Content
  deriving (Read, Show, Eq)

data FilePermissionAction
  = ChangePermissions (Int, Int, Int)
  | KeepPermissions
  deriving (Read, Show, Typeable, Data, Eq)

setFilePermissionAction ::
  Member ExcB9 e =>
  Int ->
  Int ->
  Int ->
  TextFileWriter ->
  Eff e TextFileWriter
setFilePermissionAction o g a (MkTextFileWriter env from KeepPermissions dest) =
  pure (MkTextFileWriter env from (ChangePermissions (o, g, a)) dest)
setFilePermissionAction o g a sg
  | o < 0 || o > 7 =
    throwB9Error
      (printf "Bad 'owner' permission %i in \n%s" o (ppShow sg))
  | g < 0 || g > 7 =
    throwB9Error
      (printf "Bad 'group' permission %i in \n%s" g (ppShow sg))
  | a < 0 || a > 7 =
    throwB9Error
      (printf "Bad 'all' permission %i in \n%s" a (ppShow sg))
  | otherwise =
    throwB9Error
      (printf "Permission for source already defined:\n %s" (ppShow sg))

prefixExternalSourcesPaths :: FilePath -> TextFileWriter -> TextFileWriter
prefixExternalSourcesPaths fromDir (MkTextFileWriter e (ExternalFiles fs) p d) =
  MkTextFileWriter e (ExternalFiles (prefixExternalSourcePaths <$> fs)) p d
  where
    prefixExternalSourcePaths (Source t f) = Source t (fromDir </> f)
prefixExternalSourcesPaths _fromDir sg = sg

prefixOutputFilePaths :: FilePath -> TextFileWriter -> TextFileWriter
prefixOutputFilePaths toDir (MkTextFileWriter e fs p d) =
  MkTextFileWriter e fs p (toDir </> d)

-- | Create the 'ArtifactTarget' from an 'ArtifactAssembly' in the directory @instanceDir@
--
-- @since 0.5.65
runArtifactAssembly ::
  IsB9 e =>
  InstanceId ->
  FilePath ->
  ArtifactAssembly ->
  Eff e [ArtifactTarget]
runArtifactAssembly iid instanceDir (VmImages imageTargets vmScript) = do
  dbgL (printf "Creating VM-Images in '%s'" instanceDir)
  success <- buildWithVm iid imageTargets instanceDir vmScript
  let err_msg = printf "Error creating 'VmImages' for instance '%s'" iidStr
      (IID iidStr) = iid
  unless success (errorL err_msg >> error err_msg)
  return [VmImagesTarget]
runArtifactAssembly _ instanceDir (CloudInit types outPath) =
  mapM
    create_
    types
  where
    create_ CI_DIR = do
      let ciDir = outPath
      ensureDir (ciDir ++ "/")
      dbgL (printf "creating directory '%s'" ciDir)
      files <- getDirectoryFiles instanceDir
      traceL (printf "copying files: %s" (show files))
      liftIO
        ( mapM_
            ( \(f, t) -> do
                ensureDir t
                copyFile f t
            )
            (((instanceDir </>) &&& (ciDir </>)) <$> files)
        )
      infoL (printf "CREATED CI_DIR: '%s'" (takeFileName ciDir))
      return (CloudInitTarget CI_DIR ciDir)
    create_ CI_ISO = do
      buildDir <- getBuildDir
      let isoFile = outPath <.> "iso"
          tmpFile = buildDir </> takeFileName isoFile
      ensureDir tmpFile
      dbgL
        ( printf
            "creating cloud init iso temp image '%s', destination file: '%s"
            tmpFile
            isoFile
        )
      cmd
        ( printf
            "genisoimage -output '%s' -volid cidata -rock -d '%s' 2>&1"
            tmpFile
            instanceDir
        )
      dbgL (printf "moving iso image '%s' to '%s'" tmpFile isoFile)
      ensureDir isoFile
      liftIO (copyFile tmpFile isoFile)
      infoL (printf "CREATED CI_ISO IMAGE: '%s'" (takeFileName isoFile))
      return (CloudInitTarget CI_ISO isoFile)
    create_ CI_VFAT = do
      buildDir <- getBuildDir
      let vfatFile = outPath <.> "vfat"
          tmpFile = buildDir </> takeFileName vfatFile
      ensureDir tmpFile
      files <- map (instanceDir </>) <$> getDirectoryFiles instanceDir
      dbgL (printf "creating cloud init vfat image '%s'" tmpFile)
      traceL (printf "adding '%s'" (show files))
      cmd (printf "truncate --size 2M '%s'" tmpFile)
      cmd (printf "mkfs.vfat -n cidata '%s' 2>&1" tmpFile)
      cmd
        ( unwords (printf "mcopy -oi '%s' " tmpFile : (printf "'%s'" <$> files))
            ++ " ::"
        )
      dbgL (printf "moving vfat image '%s' to '%s'" tmpFile vfatFile)
      ensureDir vfatFile
      liftIO (copyFile tmpFile vfatFile)
      infoL (printf "CREATED CI_VFAT IMAGE: '%s'" (takeFileName vfatFile))
      return (CloudInitTarget CI_ISO vfatFile)