diff options
author | stuebinm | 2021-09-16 23:18:14 +0200 |
---|---|---|
committer | stuebinm | 2021-09-16 23:18:14 +0200 |
commit | 7a9226d84cf9dde33d0fc3e7852a22c36ab1c39b (patch) | |
tree | 428079b8bd891dc09bedc594e149fc9799c82816 /lib/LintWriter.hs | |
parent | de81f6cac440fff159546f6423f017197db49e1a (diff) |
input options, output json
input options are mostly dummies for now, but some work (e.g. --inpath
and --json). Lints can now be optionally printed as json to be
reasonably machine-readable (and the json can be pretty-printed to make
it human-readable again …).
Diffstat (limited to '')
-rw-r--r-- | lib/LintWriter.hs | 40 |
1 files changed, 28 insertions, 12 deletions
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs index 0146366..ca7ff08 100644 --- a/lib/LintWriter.hs +++ b/lib/LintWriter.hs @@ -1,29 +1,32 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} {-# 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 +import Control.Monad.Trans.Maybe () +import Control.Monad.Writer (MonadTrans (lift), + MonadWriter (tell), WriterT) +import Data.Aeson (ToJSON (toJSON)) +import Data.Text (Text) +import GHC.Generics (Generic) -- | 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 + deriving (Show, Generic, ToJSON) -- | a hint comes with an explanation (and a level) data Hint = Hint { hintLevel :: Level - , hintMsg :: Text } - deriving Show + , hintMsg :: Text } + deriving (Show, Generic, ToJSON) -- shorter constructor +hint :: Level -> Text -> Hint hint level msg = Hint { hintLevel = level, hintMsg = msg } -- | a monad to collect hints. If it yields Left, then the @@ -31,7 +34,20 @@ hint level msg = Hint { hintLevel = level, hintMsg = msg } -- 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]) +-- 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]) +newtype LintResult a = LintResult (LintResult' a) + +-- better, less confusing serialisation of an Either Hint (a, [Hint]). +-- Note that Left hint is also serialised as a list to make the resulting +-- json schema more regular. +instance ToJSON a => ToJSON (LintResult a) where + toJSON (LintResult r) = toJson' r + where toJson' (Left hint) = toJSON [hint] + toJson' (Right (_, hints)) = toJSON hints + + -- | write a hint into the LintWriter monad lint :: Level -> Text -> LintWriter () @@ -49,7 +65,7 @@ complain = lint Error -- | 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 + Just a -> Right a Nothing -> Left hint -- | unwrap and produce a warning if the value was Nothing |