diff options
author | stuebinm | 2021-11-14 03:17:10 +0100 |
---|---|---|
committer | stuebinm | 2021-11-14 03:17:10 +0100 |
commit | 0e5951eedebd2f0d3991454f7bcaf5f7f749cb06 (patch) | |
tree | 12678cc1fd69abdd38e0cf2633b2c05df252631e | |
parent | 52b73711fc21e121267318677840a54fbe174b10 (diff) |
config option: don't copy asset files
-rw-r--r-- | lib/LintConfig.hs | 9 | ||||
-rw-r--r-- | lib/WriteRepo.hs | 39 | ||||
-rw-r--r-- | src/Main.hs | 2 |
3 files changed, 28 insertions, 22 deletions
diff --git a/lib/LintConfig.hs b/lib/LintConfig.hs index 1493fe2..1b1b1bc 100644 --- a/lib/LintConfig.hs +++ b/lib/LintConfig.hs @@ -30,9 +30,10 @@ type family HKD f a where HKD f a = f a data LintConfig f = LintConfig - { configScriptInject :: HKD f (Maybe Text) - , configAssemblyTag :: HKD f Text - , configMaxWarnLevel :: HKD f Level + { configScriptInject :: HKD f (Maybe Text) + , configAssemblyTag :: HKD f Text + , configMaxWarnLevel :: HKD f Level + , configDontCopyAssets :: HKD f Bool } deriving (Generic) type LintConfig' = LintConfig Identity @@ -43,6 +44,7 @@ deriving instance , Show (HKD a Text) , Show (HKD a Level) , Show (HKD a [Text]) + , Show (HKD a Bool) ) => Show (LintConfig a) @@ -58,6 +60,7 @@ instance , FromJSON (HKD a [Text]) , FromJSON (HKD a Text) , FromJSON (HKD a Level) + , FromJSON (HKD a Bool) ) => FromJSON (LintConfig a) where diff --git a/lib/WriteRepo.hs b/lib/WriteRepo.hs index 1ed3a84..52f0736 100644 --- a/lib/WriteRepo.hs +++ b/lib/WriteRepo.hs @@ -8,12 +8,14 @@ module WriteRepo where import CheckDir (DirResult (dirresultMaps), resultIsFatal) import CheckMap (MapResult (mapresultAdjusted, mapresultDepends)) -import Control.Monad (forM_) +import Control.Monad (forM_, unless) 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) import System.Exit (ExitCode (..)) @@ -23,9 +25,9 @@ import System.FilePath.Posix ((</>)) import Types (Dep (Local)) -writeAdjustedRepository :: FilePath -> FilePath -> DirResult -> IO ExitCode -writeAdjustedRepository inPath outPath result - | resultIsFatal result = do +writeAdjustedRepository :: LintConfig' -> FilePath -> FilePath -> DirResult -> IO ExitCode +writeAdjustedRepository config inPath outPath result + | resultIsFatal result && not (configDontCopyAssets config) = do putStrLn "FATAL: Repository has missing assets; cannot write to outPath" pure (ExitFailure 1) | otherwise = do @@ -36,25 +38,26 @@ writeAdjustedRepository inPath outPath result (\(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 + 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 - putStrLn $ "copying " <> assetPath <> " → " <> newPath - copyFile assetPath newPath + . 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 pure ExitSuccess diff --git a/src/Main.hs b/src/Main.hs index a7710eb..d91aee3 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -67,7 +67,7 @@ run options = do else printPretty (level, lints) case out options of - Just outpath -> writeAdjustedRepository repo outpath lints + Just outpath -> writeAdjustedRepository lintconfig repo outpath lints >>= exitWith Nothing -> pure () |