WriteRepo.hs

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}


-- | Module for writing an already linted map Repository back out again.
module WriteRepo (writeAdjustedRepository) where

import           Universum

import           CheckDir               (DirResult (..), resultIsFatal)
import           CheckMap               (MapResult (..), ResultKind (..))
import           Data.Aeson             (encodeFile)
import qualified Data.Set               as S
import           LintConfig             (LintConfig (configDontCopyAssets),
                                         LintConfig')
import           Paths                  (normalise)
import           System.Directory.Extra (copyFile, createDirectoryIfMissing,
                                         doesDirectoryExist)
import           System.Exit            (ExitCode (..))
import           System.FilePath        (takeDirectory)
import qualified System.FilePath        as FP
import           System.FilePath.Posix  ((</>))
import           Types                  (Dep (Local))


-- TODO: make this return a custom error type, not an exitcode
writeAdjustedRepository :: LintConfig' -> FilePath -> FilePath -> DirResult Full -> IO ExitCode
writeAdjustedRepository config inPath outPath result
  | resultIsFatal config result =
      pure (ExitFailure 1)
  | otherwise = do
      ifM (doesDirectoryExist outPath) (pure (ExitFailure 2)) $ do
        createDirectoryIfMissing True outPath

        -- write out all maps
        forM_ (toPairs $ dirresultMaps result) $ \(path,out) -> do
          createDirectoryIfMissing True (takeDirectory (outPath </> path))
          encodeFile (outPath </> path) $ mapresultAdjusted out

        unless (configDontCopyAssets config) $ do
          -- collect asset dependencies of maps
          -- TODO: its kinda weird doing that here, tbh
          let localdeps :: Set FilePath =
                S.fromList . concatMap
                  (\(mappath,mapresult) ->
                     let mapdir = takeDirectory mappath in
                     mapMaybe (\case
                       Local path -> Just . normalise mapdir $ path
                       _          -> Nothing)
                     $ mapresultDepends mapresult)
                . toPairs $ dirresultMaps result

          -- copy all assets
          forM_ localdeps $ \path ->
            let
              assetPath = FP.normalise $ inPath </> path
              newPath = FP.normalise $ outPath </> path
            in do
              createDirectoryIfMissing True (takeDirectory newPath)
              copyFile assetPath newPath

        pure ExitSuccess