diff options
author | stuebinm | 2023-10-23 23:18:34 +0200 |
---|---|---|
committer | stuebinm | 2023-10-24 01:21:52 +0200 |
commit | 9110064fe62f98dd3ecc5fb4c3915a843492b8fb (patch) | |
tree | 6a8e3d54bef365bf1c6c4f72a7a75dd5d1f05d40 /walint/WriteRepo.hs | |
parent | a4461ce5d73a617e614e259bfe30b4e895c38a19 (diff) |
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.hs | 62 |
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 |