diagnose: include JSON backend conditionnally (set a flag)

diagnose.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           diagnose
-version:        1.2.0
+version:        1.3.0
 homepage:       https://github.com/mesabloo/diagnose#readme
 bug-reports:    https://github.com/mesabloo/diagnose/issues
 author:         Mesabloo
@@ -19,16 +19,26 @@ source-repository head
   type: git
   location: https://github.com/mesabloo/diagnose
 
+flag json
+  description: Allows exporting diagnostics as JSON. This is disabled by default as this relies on the very heavy dependency Aeson.
+  manual: True
+  default: False
+
+flag megaparsec-compat
+  description: Includes a small compatibility layer (in the module Error.Diagnose.Compat.Megaparsec) to transform megaparsec errors into reports for this library.
+  manual: True
+  default: False
+
 library
   exposed-modules:
-      Data.List.Safe
       Error.Diagnose
       Error.Diagnose.Diagnostic
-      Error.Diagnose.Diagnostic.Internal
       Error.Diagnose.Position
       Error.Diagnose.Report
-      Error.Diagnose.Report.Internal
   other-modules:
+      Data.List.Safe
+      Error.Diagnose.Diagnostic.Internal
+      Error.Diagnose.Report.Internal
       Paths_diagnose
   hs-source-dirs:
       src
@@ -38,8 +48,7 @@ library
       BlockArguments
   ghc-options: -Wall -Wextra
   build-depends:
-      aeson ==1.5.6.0
-    , base >=4.7 && <5
+      base >=4.7 && <5
     , bytestring ==0.10.12.0
     , data-default ==0.7.1.1
     , hashable ==1.3.0.0
@@ -47,6 +56,10 @@ library
     , prettyprinter-ansi-terminal ==1.1.2
     , text ==1.2.4.1
     , unordered-containers ==0.2.14.0
+  if flag(json)
+    cpp-options: -DUSE_AESON
+    build-depends:
+        aeson ==1.5.6.0
   default-language: Haskell2010
 
 test-suite diagnose-tests
@@ -62,8 +75,7 @@ test-suite diagnose-tests
       BlockArguments
   ghc-options: -Wall -Wextra -threaded -rtsopts -with-rtsopts=-N -O0 -g
   build-depends:
-      aeson ==1.5.6.0
-    , base >=4.7 && <5
+      base >=4.7 && <5
     , bytestring ==0.10.12.0
     , data-default ==0.7.1.1
     , diagnose
@@ -72,4 +84,8 @@ test-suite diagnose-tests
     , prettyprinter-ansi-terminal ==1.1.2
     , text ==1.2.4.1
     , unordered-containers ==0.2.14.0
+  if flag(json)
+    cpp-options: -DUSE_AESON
+    build-depends:
+        aeson ==1.5.6.0
   default-language: Haskell2010

package.yaml

@@ -12,7 +12,6 @@ dependencies:
 - unordered-containers == 0.2.14.0
 - hashable == 1.3.0.0
 - data-default == 0.7.1.1
-- aeson == 1.5.6.0
 - bytestring == 0.10.12.0
 - text == 1.2.4.1
 
@@ -23,6 +22,26 @@ default-extensions:
 
 library:
   source-dirs: src
+  exposed-modules:
+  - Error.Diagnose
+  - Error.Diagnose.Diagnostic
+  - Error.Diagnose.Position
+  - Error.Diagnose.Report
+
+flags:
+  json:
+    description: "Allows exporting diagnostics as JSON.
+      This is disabled by default as this relies on the very heavy dependency Aeson."
+    manual: true
+    default: false
+
+when:
+  - condition: flag(json)
+    dependencies:
+    - aeson == 1.5.6.0
+
+    cpp-options:
+    - -DUSE_AESON
 
 ghc-options:
 - -Wall

src/Error/Diagnose/Compat/Megaparsec.hs

@@ -0,0 +1,3 @@
+module Error.Diagnose.Compat.Megaparsec where
+
+

