{-# 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 qualified System.FilePath as FP import System.FilePath (takeDirectory) 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