From efb64e0228c19ef7936446d3ca14a7d7a6e2540b Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 28 Nov 2021 22:24:30 +0100
Subject: various fixes to bugs

Among them
 - always set correct exit codes
 - refuse to write out files if the out path already exists
 - calculate the overall severity correctly
 - slightly changed the json output schema
 - also output the text output format in json
 - make the default config.json suitable for a production environment
---
 lib/WriteRepo.hs | 59 ++++++++++++++++++++++++++++----------------------------
 1 file changed, 30 insertions(+), 29 deletions(-)

(limited to 'lib/WriteRepo.hs')

diff --git a/lib/WriteRepo.hs b/lib/WriteRepo.hs
index fbe139b..7e3e5f2 100644
--- a/lib/WriteRepo.hs
+++ b/lib/WriteRepo.hs
@@ -8,6 +8,7 @@ module WriteRepo where
 import           CheckDir               (DirResult (..), resultIsFatal)
 import           CheckMap               (MapResult (..))
 import           Control.Monad          (forM_, unless)
+import           Control.Monad.Extra    (ifM)
 import           Data.Aeson             (encodeFile)
 import           Data.Map.Strict        (toList)
 import           Data.Maybe             (mapMaybe)
@@ -16,7 +17,8 @@ import qualified Data.Set               as S
 import           LintConfig             (LintConfig (configDontCopyAssets),
                                          LintConfig')
 import           Paths                  (normalise)
-import           System.Directory.Extra (copyFile, createDirectoryIfMissing)
+import           System.Directory.Extra (copyFile, createDirectoryIfMissing,
+                                         doesDirectoryExist)
 import           System.Exit            (ExitCode (..))
 import           System.FilePath        (takeDirectory)
 import qualified System.FilePath        as FP
@@ -29,36 +31,35 @@ writeAdjustedRepository :: LintConfig' -> FilePath -> FilePath -> DirResult -> I
 writeAdjustedRepository config inPath outPath result
   | resultIsFatal config result =
       pure (ExitFailure 1)
-  | not (configDontCopyAssets config) =
-      pure (ExitSuccess)
   | otherwise = do
-      createDirectoryIfMissing True outPath
+      ifM (doesDirectoryExist outPath) (pure (ExitFailure 2)) $ do
+        createDirectoryIfMissing True outPath
 
-      -- write out all maps
-      mapM_
-        (\(path,out) -> encodeFile (outPath </> path) $ mapresultAdjusted out)
-        (toList $ dirresultMaps result)
+        -- write out all maps
+        mapM_
+          (\(path,out) -> encodeFile (outPath </> path) $ mapresultAdjusted out)
+          (toList $ dirresultMaps result)
 
-      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)
-              . toList $ dirresultMaps result
+        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)
+                . toList $ dirresultMaps result
 
-        -- copy all assets
-        forM_ localdeps $ \path ->
-          let
-            assetPath = FP.normalise $ inPath </> path
-            newPath = FP.normalise $ outPath </> path
-          in do
-            -- putStrLn $ "copying " <> assetPath <> " → " <> newPath
-            copyFile assetPath newPath
+          -- 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
+        pure ExitSuccess
-- 
cgit v1.2.3