From 1c82540aeea7636a6cfd25acfdd28c1029f5669f Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 18 Sep 2021 01:59:00 +0200
Subject: can collect dependencies!

There's now a Lint type, which may be either a "true lint" (which is a
Hint, which contains some message and level of severity), or a Depends,
which indicates that this map depends on some ressource or other (and is
otherwise treated as a special info Hint in all other cases)
---
 lib/LintWriter.hs | 47 +++++++++++++++++++++++++++++++++++++----------
 1 file changed, 37 insertions(+), 10 deletions(-)

(limited to 'lib/LintWriter.hs')

diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index 09a2297..bfe543e 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -9,39 +9,63 @@ module LintWriter where
 import           Control.Monad.Trans.Maybe ()
 import           Control.Monad.Writer      (MonadTrans (lift),
                                             MonadWriter (tell), WriterT)
-import           Data.Aeson                (ToJSON (toJSON))
+import           Data.Aeson                (ToJSON (toJSON), (.=))
 import           Data.Text                 (Text)
 import           GHC.Generics              (Generic)
 
-import Util (PrettyPrint(..), showText)
+import qualified Data.Aeson                as A
+import           Util                      (PrettyPrint (..), showText)
 
 -- | Levels of errors and warnings, collectively called
 -- "Hints" until I can think of some better name
 data Level = Warning | Suggestion | Info | Forbidden | Error | Fatal
   deriving (Show, Generic, ToJSON)
 
--- | a hint comes with an explanation (and a level)
+-- | a hint comes with an explanation (and a level), or is a dependency
+-- (in which case it'll be otherwise treated as an info hint)
+data Lint = Depends Dep | Lint Hint
+
 data Hint = Hint
   { hintLevel :: Level
   , hintMsg   :: Text
   } deriving (Generic, ToJSON)
 
-instance PrettyPrint Hint where
-  prettyprint Hint { hintMsg, hintLevel } =
+lintLevel :: Lint -> Level
+lintLevel (Lint h)      = hintLevel h
+lintLevel (Depends dep) = Info
+
+instance PrettyPrint Lint where
+  prettyprint (Lint  Hint { hintMsg, hintLevel } ) =
     showText hintLevel <> ": " <> hintMsg
+  prettyprint (Depends dep) =
+    "Info: found dependency: " <> prettyprint dep
+
+instance ToJSON Lint where
+  toJSON (Lint l) = toJSON l
+  toJSON (Depends dep) = A.object
+    [ "hintMsg" .= prettyprint dep
+    , "hintLevel" .= A.String "Dependency Info" ]
+
 
 -- shorter constructor
-hint :: Level -> Text -> Hint
-hint level msg = Hint { hintLevel = level, hintMsg = msg }
+hint :: Level -> Text -> Lint
+hint level msg = Lint Hint { hintLevel = level, hintMsg = msg }
+
+-- | TODO: add a reasonable representation of possible urls
+newtype Dep = Dep Text
+  deriving (Generic, ToJSON)
+
+instance PrettyPrint Dep where
+  prettyprint (Dep txt) = txt
 
 -- | a monad to collect hints. If it yields Left, then the
 -- map is flawed in some fundamental way which prevented us
 -- from getting any hints at all except whatever broke it
-type LintWriter a = WriterT [Hint] (Either Hint) a
+type LintWriter a = WriterT [Lint] (Either Lint) a
 
 -- this is wrapped in a newtype because Aeson is silly and wants
 -- to serialise Either as { "Right" : … } or { "Left" : … } ...
-type LintResult' a = Either Hint (a, [Hint])
+type LintResult' a = Either Lint (a, [Lint])
 newtype LintResult a = LintResult (LintResult' a)
 
 -- better, less confusing serialisation of an Either Hint (a, [Hint]).
@@ -58,6 +82,9 @@ instance ToJSON a => ToJSON (LintResult a) where
 lint :: Level -> Text -> LintWriter ()
 lint level = tell . (: []) . hint level
 
+require :: Text -> LintWriter ()
+require dep = tell . (: []) $ Depends (Dep dep)
+
 warn = lint Warning
 info = lint Info
 forbid = lint Forbidden
@@ -74,7 +101,7 @@ unwrap hint maybe = case maybe of
   Nothing -> Left hint
 
 -- | unwrap and produce a warning if the value was Nothing
-unwrapWarn :: Text -> Maybe a -> Either Hint a
+unwrapWarn :: Text -> Maybe a -> Either Lint a
 unwrapWarn msg = unwrap $ hint Warning msg
 
 -- | same as unwrapWarn, but for booleans
-- 
cgit v1.2.3