summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorstuebinm2022-01-15 00:46:30 +0100
committerstuebinm2022-03-19 19:25:49 +0100
commit1530a4646b5bb7ab2930d1433eda87d5f0936125 (patch)
tree0eb4e3f0ada2743539cefbb27925ece37fabe6de /lib
parent6e929b4b1eb9b0b6a4707ed3d9f181544ed27a73 (diff)
use hpack and clean up modules
as annoying as yaml is, cabal's package format is somehow worse, apparently
Diffstat (limited to '')
-rw-r--r--lib/CheckDir.hs2
-rw-r--r--lib/KindLinter.hs64
-rw-r--r--lib/LintConfig.hs2
-rw-r--r--lib/Properties.hs7
-rw-r--r--lib/Types.hs10
-rw-r--r--lib/Uris.hs12
-rw-r--r--lib/Util.hs9
-rw-r--r--lib/WriteRepo.hs2
8 files changed, 85 insertions, 23 deletions
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 1f69abf..f876084 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/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 f346f7f..9cde1ec 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -45,7 +45,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)
@@ -344,10 +345,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 80ee014..00f86a4 100644
--- a/lib/Uris.hs
+++ b/lib/Uris.hs
@@ -26,8 +26,8 @@ import Network.URI.Encode as URI
import Text.Regex.TDFA ((=~))
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
diff --git a/lib/Util.hs b/lib/Util.hs
index 3fe0a16..ffd9faa 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 (..))