summaryrefslogtreecommitdiff
path: root/lib/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Types.hs')
-rw-r--r--lib/Types.hs130
1 files changed, 0 insertions, 130 deletions
diff --git a/lib/Types.hs b/lib/Types.hs
deleted file mode 100644
index acba99d..0000000
--- a/lib/Types.hs
+++ /dev/null
@@ -1,130 +0,0 @@
-{-# 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
- ( 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 <> "]"