blob: af4d4d75a1cb1841094a8178086defa23d11fa70 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | 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
|
