From 68af04a4da6ba4ec61d1469337ce53457526d861 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 23 Sep 2021 04:34:02 +0200
Subject: prettier pretty printing and stuff

also, configurable log level, which only required relaxing the type
system once!
---
 lib/Types.hs | 28 ++++++++++++++++++++++++----
 1 file changed, 24 insertions(+), 4 deletions(-)

(limited to 'lib/Types.hs')

diff --git a/lib/Types.hs b/lib/Types.hs
index 5ec91a0..b609012 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -17,11 +17,31 @@ import           GHC.Generics              (Generic)
 import qualified Data.Aeson                as A
 import           Paths                     (RelPath)
 import           Util                      (PrettyPrint (..), showText)
+import           WithCli                   (Argument, Proxy (..),
+                                            atomicArgumentsParser)
+import           WithCli.Pure              (Argument (argumentType, parseArgument),
+                                            HasArguments (argumentsParser))
+
 
 -- | 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)
+data Level = Info | Suggestion | Warning | Forbidden | Error | Fatal
+  deriving (Show, Generic, ToJSON, Ord, Eq, A.FromJSON)
+
+instance Argument Level where
+  argumentType Proxy = "Lint Level"
+  parseArgument arg = case arg of
+    "info"       -> Just Info
+    "suggestion" -> Just Suggestion
+    "warning"    -> Just Warning
+    "forbidden"  -> Just Forbidden
+    "error"      -> Just Error
+    "fatal"      -> Just Fatal
+    _            -> Nothing
+
+
+instance HasArguments Level where
+   argumentsParser = atomicArgumentsParser
 
 -- | 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)
@@ -48,9 +68,9 @@ lintLevel (Depends _) = Info
 
 instance PrettyPrint Lint where
   prettyprint (Lint  Hint { hintMsg, hintLevel } ) =
-    showText hintLevel <> ": " <> hintMsg
+    "  " <> showText hintLevel <> ": " <> hintMsg
   prettyprint (Depends dep) =
-    "Info: found dependency: " <> prettyprint dep
+    "  Info: found dependency: " <> prettyprint dep
 
 instance ToJSON Lint where
   toJSON (Lint l) = toJSON l
-- 
cgit v1.2.3