diff options
| -rw-r--r-- | lib/CheckMap.hs | 7 | ||||
| -rw-r--r-- | lib/LintWriter.hs | 48 | ||||
| -rw-r--r-- | lib/Types.hs | 60 | ||||
| -rw-r--r-- | lib/Util.hs | 2 | ||||
| -rw-r--r-- | tiled-hs.cabal | 1 |
5 files changed, 67 insertions, 51 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index 36cbf9d..9402170 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -16,16 +16,17 @@ import qualified Data.Text as T import qualified Data.Vector as V import GHC.Generics (Generic) -import LintWriter (Level (..), Lint (..), - LintResult (..), LintWriter, hint, - lintLevel) +import LintWriter (LintResult (..), LintWriter) import Properties (checkProperty) import Tiled2 (Layer (layerName, layerProperties), Tiledmap (tiledmapLayers), loadTiledmap) +import Types (Level (..), Lint (..), hint, + lintLevel) import Util (PrettyPrint (prettyprint), prettyprint) + -- | What this linter produces: lints for a single map data MapResult a = MapResult { mapresultLayer :: Maybe (Map Text (LintResult a)) diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs index bfe543e..66f16f1 100644 --- a/lib/LintWriter.hs +++ b/lib/LintWriter.hs @@ -9,54 +9,10 @@ module LintWriter where import Control.Monad.Trans.Maybe () import Control.Monad.Writer (MonadTrans (lift), MonadWriter (tell), WriterT) -import Data.Aeson (ToJSON (toJSON), (.=)) +import Data.Aeson (ToJSON (toJSON)) import Data.Text (Text) -import GHC.Generics (Generic) -import qualified Data.Aeson as A -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 - -data Hint = Hint - { hintLevel :: Level - , hintMsg :: Text - } deriving (Generic, ToJSON) - -lintLevel :: Lint -> Level -lintLevel (Lint h) = hintLevel h -lintLevel (Depends dep) = 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" ] - - --- shorter constructor -hint :: Level -> Text -> Lint -hint level msg = Lint Hint { hintLevel = level, hintMsg = msg } - --- | TODO: add a reasonable representation of possible urls -newtype Dep = Dep Text - deriving (Generic, ToJSON) - -instance PrettyPrint Dep where - prettyprint (Dep txt) = txt +import Types -- | a monad to collect hints. If it yields Left, then the -- map is flawed in some fundamental way which prevented us diff --git a/lib/Types.hs b/lib/Types.hs index 082b30e..79bbfab 100644 --- a/lib/Types.hs +++ b/lib/Types.hs @@ -1,3 +1,61 @@ --- | basic types for workadventure maps +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# 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 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 +newtype Dep = Dep Text + deriving (Generic, ToJSON) + +data Hint = Hint + { hintLevel :: Level + , hintMsg :: Text + } deriving (Generic, ToJSON) + +-- | shorter constructor (called lint 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 dep) = 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 PrettyPrint Dep where + prettyprint (Dep txt) = txt diff --git a/lib/Util.hs b/lib/Util.hs index 3a0e1d4..42ba960 100644 --- a/lib/Util.hs +++ b/lib/Util.hs @@ -8,7 +8,7 @@ module Util where import Data.Aeson as Aeson import Data.Text (Text) -import Data.Text as T +import qualified Data.Text as T -- | haskell's many string types are FUN … showText :: Show a => a -> Text diff --git a/tiled-hs.cabal b/tiled-hs.cabal index 9b7b171..4da4a45 100644 --- a/tiled-hs.cabal +++ b/tiled-hs.cabal @@ -31,6 +31,7 @@ library Properties Tiled2 Util + Types build-depends: base ^>=4.14.1.0, aeson, bytestring, |