diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/CheckDir.hs | 26 | ||||
| -rw-r--r-- | lib/LintConfig.hs | 2 | ||||
| -rw-r--r-- | lib/WriteRepo.hs | 11 |
3 files changed, 25 insertions, 14 deletions
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs index 4d81bc2..680039c 100644 --- a/lib/CheckDir.hs +++ b/lib/CheckDir.hs @@ -4,32 +4,33 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} -- | Module that contains high-level checking for an entire directory module CheckDir (recursiveCheckDir, DirResult(..), resultIsFatal) where -import CheckMap (MapResult (mapresultProvides), - loadAndLintMap, mapresultDepends) +import CheckMap (MapResult (..), loadAndLintMap) import Control.Monad (void) import Control.Monad.Extra (mapMaybeM) import Data.Aeson (ToJSON, (.=)) import qualified Data.Aeson as A import Data.Foldable (fold) import Data.Functor ((<&>)) -import Data.Map (Map) +import Data.Map (Map, elems, keys) import qualified Data.Map as M import Data.Map.Strict (mapKeys, (\\)) import Data.Maybe (mapMaybe) import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) -import LintConfig (LintConfig') +import LintConfig (LintConfig', configMaxLintLevel) import Paths (normalise, normaliseWithFrag) import System.Directory.Extra (doesFileExist) import System.FilePath (splitPath, (</>)) import qualified System.FilePath as FP import System.FilePath.Posix (takeDirectory) -import Types (Dep (Local, LocalMap), Level) +import Types (Dep (Local, LocalMap), Level (..), + hintLevel) import Util (PrettyPrint (prettyprint)) @@ -59,9 +60,18 @@ data MissingDep = MissingDep newtype MissingAsset = MissingAsset MissingDep -resultIsFatal :: DirResult -> Bool -resultIsFatal res = - not $ null (dirresultMissingAssets res) +resultIsFatal :: LintConfig' -> DirResult -> Bool +resultIsFatal config res = + (not (null (dirresultMissingAssets res))) + && (configMaxLintLevel config) <= maxObservedLevel + where maxObservedLevel = maximum + . map hintLevel + . concatMap keys + . map mapresultLayer + . elems + . dirresultMaps + $ res + diff --git a/lib/LintConfig.hs b/lib/LintConfig.hs index 5c1ae20..d237356 100644 --- a/lib/LintConfig.hs +++ b/lib/LintConfig.hs @@ -34,7 +34,7 @@ data LintConfig f = LintConfig -- ^ Link to Script that should be injected , configAssemblyTag :: HKD f Text -- ^ Assembly name (used for jitsiRoomAdminTag) - , configMaxWarnLevel :: HKD f Level + , configMaxLintLevel :: HKD f Level -- ^ Maximum warn level allowed before the lint fails , configDontCopyAssets :: HKD f Bool -- ^ Don't copy map assets (mostly useful for development) diff --git a/lib/WriteRepo.hs b/lib/WriteRepo.hs index 89e1bea..fbe139b 100644 --- a/lib/WriteRepo.hs +++ b/lib/WriteRepo.hs @@ -5,9 +5,8 @@ -- | Module for writing an already linted map Repository back out again. module WriteRepo where -import CheckDir (DirResult (dirresultMaps), - resultIsFatal) -import CheckMap (MapResult (mapresultAdjusted, mapresultDepends)) +import CheckDir (DirResult (..), resultIsFatal) +import CheckMap (MapResult (..)) import Control.Monad (forM_, unless) import Data.Aeson (encodeFile) import Data.Map.Strict (toList) @@ -25,11 +24,13 @@ import System.FilePath.Posix ((</>)) import Types (Dep (Local)) + 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" + | resultIsFatal config result = pure (ExitFailure 1) + | not (configDontCopyAssets config) = + pure (ExitSuccess) | otherwise = do createDirectoryIfMissing True outPath |