summaryrefslogtreecommitdiff
path: root/walint/WriteRepo.hs
diff options
context:
space:
mode:
authorstuebinm2023-10-23 23:18:34 +0200
committerstuebinm2023-10-24 01:21:52 +0200
commit9110064fe62f98dd3ecc5fb4c3915a843492b8fb (patch)
tree6a8e3d54bef365bf1c6c4f72a7a75dd5d1f05d40 /walint/WriteRepo.hs
parenta4461ce5d73a617e614e259bfe30b4e895c38a19 (diff)
a year went byHEADmain
This does many meta-things, but changes no functionality: - get rid of stack, and use just cabal with a stackage snapshot instead (why did I ever think stack was a good idea?) - update the stackage snapshot to something halfway recent - thus making builds work on nixpkgs-23.05 (current stable) - separating out packages into their own cabal files - use the GHC2021 set of extensions as default - very slight code changes to make things build again - update readme accordingly - stylish-haskell run
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