summaryrefslogtreecommitdiff
path: root/walint/WriteRepo.hs
diff options
context:
space:
mode:
Diffstat (limited to 'walint/WriteRepo.hs')
-rw-r--r--walint/WriteRepo.hs62
1 files changed, 62 insertions, 0 deletions
diff --git a/walint/WriteRepo.hs b/walint/WriteRepo.hs
new file mode 100644
index 0000000..325b301
--- /dev/null
+++ b/walint/WriteRepo.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+
+
+-- | 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