From 9110064fe62f98dd3ecc5fb4c3915a843492b8fb Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 23 Oct 2023 23:18:34 +0200
Subject: a year went by

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
---
 walint/WriteRepo.hs | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 walint/WriteRepo.hs

(limited to 'walint/WriteRepo.hs')

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
-- 
cgit v1.2.3