summaryrefslogtreecommitdiff
path: root/lib/CheckDir.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/CheckDir.hs')
-rw-r--r--lib/CheckDir.hs13
1 files changed, 8 insertions, 5 deletions
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index b9a3a31..652d58f 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -10,6 +10,7 @@
module CheckDir (maximumLintLevel, recursiveCheckDir, DirResult(..), MissingAsset(..), MissingDep(..), resultIsFatal) where
import CheckMap (MapResult (..), loadAndLintMap)
+import Control.DeepSeq (NFData)
import Control.Monad (void)
import Control.Monad.Extra (mapMaybeM)
import Data.Aeson (ToJSON, (.=))
@@ -36,6 +37,7 @@ import Types (Dep (Local, LocalMap), Hint (Hint),
Level (..), hintLevel)
import Util (PrettyPrint (prettyprint))
+
-- based on the startling observation that Data.Map has lower complexity
-- for difference than Data.Set, but the same complexity for fromList
type Set a = Map a ()
@@ -52,19 +54,20 @@ data DirResult = DirResult
-- ^ all dependencies to things outside this repository
, dirresultMissingAssets :: [MissingAsset]
-- ^ entrypoints of maps which are referred to but missing
- , dirresultGraph :: Dot ()
- } deriving (Generic)
+ , dirresultGraph :: Text
+ } deriving (Generic, NFData)
data MissingDep = MissingDep
{ depFatal :: Maybe Bool
, entrypoint :: Text
, neededBy :: [FilePath]
- } deriving (Generic, ToJSON)
+ } deriving (Generic, ToJSON, NFData)
-- | Missing assets are the same thing as missing dependencies,
-- but should not be confused (and also serialise differently
-- to json)
newtype MissingAsset = MissingAsset MissingDep
+ deriving (Generic, NFData)
-- | given this config, should the result be considered to have failed?
resultIsFatal :: LintConfig' -> DirResult -> Bool
@@ -97,7 +100,7 @@ instance ToJSON DirResult where
[ "missingDeps" .= dirresultDeps res
, "missingAssets" .= dirresultMissingAssets res
, "mapLints" .= dirresultMaps res
- , "exitGraph" .= showDot (dirresultGraph res)
+ , "exitGraph" .= dirresultGraph res
]
, "severity" .= maximumLintLevel res
, "mapInfo" .= fmap (\tm -> A.object [ "badges" .= mapresultBadges tm ])
@@ -163,7 +166,7 @@ recursiveCheckDir config prefix root = do
pure $ DirResult { dirresultDeps = missingDeps root maps'
, dirresultMissingAssets = mAssets
, dirresultMaps = maps'
- , dirresultGraph = graphToDot exitGraph
+ , dirresultGraph = T.pack $ showDot $ graphToDot exitGraph
}