diagnostician 0.1.0.0 → 0.1.1.0

raw patch · 2 files changed

+38/−29 lines, 2 filesdep ~containers

Dependency ranges changed: containers

Files

diagnostician.cabal +3/−3
src/Diagnostician.hs +35/−26

diagnostician.cabal view

@@ -1,11 +1,11 @@ cabal-version:   3.4 name:            diagnostician-description:     A minimal, opinionated library for compiler error messages-version:         0.1.0.0+version:         0.1.1.0 license:         MPL-2.0 license-file:    LICENSE maintainer:      root@owenlynch.org author:          Owen Lynch+description:     A minimal, opinionated library for compiler error messages category:        Language build-type:      Simple extra-doc-files: CHANGELOG.md@@ -44,5 +44,5 @@     ghc-options:        -Wall     build-depends:         base ^>=4.21.0.0,-        containers >=0.7,+        containers,         diagnostician

src/Diagnostician.hs view

@@ -1,5 +1,7 @@ module Diagnostician where +import Data.Functor.Contravariant+import Data.IORef (IORef, atomicModifyIORef) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (maybeToList)@@ -75,6 +77,8 @@  type LineNum = Int +type ColNum = Int+ lineStart :: File -> LineNum -> Pos lineStart f l = (f.lineBreaks UV.! l) + 1 @@ -87,19 +91,20 @@ lineContents :: File -> LineNum -> T.Text lineContents f l = sliceWord8 (lineStart f l) (lineEnd f l) f.contents -lineOf :: File -> Pos -> LineNum-lineOf f i =+srcOf :: File -> Pos -> (LineNum, ColNum)+srcOf f i =   seq-    (0 <= i && i < TU.lengthWord8 f.contents || error "position out of bounds")+    (0 <= i && i <= TU.lengthWord8 f.contents || error "position out of bounds")     (go 0 (UV.length f.lineBreaks - 1))   where     go l r-      | l == r = l+      | l == r = (l, c l)       | i < lineStart f m = go l m       | i > lineEnd f m = go m r-      | otherwise = m+      | otherwise = (m, c m)       where         m = (l + r) `div` 2+        c lineNo = i - lineStart f lineNo  repeated :: Int -> Char -> Doc ann repeated n c@@ -136,22 +141,37 @@     | l <- [ls .. le]     ]   where-    ls = lineOf f s-    le = lineOf f e+    ls = fst $ srcOf f s+    le = fst $ srcOf f e     numWidth = max (numDigits ls) (numDigits le)  -- Reporter -------------------------------------------------------------------------------- --- | A @Reporter@ is a destination for diagnostic messages. Currently this is--- very simplistic; it's just a byte sink. The @reporterFancy@ flag is in theory--- used to configure whether colors should be used, but we don't even look at--- that yet.-data Reporter = Reporter-  { handle :: Handle,-    fancy :: Bool-  }+-- | A @Reporter@ is a destination for diagnostic messages. It corresponds+-- to an IO action `reportIO` that logs a diagnostic+newtype Reporter a = Reporter {reportIO :: Diagnostic a -> IO ()} +reportTo :: Reporter a -> Diagnostic a -> IO ()+reportTo r d = r.reportIO d++instance Contravariant Reporter where+  contramap f (Reporter r) = Reporter $ r . fmap f++-- | Create a `Reporter` that writes the prettyprinted diagnostic to a file+fileReporter :: (Code a) => Handle -> Reporter a+fileReporter handle =+  Reporter+    { reportIO = \d -> hPutDoc handle (hardline <> dpretty d <> hardline)+    }++-- | Create a `Reporter` that appends a diagnostic to a list+pureReporter :: (Code a) => IORef [Diagnostic a] -> Reporter a+pureReporter ref =+  Reporter+    { reportIO = \d -> atomicModifyIORef ref (\ds -> (d : ds, ()))+    }+ -- Diagnostics -------------------------------------------------------------------------------- @@ -213,14 +233,3 @@   dpretty d =     vsep $       (prtCode d.code <> ": " <> unAnnotate d.summary) : (map dpretty d.notes)--reportIO :: (Code a) => Reporter -> Diagnostic a -> IO ()-reportIO r d = hPutDoc r.handle (hardline <> dpretty d <> hardline)--data ReporterFor a-  = forall c.-  (Code c) =>-  ReporterFor {translator :: a -> c, reporter :: Reporter}--reportTo :: ReporterFor a -> Diagnostic a -> IO ()-reportTo (ReporterFor t r) d = reportIO r (fmap t d)