Skip to content
Snippets Groups Projects
Commit 1338e4a1 authored by stuebinm's avatar stuebinm
Browse files

copy map assets (and refuse if any are missing)

parent 508f8885
Branches
No related tags found
No related merge requests found
......@@ -6,7 +6,7 @@
{-# LANGUAGE TupleSections #-}
-- | Module that contains high-level checking for an entire directory
module CheckDir (recursiveCheckDir, DirResult(..)) where
module CheckDir (recursiveCheckDir, DirResult(..), resultIsFatal) where
import CheckMap (MapResult (mapresultProvides),
loadAndLintMap, mapresultDepends)
......@@ -47,7 +47,7 @@ data DirResult = DirResult
, dirresultDeps :: [MissingDep]
-- ^ all dependencies to things outside this repository
, dirresultMissingAssets :: [MissingAsset]
-- ^ local things that are referred to but missing
-- ^ entrypoints of maps which are referred to but missing
} deriving (Generic)
data MissingDep = MissingDep
......@@ -57,6 +57,13 @@ data MissingDep = MissingDep
newtype MissingAsset = MissingAsset MissingDep
resultIsFatal :: DirResult -> Bool
resultIsFatal res =
not $ null (dirresultMissingAssets res)
instance ToJSON DirResult where
toJSON res = A.object
[ "missingDeps" .= dirresultDeps res
......
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Module for writing an already linted map Repository back out again.
module WriteRepo where
import CheckDir (DirResult (dirresultMaps))
import CheckMap (MapResult (mapresultAdjusted))
import CheckDir (DirResult (dirresultMaps),
resultIsFatal)
import CheckMap (MapResult (mapresultAdjusted, mapresultDepends))
import Control.Monad (forM_)
import Data.Aeson (encodeFile)
import Data.Map.Strict (toList)
import System.Directory.Extra (createDirectoryIfMissing)
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import qualified Data.Set as S
import Paths (normalise)
import System.Directory.Extra (copyFile, createDirectoryIfMissing)
import System.FilePath (takeDirectory)
import qualified System.FilePath as FP
import System.FilePath.Posix ((</>))
import Types (Dep (Local))
writeAdjustedRepository :: FilePath -> DirResult -> IO ()
writeAdjustedRepository outPath result = do
-- True here just means the equivalent of mkdir -p
writeAdjustedRepository :: FilePath -> FilePath -> DirResult -> IO ()
writeAdjustedRepository inPath outPath result
| resultIsFatal result = pure ()
| otherwise = do
createDirectoryIfMissing True outPath
-- write out all maps
......@@ -25,4 +33,23 @@ writeAdjustedRepository outPath result = do
(\(path,out) -> encodeFile (outPath </> path) $ mapresultAdjusted out)
(toList $ dirresultMaps result)
-- TODO: copy all assets
-- 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
......@@ -48,7 +48,7 @@ run options = do
lints <- recursiveCheckDir repo entry
case out options of
Just path -> writeAdjustedRepository path lints
Just outpath -> writeAdjustedRepository repo outpath lints
Nothing -> pure ()
if json options
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment