From 35566bf15f43c355bdc72d62841a850a90c8ba03 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 16 Sep 2021 02:27:26 +0200
Subject: moving lots of code around

(also renaming things now that concepts seem a bit clearer)
---
 lib/LintWriter.hs | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 lib/LintWriter.hs

(limited to 'lib/LintWriter.hs')

diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
new file mode 100644
index 0000000..0146366
--- /dev/null
+++ b/lib/LintWriter.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+-- | a monad that collects warnings, outputs, etc,
+module LintWriter where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Maybe (isJust, mapMaybe)
+import Control.Monad.Writer
+import Control.Monad.Trans.Maybe
+
+
+-- | Levels of errors and warnings, collectively called
+-- "Hints" until I can think of some better name
+data Level = Warning | Suggestion | Info | Forbidden | Error
+  deriving Show
+
+-- | a hint comes with an explanation (and a level)
+data Hint = Hint
+  { hintLevel :: Level
+  , hintMsg :: Text }
+  deriving Show
+
+-- shorter constructor
+hint level msg = Hint { hintLevel = level, hintMsg = msg }
+
+-- | 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 LintResult a = Either Hint (a, [Hint])
+
+-- | write a hint into the LintWriter monad
+lint :: Level -> Text -> LintWriter ()
+lint level = tell . (: []) . hint level
+
+warn = lint Warning
+info = lint Info
+forbid = lint Forbidden
+suggest = lint Suggestion
+complain = lint Error
+
+
+-- TODO: all these functions should probably also just operate on LintWriter
+
+-- | converts a Maybe to an Either, with a default value for Left
+unwrap :: b -> Maybe a  -> Either b a
+unwrap hint maybe = case maybe of
+  Just a -> Right a
+  Nothing -> Left hint
+
+-- | unwrap and produce a warning if the value was Nothing
+unwrapWarn :: Text -> Maybe a -> Either Hint a
+unwrapWarn msg = unwrap $ hint Warning msg
+
+-- | same as unwrapWarn, but for booleans
+assertWarn :: Text -> Bool -> LintWriter ()
+assertWarn msg cond = lift $ if cond then Right () else Left $ hint Warning msg
-- 
cgit v1.2.3