summaryrefslogtreecommitdiff
path: root/lib/LintWriter.hs
diff options
context:
space:
mode:
authorstuebinm2021-09-18 23:21:15 +0200
committerstuebinm2021-09-18 23:21:15 +0200
commitccb57f9a16b47aab55f786b976b0b8e89ff49f36 (patch)
treece757ccdf2eb0bfde8bcfc3cf28dab602cc5643b /lib/LintWriter.hs
parent0bd2e836d96fe864b00d2085f29e932130722cc3 (diff)
collecting map dependencies
Diffstat (limited to 'lib/LintWriter.hs')
-rw-r--r--lib/LintWriter.hs20
1 files changed, 18 insertions, 2 deletions
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index 66f16f1..055e2d4 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -12,6 +13,7 @@ import Control.Monad.Writer (MonadTrans (lift),
import Data.Aeson (ToJSON (toJSON))
import Data.Text (Text)
+import Data.Maybe (mapMaybe)
import Types
-- | a monad to collect hints. If it yields Left, then the
@@ -32,14 +34,24 @@ instance ToJSON a => ToJSON (LintResult a) where
where toJson' (Left hint) = toJSON [hint]
toJson' (Right (_, hints)) = toJSON hints
+lintToDep :: Lint -> Maybe Dep
+lintToDep = \case
+ Depends dep -> Just dep
+ _ -> Nothing
+
+lintsToDeps :: LintResult a -> [Dep]
+lintsToDeps (LintResult a) = case a of
+ Left (Depends dep) -> [dep]
+ Left _ -> []
+ Right (_, lints) -> mapMaybe lintToDep lints
-- | write a hint into the LintWriter monad
lint :: Level -> Text -> LintWriter ()
lint level = tell . (: []) . hint level
-require :: Text -> LintWriter ()
-require dep = tell . (: []) $ Depends (Dep dep)
+dependsOn :: Dep -> LintWriter ()
+dependsOn dep = tell . (: []) $ Depends dep
warn = lint Warning
info = lint Info
@@ -47,6 +59,10 @@ forbid = lint Forbidden
suggest = lint Suggestion
complain = lint Error
+dependsLocal = dependsOn . Local
+dependsLink = dependsOn . Link
+dependsMapService = dependsOn . MapLink
+
-- TODO: all these functions should probably also just operate on LintWriter