1 files changed, 128 insertions, 0 deletions
diff --git a/walint/Types.hs b/walint/Types.hs
new file mode 100644
index 0000000..746fc00
--- /dev/null
+++ b/walint/Types.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+
+-- | basic types for the linter to eat and produce
+-- The dark magic making thse useful is in LintWriter
+module Types
+  ( Level(..)
+  , Lint(..)
+  , Dep(..)
+  , Hint(..)
+  , hint
+  , lintLevel
+  , lintsToHints
+  ) where
+
+import           Universum
+
+import           Control.Monad.Trans.Maybe ()
+import           Data.Aeson                (FromJSON, ToJSON (toJSON),
+                                            ToJSONKey, (.=))
+
+import           Badges                    (Badge)
+import qualified Data.Aeson                as A
+import           Paths                     (RelPath)
+import           Util                      (PrettyPrint (..))
+import           WithCli                   (Argument, 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 = Info | Suggestion | Warning | Forbidden | Error | Fatal
+  deriving (Show, Generic, Ord, Eq, ToJSON, FromJSON, NFData)
+
+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)
+data Lint = Depends Dep | Offers Text | Lint Hint | Badge Badge | CW [Text] | Jitsi Text
+  deriving (Ord, Eq, Generic)
+
+data Dep = Local RelPath | Link Text | MapLink Text | LocalMap RelPath
+  deriving (Generic, Ord, Eq, NFData)
+
+data Hint = Hint
+  { hintLevel :: Level
+  , hintMsg   :: Text
+  } deriving (Generic, Ord, Eq, NFData)
+
+-- | 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 _        = Info
+
+lintsToHints :: [Lint] -> [Hint]
+lintsToHints = mapMaybe (\case {Lint hint -> Just hint ; _ -> Nothing})
+
+-- instance PrettyPrint Lint where
+--   prettyprint (Lint  Hint { hintMsg, hintLevel } ) =
+--     "  " <> show hintLevel <> ": " <> hintMsg
+--   prettyprint (Depends dep) =
+--     "  Info: found dependency: " <> prettyprint dep
+--   prettyprint (Offers dep) =
+--     "  Info: map offers entrypoint " <> prettyprint dep
+--   prettyprint (Badge _) =
+--     "  Info: found a badge."
+--   prettyprint (CW cws) =
+--     "  CWs: " <> show cws
+
+instance PrettyPrint Hint where
+  prettyprint (Hint level msg) = "  " <> show level <> ": " <> msg
+
+-- instance ToJSON Lint where
+--   toJSON (Lint h) = toJSON h
+--   toJSON (Depends dep) = A.object
+--     [ "msg" .= prettyprint dep
+--     , "level" .= A.String "Dependency Info" ]
+--   toJSON (Offers l) = A.object
+--     [ "msg" .= prettyprint l
+--     , "level" .= A.String "Entrypoint Info" ]
+--   toJSON (Badge _) = A.object
+--     [ "msg" .= A.String "found a badge"
+--     , "level" .= A.String "Badge Info"]
+--   toJSON (CW cws) = A.object
+--     [ "msg" .= A.String "Content Warning"
+--     , "level" .= A.String "CW Info" ]
+
+instance ToJSON Hint where
+  toJSON (Hint l m) = A.object
+    [ "msg" .= m, "level" .= l ]
+
+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 <> "]"