reformat all files

src/Error/Diagnose/Compat/Megaparsec.hs

@@ -1,40 +1,50 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
 
 {-# OPTIONS -Wno-name-shadowing #-}
 
+-- |
+-- Module      : Error.Diagnose.Compat.Megaparsec
+-- Description : Compatibility layer for megaparsec
+-- Copyright   : (c) Mesabloo, 2021
+-- License     : BSD3
+-- Stability   : experimental
+-- Portability : Portable
 module Error.Diagnose.Compat.Megaparsec
-( diagnosticFromBundle
+  ( diagnosticFromBundle,
-, errorDiagnosticFromBundle
+    errorDiagnosticFromBundle,
-, warningDiagnosticFromBundle
+    warningDiagnosticFromBundle,
-, module Error.Diagnose.Compat.Hints
+    module Error.Diagnose.Compat.Hints,
-) where
+  )
+where
 
 import Data.Bifunctor (second)
 import Data.Function ((&))
 import Data.Maybe (fromMaybe)
 import qualified Data.Set as Set (toList)
 import Data.String (IsString (..))
-
 import Error.Diagnose
 import Error.Diagnose.Compat.Hints (HasHints (..))
-
 import qualified Text.Megaparsec as MP
 
 -- | Transforms a megaparsec 'MP.ParseErrorBundle' into a well-formated 'Diagnostic' ready to be shown.
-diagnosticFromBundle
+diagnosticFromBundle ::
-  :: forall msg s e.
+  forall msg s e.
-     (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s)
+  (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s) =>
-  => (MP.ParseError s e -> Bool)    -- ^ How to decide whether this is an error or a warning diagnostic
+  -- | How to decide whether this is an error or a warning diagnostic
-  -> msg                            -- ^ The error message of the diagnostic
+  (MP.ParseError s e -> Bool) ->
-  -> Maybe [msg]                    -- ^ Default hints when trivial errors are reported
+  -- | The error message of the diagnostic
-  -> MP.ParseErrorBundle s e        -- ^ The bundle to create a diagnostic from
+  msg ->
-  -> Diagnostic msg
+  -- | Default hints when trivial errors are reported
+  Maybe [msg] ->
+  -- | The bundle to create a diagnostic from
+  MP.ParseErrorBundle s e ->
+  Diagnostic msg
 diagnosticFromBundle isError msg (fromMaybe [] -> trivialHints) MP.ParseErrorBundle {..} =
   foldl addReport def (toLabeledPosition <$> bundleErrors)
   where
@@ -43,8 +53,11 @@ diagnosticFromBundle isError msg (fromMaybe [] -> trivialHints) MP.ParseErrorBun
       let (_, pos) = MP.reachOffset (MP.errorOffset error) bundlePosState
           source = fromSourcePos (MP.pstateSourcePos pos)
           msgs = fromString @msg <$> lines (MP.parseErrorTextPretty error)
-      in flip (msg & if isError error then err else warn) (errorHints error)
+       in flip
-           if | [m] <- msgs      -> [ (source, This m) ]
+            (msg & if isError error then err else warn)
+            (errorHints error)
+            if
+                | [m] <- msgs -> [(source, This m)]
                 | [m1, m2] <- msgs -> [(source, This m1), (source, Where m2)]
                 | otherwise -> [(source, This $ fromString "<<Unknown error>>")]
 
@@ -56,31 +69,37 @@ diagnosticFromBundle isError msg (fromMaybe [] -> trivialHints) MP.ParseErrorBun
 
     errorHints :: MP.ParseError s e -> [msg]
     errorHints MP.TrivialError {} = trivialHints
-    errorHints (MP.FancyError _ errs) = Set.toList errs >>= \ case
+    errorHints (MP.FancyError _ errs) =
+      Set.toList errs >>= \case
         MP.ErrorCustom e -> hints e
         _ -> mempty
 
 -- | Creates an error diagnostic from a megaparsec 'MP.ParseErrorBundle'.
-errorDiagnosticFromBundle
+errorDiagnosticFromBundle ::
-  :: forall msg s e.
+  forall msg s e.
-     (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s)
+  (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s) =>
-  => msg                              -- ^ The error message of the diagnostic
+  -- | The error message of the diagnostic
-  -> Maybe [msg]                      -- ^ Default hints when trivial errors are reported
+  msg ->
-  -> MP.ParseErrorBundle s e          -- ^ The bundle to create a diagnostic from
+  -- | Default hints when trivial errors are reported
-  -> Diagnostic msg
+  Maybe [msg] ->
+  -- | The bundle to create a diagnostic from
+  MP.ParseErrorBundle s e ->
+  Diagnostic msg
 errorDiagnosticFromBundle = diagnosticFromBundle (const True)
 
 -- | Creates a warning diagnostic from a megaparsec 'MP.ParseErrorBundle'.
-warningDiagnosticFromBundle
+warningDiagnosticFromBundle ::
-  :: forall msg s e.
+  forall msg s e.
-     (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s)
+  (IsString msg, MP.Stream s, HasHints e msg, MP.ShowErrorComponent e, MP.VisualStream s, MP.TraversableStream s) =>
-  => msg                              -- ^ The error message of the diagnostic
+  -- | The error message of the diagnostic
-  -> Maybe [msg]                      -- ^ Default hints when trivial errors are reported
+  msg ->
-  -> MP.ParseErrorBundle s e          -- ^ The bundle to create a diagnostic from
+  -- | Default hints when trivial errors are reported
-  -> Diagnostic msg
+  Maybe [msg] ->
+  -- | The bundle to create a diagnostic from
+  MP.ParseErrorBundle s e ->
+  Diagnostic msg
 warningDiagnosticFromBundle = diagnosticFromBundle (const False)
 
-
 ------------------------------------
 ------------ INTERNAL --------------
 ------------------------------------

src/Error/Diagnose/Compat/Parsec.hs

@@ -1,37 +1,48 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE FlexibleContexts #-}
 
 {-# OPTIONS -Wno-name-shadowing #-}
 
+-- |
+-- Module      : Error.Diagnose.Compat.Parsec
+-- Description : Compatibility layer for parsec
+-- Copyright   : (c) Mesabloo, 2021
+-- License     : BSD3
+-- Stability   : experimental
+-- Portability : Portable
 module Error.Diagnose.Compat.Parsec
-( diagnosticFromParseError
+  ( diagnosticFromParseError,
-, errorDiagnosticFromParseError
+    errorDiagnosticFromParseError,
-, warningDiagnosticFromParseError
+    warningDiagnosticFromParseError,
-, module Error.Diagnose.Compat.Hints
+    module Error.Diagnose.Compat.Hints,
-) where
+  )
+where
 
 import Data.Bifunctor (second)
 import Data.Function ((&))
-import Data.Maybe (fromMaybe)
 import Data.List (intercalate)
+import Data.Maybe (fromMaybe)
 import Data.String (IsString (..))
 import Data.Void (Void)
-
 import Error.Diagnose
 import Error.Diagnose.Compat.Hints (HasHints (..))
-
 import qualified Text.Parsec.Error as PE
 import qualified Text.Parsec.Pos as PP
 
 -- | Generates a diagnostic from a 'PE.ParseError'.
-diagnosticFromParseError
+diagnosticFromParseError ::
-  :: forall msg. (IsString msg, HasHints Void msg)
+  forall msg.
-  => (PE.ParseError -> Bool)         -- ^ Determine whether the diagnostic is an error or a warning
+  (IsString msg, HasHints Void msg) =>
-  -> msg                             -- ^ The main error of the diagnostic
+  -- | Determine whether the diagnostic is an error or a warning
-  -> Maybe [msg]                     -- ^ Default hints
+  (PE.ParseError -> Bool) ->
-  -> PE.ParseError                   -- ^ The 'PE.ParseError' to transform into a 'Diagnostic'
+  -- | The main error of the diagnostic
-  -> Diagnostic msg
+  msg ->
+  -- | Default hints
+  Maybe [msg] ->
+  -- | The 'PE.ParseError' to transform into a 'Diagnostic'
+  PE.ParseError ->
+  Diagnostic msg
 diagnosticFromParseError isError msg (fromMaybe [] -> defaultHints) error =
   let pos = fromSourcePos $ PE.errorPos error
       markers = toMarkers pos $ PE.errorMessages error
@@ -54,32 +65,38 @@ diagnosticFromParseError isError msg (fromMaybe [] -> defaultHints) error =
           putTogether (PE.Message thing : ms) = let (a, b, c, d) = putTogether ms in (a, b, c, thing : d)
 
           (sysUnexpectedList, unexpectedList, expectedList, messages) = putTogether msgs
-      in [ (source, marker) | unexpected <- if null unexpectedList then sysUnexpectedList else unexpectedList
+       in [ (source, marker) | unexpected <- if null unexpectedList then sysUnexpectedList else unexpectedList, let marker = This $ fromString $ "unexpected " <> unexpected
-                            , let marker = This $ fromString $ "unexpected " <> unexpected ]
+          ]
-      <> [ (source, marker) | msg <- messages
+            <> [ (source, marker) | msg <- messages, let marker = This $ fromString msg
-                            , let marker = This $ fromString msg ]
+               ]
             <> [(source, Where $ fromString $ "expecting any of " <> intercalate ", " expectedList)]
 
 -- | Generates an error diagnostic from a 'PE.ParseError'.
-errorDiagnosticFromParseError
+errorDiagnosticFromParseError ::
-  :: forall msg. (IsString msg, HasHints Void msg)
+  forall msg.
-  => msg                  -- ^ The main error message of the diagnostic
+  (IsString msg, HasHints Void msg) =>
-  -> Maybe [msg]          -- ^ Default hints
+  -- | The main error message of the diagnostic
-  -> PE.ParseError        -- ^ The 'PE.ParseError' to convert
+  msg ->
-  -> Diagnostic msg
+  -- | Default hints
+  Maybe [msg] ->
+  -- | The 'PE.ParseError' to convert
+  PE.ParseError ->
+  Diagnostic msg
 errorDiagnosticFromParseError = diagnosticFromParseError (const True)
 
 -- | Generates a warning diagnostic from a 'PE.ParseError'.
-warningDiagnosticFromParseError
+warningDiagnosticFromParseError ::
-  :: forall msg. (IsString msg, HasHints Void msg)
+  forall msg.
-  => msg                  -- ^ The main error message of the diagnostic
+  (IsString msg, HasHints Void msg) =>
-  -> Maybe [msg]          -- ^ Default hints
+  -- | The main error message of the diagnostic
-  -> PE.ParseError        -- ^ The 'PE.ParseError' to convert
+  msg ->
-  -> Diagnostic msg
+  -- | Default hints
+  Maybe [msg] ->
+  -- | The 'PE.ParseError' to convert
+  PE.ParseError ->
+  Diagnostic msg
 warningDiagnosticFromParseError = diagnosticFromParseError (const False)
 
-
-
 ------------------------------------
 ------------ INTERNAL --------------
 ------------------------------------
@@ -89,4 +106,3 @@ warningDiagnosticFromParseError = diagnosticFromParseError (const False)
 --   > both f = bimap @(,) f f
 both :: (a -> b) -> (a, a) -> (b, b)
 both f ~(x, y) = (f x, f y)
-

src/Error/Diagnose/Diagnostic.hs

@@ -1,22 +1,26 @@
 {-# LANGUAGE CPP #-}
 
-{-|
+-- |
-Module      : Error.Diagnose.Diagnostic
+-- Module      : Error.Diagnose.Diagnostic
-Description : Diagnostic definition and pretty printing
+-- Description : Diagnostic definition and pretty printing
-Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021
-License     : BSD3
+-- License     : BSD3
-Stability   : experimental
+-- Stability   : experimental
-Portability : Portable
+-- Portability : Portable
--}
 module Error.Diagnose.Diagnostic
   ( -- * Re-exports
-    module Export ) where
+    module Export,
+  )
+where
 
 import Error.Diagnose.Diagnostic.Internal as Export
-  (Diagnostic, def, printDiagnostic,
+  ( Diagnostic,
 #ifdef USE_AESON
   diagnosticToJson,
 #endif
-  addFile, addReport)
+    addFile,
-
+    addReport,
-import System.IO as Export (stdout, stderr)
+    def,
+    printDiagnostic,
+  )
+import System.IO as Export (stderr, stdout)

src/Error/Diagnose/Diagnostic/Internal.hs

@@ -1,23 +1,21 @@
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
 
-{-|
+-- |
-Module      : Error.Diagnose.Diagnostic.Internal
+-- Module      : Error.Diagnose.Diagnostic.Internal
-Description : Internal workings for diagnostic definitions and pretty printing.
+-- Description : Internal workings for diagnostic definitions and pretty printing.
-Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021
-License     : BSD3
+-- License     : BSD3
-Stability   : experimental
+-- Stability   : experimental
-Portability : Portable
+-- Portability : Portable
-
+--
-/Warning/: The API of this module can break between two releases, therefore you should not rely on it.
+-- /Warning/: The API of this module can break between two releases, therefore you should not rely on it.
-           It is also highly undocumented.
+--            It is also highly undocumented.
-
+--
-           Please limit yourself to the "Error.Diagnose.Diagnostic" module, which exports some of the useful functions defined here.
+--            Please limit yourself to the "Error.Diagnose.Diagnostic" module, which exports some of the useful functions defined here.
--}
 module Error.Diagnose.Diagnostic.Internal (module Error.Diagnose.Diagnostic.Internal, def) where
 
 import Control.Monad.IO.Class (MonadIO, liftIO)
-
 #ifdef USE_AESON
 import Data.Aeson (ToJSON(..), encode, object, (.=))
 import Data.ByteString.Lazy (ByteString)
@@ -27,26 +25,24 @@ import Data.Foldable (fold)
 import Data.HashMap.Lazy (HashMap)
 import qualified Data.HashMap.Lazy as HashMap
 import Data.List (intersperse)
-
 import Error.Diagnose.Report (Report)
 import Error.Diagnose.Report.Internal (prettyReport)
-
+import Prettyprinter (Doc, Pretty, hardline, unAnnotate)
+import Prettyprinter.Render.Terminal (AnsiStyle, hPutDoc)
 import System.IO (Handle)
 
-import Prettyprinter (Pretty, Doc, unAnnotate, hardline)
-import Prettyprinter.Render.Terminal (hPutDoc, AnsiStyle)
-
-
 -- | The data type for diagnostic containing messages of an abstract type.
 --
 --   The constructors are private, but users can use 'def' from the 'Default' typeclass
 --   to create a new empty diagnostic, and 'addFile' and 'addReport' to alter its internal state.
 data Diagnostic msg
   = Diagnostic
-      [Report msg]                  -- ^ All the reports contained in a diagnostic.
+      [Report msg]
+      -- ^ All the reports contained in a diagnostic.
       --
       --   Reports are output one by one, without connections in between.
-      (HashMap FilePath [String])   -- ^ A map associating files with their content as lists of lines.
+      (HashMap FilePath [String])
+      -- ^ A map associating files with their content as lists of lines.
 
 instance Default (Diagnostic msg) where
   def = Diagnostic mempty mempty
@@ -69,21 +65,29 @@ instance ToJSON msg => ToJSON (Diagnostic msg) where
 
 -- | Pretty prints a diagnostic into a 'Doc'ument that can be output using
 --   'Text.PrettyPrint.ANSI.Leijen.hPutDoc' or 'Text.PrettyPrint.ANSI.Leijen.displayIO'.
-prettyDiagnostic :: Pretty msg
+prettyDiagnostic ::
-                 => Bool                -- ^ Should we use unicode when printing paths?
+  Pretty msg =>
-                 -> Diagnostic msg      -- ^ The diagnostic to print
+  -- | Should we use unicode when printing paths?
-                 -> Doc AnsiStyle
+  Bool ->
+  -- | The diagnostic to print
+  Diagnostic msg ->
+  Doc AnsiStyle
 prettyDiagnostic withUnicode (Diagnostic reports file) =
   fold . intersperse hardline $ prettyReport file withUnicode <$> reports
 {-# INLINE prettyDiagnostic #-}
 
 -- | Prints a 'Diagnostic' onto a specific 'Handle'.
-printDiagnostic :: (MonadIO m, Pretty msg)
+printDiagnostic ::
-                => Handle                   -- ^ The handle onto which to output the diagnostic.
+  (MonadIO m, Pretty msg) =>
-                -> Bool                     -- ^ Should we print with unicode characters?
+  -- | The handle onto which to output the diagnostic.
-                -> Bool                     -- ^ 'False' to disable colors.
+  Handle ->
-                -> Diagnostic msg           -- ^ The diagnostic to output.
+  -- | Should we print with unicode characters?
-                -> m ()
+  Bool ->
+  -- | 'False' to disable colors.
+  Bool ->
+  -- | The diagnostic to output.
+  Diagnostic msg ->
+  m ()
 printDiagnostic handle withUnicode withColors diag =
   liftIO $ hPutDoc handle (unlessId withColors unAnnotate $ prettyDiagnostic withUnicode diag)
   where
@@ -92,18 +96,23 @@ printDiagnostic handle withUnicode withColors diag =
 {-# INLINE printDiagnostic #-}
 
 -- | Inserts a new referenceable file within the diagnostic.
-addFile :: Diagnostic msg
+addFile ::
-        -> FilePath         -- ^ The path to the file.
+  Diagnostic msg ->
-        -> String           -- ^ The content of the file as a single string, where lines are ended by @\n@.
+  -- | The path to the file.
-        -> Diagnostic msg
+  FilePath ->
+  -- | The content of the file as a single string, where lines are ended by @\n@.
+  String ->
+  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
+addReport ::
-          -> Report msg       -- ^ The new report to add to the diagnostic.
+  Diagnostic msg ->
-          -> Diagnostic msg
+  -- | The new report to add to the diagnostic.
+  Report msg ->
+  Diagnostic msg
 addReport (Diagnostic reports files) report =
   Diagnostic (report : reports) files
 {-# INLINE addReport #-}

src/Error/Diagnose/Position.hs

@@ -1,17 +1,16 @@
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
 
-{-|
+-- |
-Module      : Error.Diagnose.Diagnostic
+-- Module      : Error.Diagnose.Diagnostic
-Description : Defines location information as a simple record.
+-- Description : Defines location information as a simple record.
-Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021
-License     : BSD3
+-- License     : BSD3
-Stability   : experimental
+-- Stability   : experimental
-Portability : Portable
+-- Portability : Portable
--}
 module Error.Diagnose.Position (Position (..)) where
 
 #ifdef USE_AESON
@@ -20,29 +19,23 @@ import Data.Aeson (ToJSON(..), object, (.=))
 import Data.Default (Default, def)
 import Data.Hashable (Hashable)
 import Data.Text (Text)
-
 import GHC.Generics (Generic (..))
-
 import Prettyprinter (Pretty (..), colon)
+
 -- import Text.PrettyPrint.ANSI.Leijen (Pretty(..), text, colon, int)
 
-
+-- | Contains information about the location of something.
--- | Contains information about the location about something.
 --
 --   It is best used in a datatype like:
 --
 --   > data Located a
 --   >   = a :@ Position
 --   >   deriving (Show, Eq, Ord, Functor, Traversable)
-data Position
+data Position = Position
-  = Position
+  { -- | The beginning line and column of the span.
-  {
+    begin :: (Int, Int),
-      -- | The beginning line and column of the span.
-      begin :: (Int, Int)
-  ,
     -- | The end line and column of the span.
-      end   :: (Int, Int)
+    end :: (Int, Int),
-  ,
     -- | The file this position spans in.
     file :: FilePath
   }
@@ -53,10 +46,11 @@ instance Ord Position where
 
 instance Pretty Position where
   pretty (Position (bl, bc) (el, ec) f) = pretty f <> at <> pretty bl <> colon <> pretty bc <> dash <> pretty el <> colon <> pretty ec
-    where at = pretty @Text "@"
+    where
+      at = pretty @Text "@"
       dash = pretty @Text "-"
 
-instance Hashable Position where
+instance Hashable Position
 
 instance Default Position where
   def = Position (1, 1) (1, 1) "<no-file>"

src/Error/Diagnose/Report.hs

@@ -1,13 +1,14 @@
-{-|
+-- |
-Module      : Error.Diagnose.Report
+-- Module      : Error.Diagnose.Report
-Description : Report definition and pretty printing
+-- Description : Report definition and pretty printing
-Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021
-License     : BSD3
+-- License     : BSD3
-Stability   : experimental
+-- Stability   : experimental
-Portability : Portable
+-- Portability : Portable
--}
 module Error.Diagnose.Report
   ( -- * Re-exports
-    module Export ) where
+    module Export,
+  )
+where
 
-import Error.Diagnose.Report.Internal as Export (Report, warn, err, Marker(..))
+import Error.Diagnose.Report.Internal as Export (Marker (..), Report, err, warn)