From 0bd2e836d96fe864b00d2085f29e932130722cc3 Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Sat, 18 Sep 2021 02:09:27 +0200
Subject: [PATCH] moved types into Types.hs
it's almost as if there's some structure to this code!
---
lib/CheckMap.hs | 7 +++---
lib/LintWriter.hs | 48 ++-----------------------------------
lib/Types.hs | 60 ++++++++++++++++++++++++++++++++++++++++++++++-
lib/Util.hs | 2 +-
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,
--
GitLab