use hpack and clean up modules

as annoying as yaml is, cabal's package format is somehow worse, apparently

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 (..))