From 0965e840d2e26378ef64392ed69e4c6109c31009 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Wed, 30 Mar 2022 18:21:16 +0200
Subject: remove unused module

---
 lib/KindLinter.hs | 74 -------------------------------------------------------
 package.yaml      |  1 -
 walint.cabal      |  4 +--
 3 files changed, 1 insertion(+), 78 deletions(-)
 delete mode 100644 lib/KindLinter.hs

diff --git a/lib/KindLinter.hs b/lib/KindLinter.hs
deleted file mode 100644
index a876a8f..0000000
--- a/lib/KindLinter.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{-# 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           Universum
-
-import           Data.HList
-import           GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
-
-
-func :: a -> HList [Int, String]
-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 .*.
-  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) .*.
-  emptyRecord
diff --git a/package.yaml b/package.yaml
index 9d2f826..82fd537 100644
--- a/package.yaml
+++ b/package.yaml
@@ -42,7 +42,6 @@ library:
     - text-metrics
     - uri-encode
     - network-uri
-    - HList
   exposed-modules:
     - CheckDir
     - CheckMap
diff --git a/walint.cabal b/walint.cabal
index 703cf4a..f5fe2fc 100644
--- a/walint.cabal
+++ b/walint.cabal
@@ -23,7 +23,6 @@ library
   other-modules:
       Badges
       Dirgraph
-      KindLinter
       LayerData
       LintWriter
       Paths
@@ -36,8 +35,7 @@ library
       NoImplicitPrelude
   ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
   build-depends:
-      HList
-    , aeson
+      aeson
     , base
     , bytestring
     , containers
-- 
cgit v1.2.3