summaryrefslogtreecommitdiff
path: root/lib/WriteRepo.hs
diff options
context:
space:
mode:
authorstuebinm2021-11-28 22:24:30 +0100
committerstuebinm2021-11-28 22:26:48 +0100
commitefb64e0228c19ef7936446d3ca14a7d7a6e2540b (patch)
treeb9988c843847ed19e1e9fce2f3072a318f489f81 /lib/WriteRepo.hs
parenta683b00fa1bc506be76919f4f0b166e595ef7a5b (diff)
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
Diffstat (limited to '')
-rw-r--r--lib/WriteRepo.hs59
1 files changed, 30 insertions, 29 deletions
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