From 1530a4646b5bb7ab2930d1433eda87d5f0936125 Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Sat, 15 Jan 2022 00:46:30 +0100
Subject: [PATCH] use hpack and clean up modules
as annoying as yaml is, cabal's package format is somehow worse, apparently
---
.gitignore | 1 +
lib/CheckDir.hs | 2 +-
lib/KindLinter.hs | 64 +++++++++++++++++---
lib/LintConfig.hs | 2 +-
lib/Properties.hs | 7 ++-
lib/Types.hs | 10 ++-
lib/Uris.hs | 12 ++--
lib/Util.hs | 9 ++-
lib/WriteRepo.hs | 2 +-
package.yaml | 52 ++++++++++++++++
src/Main.hs | 9 +--
stack.yaml | 46 +-------------
walint.cabal | 151 +++++++++++++++++++++++-----------------------
13 files changed, 219 insertions(+), 148 deletions(-)
create mode 100644 package.yaml
diff --git a/.gitignore b/.gitignore
index deffb08..af63e5f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,3 @@
dist-newstyle/*
.stack-work
+walint.cabal
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 (..))
diff --git a/package.yaml b/package.yaml
new file mode 100644
index 0000000..b3684cd
--- /dev/null
+++ b/package.yaml
@@ -0,0 +1,52 @@
+name: walint
+version: 0.1
+homepage: https://stuebinm.eu/git/walint
+# TODO: license
+author: stuebinm
+maintainer: stuebinm@disroot.org
+copyright: 2022 stuebinm
+ghc-options: -Wall -Wno-name-shadowing
+
+dependencies:
+ - base
+ - aeson
+ - bytestring
+ - mtl
+ - text
+
+library:
+ source-dirs: 'lib'
+ dependencies:
+ - containers
+ - text
+ - vector
+ - transformers
+ - either
+ - filepath
+ - getopt-generics
+ - regex-tdfa
+ - extra
+ - witherable
+ - dotgen
+ - text-metrics
+ - uri-encode
+ - network-uri
+ - HList
+ exposed-modules:
+ - CheckDir
+ - WriteRepo
+ - Util
+ - Types
+ - LintConfig
+
+executables:
+ walint:
+ main: Main.hs
+ source-dirs: 'src'
+ build-tools: hspec-discover
+ dependencies:
+ - walint
+ - getopt-generics
+ - aeson-pretty
+ - template-haskell
+ - process
diff --git a/src/Main.hs b/src/Main.hs
index 02e8f02..f0a6c09 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,7 +7,7 @@
module Main where
-import Control.Monad (unless)
+import Control.Monad (unless, when)
import Control.Monad.Identity (Identity)
import Data.Aeson (eitherDecode, encode)
import Data.Aeson.Encode.Pretty (encodePretty)
@@ -17,18 +17,19 @@ import Data.Maybe (fromMaybe)
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import System.Exit (ExitCode (..), exitWith)
-import WithCli
+import System.IO (hPutStrLn, stderr)
+import WithCli (Generic, HasArguments, withCli)
import CheckDir (recursiveCheckDir, resultIsFatal, DirResult (dirresultGraph))
import Control.Monad (when)
import LintConfig (LintConfig (..), patchConfig)
-import System.IO (hPutStrLn, stderr)
import Types (Level (..))
import Util (printPretty)
-import qualified Version as V (version)
import WriteRepo (writeAdjustedRepository)
import Text.Dot (showDot)
+import qualified Version as V (version)
+
-- | the options this cli tool can take
data Options = Options
{ repository :: Maybe String
diff --git a/stack.yaml b/stack.yaml
index 78836a8..50475b0 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,22 +1,3 @@
-# This file was automatically generated by 'stack init'
-#
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-# Resolver to choose a 'specific' stackage snapshot or a compiler version.
-# A snapshot resolver dictates the compiler version and the set of packages
-# to be used for project dependencies. For example:
-#
-# resolver: lts-3.5
-# resolver: nightly-2015-09-21
-# resolver: ghc-7.10.2
-#
-# The location of a snapshot can be provided as a file or url. Stack assumes
-# a snapshot provided as a file might change, whereas a url resource does not.
-#
-# resolver: ./custom-snapshot.yaml
-# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/16.yaml
@@ -44,34 +25,9 @@ extra-deps:
- HList-0.5.1.0@sha256:3ecb2d10ad2b3d36ad28e2f08505f9c3d7143ca737ef13b3e64db503635966c2,7525
allow-newer: true
-# - acme-missiles-0.3
-# - git: https://github.com/commercialhaskell/stack.git
-# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#
-# extra-deps: []
-# Override default flag values for local packages and extra-deps
+# use aeson with a non-hash-floodable implementation
flags:
aeson:
ordered-keymap: true
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=2.7"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
diff --git a/walint.cabal b/walint.cabal
index e43ae12..73c5fd0 100644
--- a/walint.cabal
+++ b/walint.cabal
@@ -1,82 +1,81 @@
-cabal-version: 2.4
-name: walint
-version: 0.1.0.0
+cabal-version: 1.12
--- A short (one-line) description of the package.
--- synopsis:
+-- This file has been generated from package.yaml by hpack version 0.34.5.
+--
+-- see: https://github.com/sol/hpack
--- A longer description of the package.
--- description:
-
--- A URL where users can report bugs.
--- bug-reports:
-
--- The license under which the package is released.
--- license:
-author: stuebinm
-maintainer: stuebinm@disroot.org
-
--- A copyright notice.
--- copyright:
--- category:
-extra-source-files: CHANGELOG.md
+name: walint
+version: 0.1
+homepage: https://stuebinm.eu/git/walint
+author: stuebinm
+maintainer: stuebinm@disroot.org
+copyright: 2022 stuebinm
+build-type: Simple
library
- default-language: Haskell2010
- ghc-options: -Wall -Wno-name-shadowing
- hs-source-dirs: lib
- exposed-modules:
- CheckMap
- WriteRepo
- CheckDir
- LintWriter
- Properties
- Tiled
- TiledAbstract
- Util
- Types
- Paths
- Uris
- LintConfig
- Badges
- LayerData
- Dirgraph
- KindLinter
- build-depends: base,
- aeson,
- bytestring,
- containers,
- text,
- vector,
- transformers,
- mtl,
- either,
- filepath,
- getopt-generics,
- regex-tdfa,
- extra,
- witherable,
- dotgen,
- text-metrics,
- uri-encode,
- network-uri,
- HList
+ exposed-modules:
+ CheckDir
+ WriteRepo
+ Util
+ Types
+ LintConfig
+ other-modules:
+ Badges
+ CheckMap
+ Dirgraph
+ KindLinter
+ LayerData
+ LintWriter
+ Paths
+ Properties
+ Tiled
+ TiledAbstract
+ Uris
+ Paths_walint
+ hs-source-dirs:
+ lib
+ ghc-options: -Wall -Wno-name-shadowing
+ build-depends:
+ HList
+ , aeson
+ , base
+ , bytestring
+ , containers
+ , dotgen
+ , either
+ , extra
+ , filepath
+ , getopt-generics
+ , mtl
+ , network-uri
+ , regex-tdfa
+ , text
+ , text-metrics
+ , transformers
+ , uri-encode
+ , vector
+ , witherable
+ default-language: Haskell2010
--- TODO: move more stuff into lib, these dependencies are silly
executable walint
- main-is: Main.hs
- ghc-options: -Wall
- build-depends: base,
- walint,
- getopt-generics,
- aeson,
- aeson-pretty,
- bytestring,
- mtl,
- text,
- template-haskell,
- process,
- dotgen
- hs-source-dirs: src
- default-language: Haskell2010
- other-modules: Version
+ main-is: Main.hs
+ ghc-options: -Wall -Wno-name-shadowing
+ build-tool-depends:
+ hspec-discover:hspec-discover
+ build-depends:
+ aeson
+ , aeson-pretty
+ , base
+ , bytestring
+ , getopt-generics
+ , mtl
+ , process
+ , template-haskell
+ , text
+ , walint
+ hs-source-dirs:
+ src
+ default-language: Haskell2010
+ other-modules:
+ Version
+ Paths_walint
--
GitLab