{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -- | basic types for the linter to eat and produce -- The dark magic making thse useful is in LintWriter module Types where import Control.Monad.Trans.Maybe () import Data.Aeson (ToJSON (toJSON), (.=)) import Data.Text (Text) import GHC.Generics (Generic) import qualified Data.Aeson as A import Paths (RelPath) 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), or is a dependency -- (in which case it'll be otherwise treated as an info hint) data Lint = Depends Dep | Lint Hint -- | TODO: add a reasonable representation of possible urls data Dep = Local RelPath | Link Text | MapLink Text | LocalMap RelPath deriving (Generic) data Hint = Hint { hintLevel :: Level , hintMsg :: Text } deriving (Generic, ToJSON) -- | shorter constructor (called hint because (a) older name and -- (b) lint also exists and is monadic) hint :: Level -> Text -> Lint hint level msg = Lint Hint { hintLevel = level, hintMsg = msg } -- | dependencies just have level Info lintLevel :: Lint -> Level lintLevel (Lint h) = hintLevel h lintLevel (Depends _) = 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" ] instance ToJSON Dep where toJSON = \case Local text -> json "local" $ prettyprint text Link text -> json "link" text MapLink text -> json "mapservice" text LocalMap text -> json "map" $ prettyprint text where json :: A.Value -> Text -> A.Value json kind text = A.object [ "kind" .= kind, "dep" .= text ] instance PrettyPrint Dep where prettyprint = \case Local dep -> "[local dep: " <> prettyprint dep <> "]" Link dep -> "[link dep: " <> dep <> "]" MapLink dep -> "[map service dep: " <> dep <> "]" LocalMap dep -> "[local map dep: " <> prettyprint dep <> "]"