src/Error/Diagnose/Diagnostic.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 {-|
 Module      : Error.Diagnose.Diagnostic
 Description : Diagnostic definition and pretty printing
@@ -10,6 +12,11 @@ module Error.Diagnose.Diagnostic
   ( -- * Re-exports
     module Export ) where
 
-import Error.Diagnose.Diagnostic.Internal as Export (Diagnostic, def, printDiagnostic, diagnosticToJson, addFile, addReport)
+import Error.Diagnose.Diagnostic.Internal as Export
+  (Diagnostic, def, printDiagnostic,
+#ifdef USE_AESON
+  diagnosticToJson,
+#endif 
+  addFile, addReport)
 
 import System.IO as Export (stdout, stderr)

src/Error/Diagnose/Diagnostic/Internal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
 
 {-|
 Module      : Error.Diagnose.Diagnostic.Internal
@@ -17,7 +18,9 @@ module Error.Diagnose.Diagnostic.Internal (module Error.Diagnose.Diagnostic.Inte
 
 import Control.Monad.IO.Class (MonadIO, liftIO)
 
+#ifdef USE_AESON
 import Data.Aeson (ToJSON(..), encode, object, (.=))
+#endif
 import Data.ByteString.Lazy (ByteString)
 import Data.Default (Default, def)
 import Data.Foldable (fold)
@@ -51,6 +54,7 @@ instance Default (Diagnostic msg) where
 instance Semigroup (Diagnostic msg) where
   Diagnostic rs1 file <> Diagnostic rs2 _ = Diagnostic (rs1 <> rs2) file
 
+#ifdef USE_AESON
 instance ToJSON msg => ToJSON (Diagnostic msg) where
   toJSON (Diagnostic reports files) =
     object [ "files" .= fmap toJSONFile (HashMap.toList files)
@@ -61,6 +65,7 @@ instance ToJSON msg => ToJSON (Diagnostic msg) where
         object [ "name" .= path
                , "content" .= content
                ]
+#endif
 
 -- | Pretty prints a diagnostic into a 'Doc'ument that can be output using
 --   'Text.PrettyPrint.ANSI.Leijen.hPutDoc' or 'Text.PrettyPrint.ANSI.Leijen.displayIO'.
@@ -93,6 +98,7 @@ addFile :: Diagnostic msg
         -> Diagnostic msg
 addFile (Diagnostic reports files) path content =
   Diagnostic reports (HashMap.insert path (lines content) files)
+{-# INLINE addFile #-}
 
 -- | Inserts a new report into a diagnostic.
 addReport :: Diagnostic msg
@@ -100,7 +106,9 @@ addReport :: Diagnostic msg
           -> Diagnostic msg
 addReport (Diagnostic reports files) report =
   Diagnostic (report : reports) files
+{-# INLINE addReport #-}
 
+#ifdef USE_AESON
 -- | Creates a JSON object from a diagnostic, containing those fields (only types are indicated):
 --
 --   > { files:
@@ -124,3 +132,4 @@ addReport (Diagnostic reports files) report =
 --   > }
 diagnosticToJson :: ToJSON msg => Diagnostic msg -> ByteString
 diagnosticToJson = encode
+#endif

src/Error/Diagnose/Position.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
 
 {-|
 Module      : Error.Diagnose.Diagnostic
@@ -13,7 +14,9 @@ Portability : Portable
 -}
 module Error.Diagnose.Position (Position(..)) where
 
+#ifdef USE_AESON
 import Data.Aeson (ToJSON(..), object, (.=))
+#endif
 import Data.Default (Default, def)
 import Data.Hashable (Hashable)
 import Data.Text (Text)
@@ -58,9 +61,11 @@ instance Hashable Position where
 instance Default Position where
   def = Position (1, 1) (1, 1) "<no-file>"
 
+#ifdef USE_AESON
 instance ToJSON Position where
   toJSON (Position (bl, bc) (el, ec) file) =
     object [ "beginning" .= object [ "line" .= bl, "column" .= bc ]
            , "end" .= object [ "line" .= el, "column" .= ec ]
            , "file" .= file
            ]
+#endif

src/Error/Diagnose/Report/Internal.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
 
 {-# OPTIONS -Wno-name-shadowing #-}
 
@@ -22,7 +23,9 @@ Portability : Portable
 -}
 module Error.Diagnose.Report.Internal where
 
+#ifdef USE_AESON
 import Data.Aeson (ToJSON(..), object, (.=))
+#endif
 import Data.Bifunctor (first, second, bimap)
 import Data.Default (def)
 import Data.Foldable (fold)
@@ -39,8 +42,6 @@ import Error.Diagnose.Position
 import Prettyprinter (Pretty(..), Doc, hardline, (<+>), align, space, annotate, width, colon)
 import Prettyprinter.Internal (Doc(..))
 import Prettyprinter.Render.Terminal (color, colorDull, Color(..), bold, AnsiStyle)
--- import Text.PrettyPrint.ANSI.Leijen (Pretty, Doc, mempty, bold, red, yellow, colon, pretty, hardline, (<+>), text, black, dullgreen, width, dullblue, magenta, int, space, align, cyan, char, string)
--- import Text.PrettyPrint.ANSI.Leijen.Internal (Doc(..))
 
 
 -- | The type of diagnostic reports with abstract message type.
@@ -51,6 +52,7 @@ data Report msg
         [(Position, Marker msg)]        -- ^ A map associating positions with marker to show under the source code.
         [msg]                           -- ^ A list of hints to add at the end of the report.
 
+#ifdef USE_AESON
 instance ToJSON msg => ToJSON (Report msg) where
   toJSON (Report isError msg markers hints) =
     object [ "kind" .= (if isError then "error" else "warning" :: String)
@@ -71,6 +73,7 @@ instance ToJSON msg => ToJSON (Report msg) where
                    Maybe m -> [ "message" .= m
                               , "kind" .= ("maybe" :: String)
                               ]
+#endif
 
 -- | The type of markers with abstract message type, shown under code lines.
 data Marker msg
@@ -174,6 +177,7 @@ dotPrefix :: Int        -- ^ The length of the left space before the bullet.
           -> Bool       -- ^ Whether to print with unicode characters or not.
           -> Doc AnsiStyle
 dotPrefix leftLen withUnicode = pad leftLen ' ' mempty <+> annotate (bold <> color Black) (if withUnicode then "•" else ":")
+{-# INLINE dotPrefix #-}
 
 -- | Creates a "pipe"-prefix for a report line where there is no code.
 --
@@ -185,6 +189,7 @@ pipePrefix :: Int       -- ^ The length of the left space before the pipe.
            -> Bool      -- ^ Whether to print with unicode characters or not.
            -> Doc AnsiStyle
 pipePrefix leftLen withUnicode = pad leftLen ' ' mempty <+> annotate (bold <> color Black) (if withUnicode then "│" else "|")
+{-# INLINE pipePrefix #-}
 
 -- | Creates a line-prefix for a report line containing source code
 --
@@ -201,6 +206,7 @@ linePrefix :: Int       -- ^ The length of the amount of space to span before th
 linePrefix leftLen lineNo withUnicode =
   let lineNoLen = length (show lineNo)
   in annotate (bold <> color Black) $ mempty <+> pad (leftLen - lineNoLen) ' ' mempty <> pretty lineNo <+> if withUnicode then "│" else "|"
+{-# INLINE linePrefix #-}
 
 -- |
 splitMarkersPerLine :: [(Position, Marker msg)] -> (HashMap Int [(Position, Marker msg)], [(Position, Marker msg)])
@@ -391,12 +397,14 @@ markerColor :: Bool             -- ^ Whether the marker is in an error context o
 markerColor isError (This _) = if isError then color Red else color Yellow
 markerColor _ (Where _)      = colorDull Blue
 markerColor _ (Maybe _)      = color Magenta
+{-# INLINE markerColor #-}
 
 -- | Retrieves the message held by a marker.
 markerMessage :: Marker msg -> msg
 markerMessage (This m)  = m
 markerMessage (Where m) = m
 markerMessage (Maybe m) = m
+{-# INLINE markerMessage #-}
 
 -- | Pretty prints all hints.
 prettyAllHints :: Pretty msg => [msg] -> Int -> Bool -> Doc AnsiStyle

test/Spec.hs

@@ -1,8 +1,11 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
 
 import Error.Diagnose
     ( printDiagnostic,
+#ifdef USE_AESON
       diagnosticToJson,
+#endif
       stdout,
       err,
       warn,
@@ -60,8 +63,10 @@ main = do
   printDiagnostic stdout True True diag
   hPutStrLn stdout "\n\nWithout unicode: ----------------------\n"
   printDiagnostic stdout False True diag
+#ifdef USE_AESON
   hPutStrLn stdout "\n\nAs JSON: ------------------------------\n"
   BS.hPutStr stdout (diagnosticToJson diag)
+#endif
   hPutStrLn stdout "\n"
 
 errorNoMarkersNoHints :: Report String