From ccb57f9a16b47aab55f786b976b0b8e89ff49f36 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 18 Sep 2021 23:21:15 +0200
Subject: collecting map dependencies

---
 lib/LintWriter.hs | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

(limited to 'lib/LintWriter.hs')

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
 
-- 
cgit v1.2.3