summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/CheckDir.hs2
-rw-r--r--lib/CheckMap.hs9
-rw-r--r--lib/KindLinter.hs64
-rw-r--r--lib/LintConfig.hs2
-rw-r--r--lib/Properties.hs9
-rw-r--r--lib/Types.hs10
-rw-r--r--lib/Uris.hs18
-rw-r--r--lib/Util.hs9
-rw-r--r--lib/WriteRepo.hs2
9 files changed, 94 insertions, 31 deletions
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 59c6f2f..02985ec 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -7,7 +7,7 @@
{-# LANGUAGE TypeFamilies #-}
-- | Module that contains high-level checking for an entire directory
-module CheckDir (recursiveCheckDir, DirResult(..), resultIsFatal) where
+module CheckDir (recursiveCheckDir, DirResult(..), resultIsFatal) where
import CheckMap (MapResult (..), loadAndLintMap)
import Control.Monad (void)
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 2677a30..cfa4b6e 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -27,14 +27,15 @@ import LintWriter (LintResult, invertLintResult,
resultToDeps, resultToLints, resultToOffers,
runLintWriter)
import Properties (checkLayer, checkMap, checkTileset)
+import System.FilePath (takeFileName)
import Tiled (Layer (layerLayers, layerName),
LoadResult (..),
Tiledmap (tiledmapLayers, tiledmapTilesets),
loadTiledmap)
-import Types (Dep (MapLink), Hint (Hint, hintLevel, hintMsg),
- Level (..), lintsToHints)
+import Types (Dep (MapLink),
+ Hint (Hint, hintLevel, hintMsg), Level (..),
+ lintsToHints)
import Util (PrettyPrint (prettyprint), prettyprint)
-import System.FilePath (takeFileName)
@@ -106,7 +107,7 @@ runLinter isMain config tiledmap depth = MapResult
where
linksLobby = \case
MapLink link -> "/@/rc3_21/lobby" `T.isPrefixOf` link
- _ -> False
+ _ -> False
layerDeps = concatMap resultToDeps layer
layer = checkLayerRec config depth (V.toList $ tiledmapLayers tiledmap)
tileset = checkThing tiledmapTilesets checkTileset
diff --git a/lib/KindLinter.hs b/lib/KindLinter.hs
index 4ecf067..ccca1db 100644
--- a/lib/KindLinter.hs
+++ b/lib/KindLinter.hs
@@ -1,14 +1,23 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
module KindLinter where
-import Data.Map.Strict
-import Data.HList
-import GHC.TypeLits (Symbol, KnownSymbol)
+import Data.HList
+import Data.Kind (Type)
+import Data.Map.Strict
+import Data.Void (Void)
+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
func :: a -> HList [Int, String]
@@ -17,12 +26,49 @@ func _ = hBuild 10 "test"
field :: forall a. KnownSymbol a => Label a
field = Label
+data Linter a = Some a | None
+type LintSingleton b a = Tagged b a
+
+-- newtype LintSet a :: Record '[LintSingleton Int]
+-- newtype LintSet (a :: Type -> Record '[Type]) = Record (a Void)
+
+type SomeList (a :: Type) = Record '[Tagged "test" a]
+
+type family MkList (b :: [Symbol]) a where
+ MkList '[] _ = '[]
+ MkList (x:xs) a = Tagged x a : MkList xs a
+
+type Lints labels a = Record (MkList labels a)
+
+type KnownProperties = '["hello", "test"]
+
+record :: Lints KnownProperties Int
record =
+ Label @"hello" .=. 20 .*.
Label @"test" .=. 10 .*.
- field @"x" .=. 20 .*.
+ -- field @"x" .=. 20 .*.
emptyRecord
+
+class KnownList a where
+ listVal :: Proxy a -> [String]
+
+instance KnownList '[] where
+ listVal _ = []
+
+instance (KnownList xs, KnownSymbol x) => KnownList (x:xs) where
+ listVal _ = symbolVal (Proxy @x) : listVal (Proxy @xs)
+
+
+lints :: [String]
+lints = listVal (Proxy @KnownProperties)
+
+-- TODO: how to pattern match on that?
+doSth :: forall a b ctxt. (KnownList a, b ~ MkList a (Linter ctxt)) => Proxy b -> String -> Linter ctxt
+doSth _ name = None -- want to get a different result for each value of name in a
+ -- is there a better way than using listVal / something related to it?
+
-- TODO: these should be limited to Tagged "symbol" (LintWriter a)
tileLints =
field @"test" .=. (\a -> a) .*.
diff --git a/lib/LintConfig.hs b/lib/LintConfig.hs
index 904d930..e71638b 100644
--- a/lib/LintConfig.hs
+++ b/lib/LintConfig.hs
@@ -10,7 +10,7 @@
{-# LANGUAGE UndecidableInstances #-}
-- | Module that deals with handling config options
-module LintConfig where
+module LintConfig (LintConfig(..), LintConfig', patchConfig) where
import Control.Monad.Identity (Identity)
import Data.Aeson (FromJSON (parseJSON), Options (..),
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 00d03da..87b2a28 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -12,7 +12,7 @@ module Properties (checkMap, checkTileset, checkLayer) where
import Control.Monad (forM, forM_, unless, when)
-import Data.Text (Text, intercalate, isPrefixOf, isInfixOf)
+import Data.Text (Text, intercalate, isInfixOf, isPrefixOf)
import qualified Data.Text as T
import qualified Data.Vector as V
import Tiled (Layer (..), Object (..), Property (..),
@@ -44,7 +44,8 @@ import LintWriter (LintWriter, adjust, askContext,
import Paths (PathResult (..), RelPath (..), getExtension,
isOldStyle, parsePath)
import Types (Dep (Link, Local, LocalMap, MapLink))
-import Uris (SubstError (..), applySubsts, parseUri, extractDomain)
+import Uris (SubstError (..), applySubsts, extractDomain,
+ parseUri)
@@ -338,10 +339,10 @@ checkObjectGroupProperty (Property name _) = case name of
\not the object layer."
_ -> warn $ "unknown property " <> prettyprint name <> " for objectgroup layers"
-checkIsRc3Url :: Text -> Bool
+checkIsRc3Url :: Text -> Bool
checkIsRc3Url text= case extractDomain text of
Nothing -> False
- Just domain -> do
+ Just domain -> do
domain == "https://static.rc3.world"
diff --git a/lib/Types.hs b/lib/Types.hs
index 3ec9ebc..588c8ea 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -7,7 +7,15 @@
-- | basic types for the linter to eat and produce
-- The dark magic making thse useful is in LintWriter
-module Types where
+module Types
+ ( Level(..)
+ , Lint(..)
+ , Dep(..)
+ , Hint(..)
+ , hint
+ , lintLevel
+ , lintsToHints
+ ) where
import Control.Monad.Trans.Maybe ()
import Data.Aeson (FromJSON, ToJSON (toJSON),
diff --git a/lib/Uris.hs b/lib/Uris.hs
index 22b36eb..00f86a4 100644
--- a/lib/Uris.hs
+++ b/lib/Uris.hs
@@ -22,12 +22,12 @@ import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import GHC.Generics (Generic)
import GHC.TypeLits (KnownSymbol, symbolVal)
+import Network.URI.Encode as URI
import Text.Regex.TDFA ((=~))
-import Witherable (mapMaybe)
-import Network.URI.Encode as URI
+import Witherable (mapMaybe)
-import Network.URI as NativeUri
-import Data.String
+import Data.String
+import Network.URI as NativeUri
data Substitution =
Prefixed { prefix :: Text, blocked :: [Text], allowed :: [Text], scope :: [String] }
@@ -48,7 +48,7 @@ type SchemaSet = [(Text, Substitution)]
extractDomain :: Text -> Maybe Text
extractDomain url =
case parseUri url of
- Nothing -> Nothing
+ Nothing -> Nothing
Just (_,domain,_) -> Just domain
@@ -60,13 +60,13 @@ parseUri uri =
Nothing -> Nothing
Just parsedUri -> case uriAuthority parsedUri of
Nothing -> Nothing
- -- https:
+ -- https:
Just uriAuth -> Just (T.replace (fromString ":") (fromString "") (fromString (uriScheme parsedUri )),
- -- //anonymous@ www.haskell.org :42
+ -- //anonymous@ www.haskell.org :42
fromString(uriUserInfo uriAuth++uriRegName uriAuth ++ uriPort uriAuth),
-- /ghc ?query #frag
fromString(uriPath parsedUri ++ uriQuery parsedUri ++ uriFragment parsedUri))
-
+
data SubstError =
SchemaDoesNotExist Text
@@ -94,7 +94,7 @@ applySubsts s substs uri = do
[] -> Left (SchemaDoesNotExist schema)
results@(_:_) -> case mapMaybe rightToMaybe results of
suc:_ -> Right suc
- _ -> minimum results
+ _ -> minimum results
where
note = maybeToRight
diff --git a/lib/Util.hs b/lib/Util.hs
index a6c8354..21a2661 100644
--- a/lib/Util.hs
+++ b/lib/Util.hs
@@ -4,7 +4,14 @@
-- | has (perhaps inevitably) morphed into a module that mostly
-- concerns itself with wrangling haskell's string types
-module Util where
+module Util
+ ( mkProxy
+ , showText
+ , PrettyPrint(..)
+ , printPretty
+ , naiveEscapeHTML
+ , layerIsEmpty
+ ) where
import Data.Aeson as Aeson
import Data.Proxy (Proxy (..))
diff --git a/lib/WriteRepo.hs b/lib/WriteRepo.hs
index c1a3f78..36c0df7 100644
--- a/lib/WriteRepo.hs
+++ b/lib/WriteRepo.hs
@@ -3,7 +3,7 @@
-- | Module for writing an already linted map Repository back out again.
-module WriteRepo where
+module WriteRepo (writeAdjustedRepository) where
import CheckDir (DirResult (..), resultIsFatal)
import CheckMap (MapResult (..))
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-26 06:00:13 +0000