diff options
| -rw-r--r-- | lib/CheckDir.hs | 11 | ||||
| -rw-r--r-- | lib/WriteRepo.hs | 67 | ||||
| -rw-r--r-- | src/Main.hs | 2 |
3 files changed, 57 insertions, 23 deletions
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs index 68bcefe..5540aae 100644 --- a/lib/CheckDir.hs +++ b/lib/CheckDir.hs @@ -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 diff --git a/lib/WriteRepo.hs b/lib/WriteRepo.hs index 5e695f5..c0bf31b 100644 --- a/lib/WriteRepo.hs +++ b/lib/WriteRepo.hs @@ -1,28 +1,55 @@ - +{-# 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 ((</>)) - - - -writeAdjustedRepository :: FilePath -> DirResult -> IO () -writeAdjustedRepository outPath result = do - - -- True here just means the equivalent of mkdir -p - createDirectoryIfMissing True outPath - - -- write out all maps - mapM_ - (\(path,out) -> encodeFile (outPath </> path) $ mapresultAdjusted out) - (toList $ dirresultMaps result) - - -- TODO: copy all assets +import Types (Dep (Local)) + + +writeAdjustedRepository :: FilePath -> FilePath -> DirResult -> IO () +writeAdjustedRepository inPath outPath result + | resultIsFatal result = pure () + | otherwise = do + createDirectoryIfMissing True outPath + + -- write out all maps + mapM_ + (\(path,out) -> encodeFile (outPath </> path) $ mapresultAdjusted out) + (toList $ dirresultMaps result) + + -- 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 diff --git a/src/Main.hs b/src/Main.hs index 8cbfe7d..1862c5b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 |