diff options
author | stuebinm | 2021-09-20 22:30:22 +0200 |
---|---|---|
committer | stuebinm | 2021-09-20 22:30:22 +0200 |
commit | 42df3cf0eb0c5877ac3320994cadec07619bcd6b (patch) | |
tree | cbe11c6cc138ab5a303ec9ba4105dfd00df243f1 /lib/LintWriter.hs | |
parent | 9a8d793f8f08fd5674bc6a917278ee7251bac56f (diff) |
typechecking for path depths!
This now checks if relative paths are still inside the repository, as a
general safety mechanism to stop the linter from accidentally reading
other things, as well as a nice hint for users.
Diffstat (limited to 'lib/LintWriter.hs')
-rw-r--r-- | lib/LintWriter.hs | 28 |
1 files changed, 20 insertions, 8 deletions
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs index a6fa17e..de7d314 100644 --- a/lib/LintWriter.hs +++ b/lib/LintWriter.hs @@ -14,20 +14,26 @@ import Control.Monad.Writer (MonadWriter (tell), WriterT, import Data.Aeson (ToJSON (toJSON)) import Data.Text (Text) -import Control.Monad.Trans.Reader (Reader, runReader) +import Control.Monad.Reader (local) +import Control.Monad.Trans.Reader (Reader, asks, runReader) +import Control.Monad.Writer.Lazy (lift) import Data.Maybe (mapMaybe) +import GHC.Generics (Generic) import Types -import GHC.Generics (Generic) + + +-- | for now, all context we have is how "deep" in the directory tree +-- we currently are +type Context = Int -- | a monad to collect hints, with some context -type LintWriter ctxt = WriterT [Lint] (Reader ctxt) () +type LintWriter ctxt = LintWriter' ctxt () +type LintWriter' ctxt res = WriterT [Lint] (Reader (Context, ctxt)) res -- wrapped to allow for manual writing of Aeson instances type LintResult' ctxt = (ctxt, [Lint]) -- Either Lint (a, [Lint]) newtype LintResult ctxt = LintResult (LintResult' ctxt) -data LayerContext = LayerContext () - deriving (Generic, ToJSON) -- better, less confusing serialisation of an Either Hint (a, [Hint]). -- Note that Left hint is also serialised as a list to make the resulting @@ -49,9 +55,9 @@ resultToLints :: LintResult a -> [Lint] resultToLints (LintResult res) = snd res -- | run a linter -runLintWriter :: ctxt -> LintWriter ctxt -> LintResult ctxt -runLintWriter c linter = LintResult (c, lints) - where lints = snd $ flip runReader c $ runWriterT linter +runLintWriter :: ctxt -> Context -> LintWriter ctxt -> LintResult ctxt +runLintWriter c c' linter = LintResult (c, lints) + where lints = snd $ flip runReader (c',c) $ runWriterT linter -- | write a hint into the LintWriter monad lint :: Level -> Text -> LintWriter a @@ -66,3 +72,9 @@ suggest = lint Suggestion warn = lint Warning forbid = lint Forbidden complain = lint Error + +askContext :: LintWriter' a a +askContext = lift $ asks snd + +askFileDepth :: LintWriter' a Int +askFileDepth = lift $ asks fst |