summaryrefslogtreecommitdiff
path: root/lib/WriteRepo.hs
blob: 36c0df77dbb399dc057f7d52e9e8a7a3a34c9fee (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
64
65
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}


-- | Module for writing an already linted map Repository back out again.
module WriteRepo (writeAdjustedRepository) 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)
import           Data.Set               (Set)
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           System.FilePath        (takeDirectory)
import qualified System.FilePath        as FP
import           System.FilePath.Posix  ((</>))
import           Types                  (Dep (Local))



writeAdjustedRepository :: LintConfig' -> FilePath -> FilePath -> DirResult -> 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_ (toList $ 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)
                . toList $ 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