diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -27,6 +27,7 @@
 - Support for optional custom error codes, if you want to go the Rust way
 - Variable width Unicode characters are handled in a crossplatform manner
 - TAB characters have custom sizes specified when printing a diagnostic, so that *you* decide the width of a TAB, not your terminal emulator!
+- Colors can be tweaked thanks to the ability to export diagnostics as `Doc`uments
 
 ## Usage
 
@@ -77,8 +78,10 @@
 Once your reports are created, you will need to add them inside the diagnostic using `addReport`.
 You will also need to put your files into the diagnostic with `addFile`, else lines won't be printed and you will get `<no-line>` in your reports.
 
-After all of this is done, you may choose to either print the diagnostic onto a handle using `printDiagnostic`
-or export it to JSON with `diagnosticToJson` or the `ToJSON` class of Aeson (the output format is documented under the `diagnosticToJson` function).
+After all of this is done, you may choose to either:
+- print the diagnostic onto a file `Handle` (most likely `stdout` or `stderr`) using `printDiagnostic`;
+- create a `Doc`ument which can be further altered using `prettyDiagnostic`;
+- or export it to JSON with `diagnosticToJson` or the `ToJSON` class of Aeson (the output format is documented under the `diagnosticToJson` function).
 
 ## Example
 
@@ -98,11 +101,11 @@
 let diagnostic  = addFile def "somefile.zc" "let id<a>(x : a) : a := x\n  + 1"
 let diagnostic' = addReport diagnostic beautifulExample
 
--- Print with unicode characters and colors
-printDiagnostic stdout True True 4 diagnostic'
+-- Print with unicode characters, colors and the default style
+printDiagnostic stdout True True 4 defaultStyle diagnostic'
 ```
 
-More examples are given in the [`test/rendering`](./test/rendering) folder.
+More examples are given in the [`test/rendering`](./test/rendering) folder (execute `stack test` to see the output).
 
 ## TODO list
 
@@ -112,4 +115,4 @@
 
 This work is licensed under the BSD-3 clause license.
 
-Copyright (c) 2021- Mesabloo, all rights reserved.
+Copyright (c) 2021-2022 Mesabloo, all rights reserved.
diff --git a/diagnose.cabal b/diagnose.cabal
--- a/diagnose.cabal
+++ b/diagnose.cabal
@@ -5,7 +5,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           diagnose
-version:        1.9.0
+version:        2.0.0
 synopsis:       Beautiful error reporting done easily
 description:    This package provides a simple way of getting beautiful compiler/interpreter errors
                 using a very simple interface for the programmer.
@@ -17,7 +17,7 @@
 bug-reports:    https://github.com/mesabloo/diagnose/issues
 author:         Ghilain Bergeron
 maintainer:     Ghilain Bergeron
-copyright:      2021- Ghilain Bergeron
+copyright:      2021-2022 Ghilain Bergeron
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
@@ -50,6 +50,7 @@
       Error.Diagnose.Position
       Error.Diagnose.Pretty
       Error.Diagnose.Report
+      Error.Diagnose.Style
   other-modules:
       Data.List.Safe
       Error.Diagnose.Compat.Hints
@@ -95,6 +96,8 @@
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Instances
+      Repro6
       Paths_diagnose
   hs-source-dirs:
       test/megaparsec
diff --git a/src/Error/Diagnose.hs b/src/Error/Diagnose.hs
--- a/src/Error/Diagnose.hs
+++ b/src/Error/Diagnose.hs
@@ -10,9 +10,12 @@
     -- ** Creating diagnostics from reports
     -- $create_diagnostic
 
-    -- *** Pretty-printing a diagnostic
+    -- *** Pretty-printing a diagnostic onto a file 'System.IO.Handle'
     -- $diagnostic_pretty
 
+    -- *** Pretty-printing a diagnostic as a document
+    -- $diagnostic_to_doc
+
     -- *** Exporting a diagnostic to JSON
     -- $diagnostic_json
 
@@ -37,6 +40,7 @@
 import Error.Diagnose.Position as Export
 import Error.Diagnose.Pretty as Export
 import Error.Diagnose.Report as Export
+import Error.Diagnose.Style as Export
 
 -- $header
 --
@@ -95,13 +99,13 @@
 --
 --   Markers put in the report can be one of (the colors specified are used only when pretty-printing):
 --
---   - A 'This' marker, which is the primary marker of the report.
+--   - A 'Error.Diagnose.Report.This' marker, which is the primary marker of the report.
 --     While it is allowed to have multiple of these inside one report, it is encouraged not to, because the position at the top of
---     the report will only be the one of the /first/ 'This' marker, and because the resulting report may be harder to understand.
+--     the report will only be the one of the /first/ 'Error.Diagnose.Report.This' marker, and because the resulting report may be harder to understand.
 --
 --         This marker is output in red in an error report, and yellow in a warning report.
 --
---   - A 'Where' marker contains additional information/provides context to the error/warning report.
+--   - A 'Error.Diagnose.Report.Where' marker contains additional information/provides context to the error/warning report.
 --     For example, it may underline where a given variable @x@ is bound to emphasize it.
 --
 --         This marker is output in blue.
@@ -117,7 +121,8 @@
 --   and returns a 'Diagnostic') to insert a new report inside the diagnostic, or 'addFile' (which takes a 'Diagnostic', a 'FilePath' and a @['String']@,
 --   and returns a 'Diagnostic') to insert a new file reference in the diagnostic.
 --
---   You can then either pretty-print the diagnostic obtained (which requires all messages to be instances of the 'Text.PrettyPrint.ANSI.Leijen.Pretty')
+--   You can then either pretty-print the diagnostic obtained (which requires all messages to be instances of the 'Prettyprinter.Pretty')
+--   -- directly onto a file handle or as a plain 'Prettyprinter.Doc'ument --
 --   or export it to a lazy JSON 'Data.Bytestring.Lazy.ByteString' (e.g. in a LSP context).
 
 -- $diagnostic_pretty
@@ -152,7 +157,19 @@
 --
 --   - A 'Int' describing the number of spaces with which to output a TAB character.
 --
+--   - The 'Style' describing colors of the report.
+--     See the module "Error.Diagnose.Style" for how to define new styles.
+--
 --   - And finally the 'Diagnostic' to output.
+
+-- $diagnostic_to_doc
+--
+-- 'Diagnostic's can be “output” (at least ready to be rendered) to a 'Prettyprinter.Doc' using 'prettyDiagnostic', which allows it to be easily added to other 'Prettyprinter.Doc' outputs.
+-- This makes it easy to customize the error messages further (though not the internal parts, only adding to it).
+-- As a 'Prettyprinter.Doc', there is also the possibility of altering internal annotations (styles) much easier (although this is already possible when printing the diagnostic).
+--
+-- The arguments of the function mostly follow the ones from 'printDiagnostic'.
+-- The style is not one, as it can be applied by simply applying the styling function to the resulting function (if wanted).
 
 -- $diagnostic_json
 --
diff --git a/src/Error/Diagnose/Compat/Megaparsec.hs b/src/Error/Diagnose/Compat/Megaparsec.hs
--- a/src/Error/Diagnose/Compat/Megaparsec.hs
+++ b/src/Error/Diagnose/Compat/Megaparsec.hs
@@ -11,7 +11,7 @@
 -- |
 -- Module      : Error.Diagnose.Compat.Megaparsec
 -- Description : Compatibility layer for megaparsec
--- Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021-2022
 -- License     : BSD3
 -- Stability   : experimental
 -- Portability : Portable
diff --git a/src/Error/Diagnose/Compat/Parsec.hs b/src/Error/Diagnose/Compat/Parsec.hs
--- a/src/Error/Diagnose/Compat/Parsec.hs
+++ b/src/Error/Diagnose/Compat/Parsec.hs
@@ -7,7 +7,7 @@
 -- |
 -- Module      : Error.Diagnose.Compat.Parsec
 -- Description : Compatibility layer for parsec
--- Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021-2022
 -- License     : BSD3
 -- Stability   : experimental
 -- Portability : Portable
diff --git a/src/Error/Diagnose/Diagnostic.hs b/src/Error/Diagnose/Diagnostic.hs
--- a/src/Error/Diagnose/Diagnostic.hs
+++ b/src/Error/Diagnose/Diagnostic.hs
@@ -3,7 +3,7 @@
 -- |
 -- Module      : Error.Diagnose.Diagnostic
 -- Description : Diagnostic definition and pretty printing
--- Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021-2022
 -- License     : BSD3
 -- Stability   : experimental
 -- Portability : Portable
diff --git a/src/Error/Diagnose/Diagnostic/Internal.hs b/src/Error/Diagnose/Diagnostic/Internal.hs
--- a/src/Error/Diagnose/Diagnostic/Internal.hs
+++ b/src/Error/Diagnose/Diagnostic/Internal.hs
@@ -4,7 +4,7 @@
 -- |
 -- Module      : Error.Diagnose.Diagnostic.Internal
 -- Description : Internal workings for diagnostic definitions and pretty printing.
--- Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021-2022
 -- License     : BSD3
 -- Stability   : experimental
 -- Portability : Portable
@@ -27,8 +27,9 @@
 import Data.List (intersperse)
 import Error.Diagnose.Report (Report)
 import Error.Diagnose.Report.Internal (prettyReport)
+import Error.Diagnose.Style (Annotation, Style)
 import Prettyprinter (Doc, Pretty, hardline, unAnnotate)
-import Prettyprinter.Render.Terminal (AnsiStyle, hPutDoc)
+import Prettyprinter.Render.Terminal (hPutDoc)
 import System.IO (Handle)
 
 -- | The data type for diagnostic containing messages of an abstract type.
@@ -69,6 +70,11 @@
 --   If you do not want these, just 'unAnnotate' the resulting document like so:
 --
 --   >>> let doc = unAnnotate (prettyDiagnostic withUnicode tabSize diagnostic)
+--
+--   Changing the style is also rather easy:
+--
+--   >>> let myCustomStyle :: Style = _
+--   >>> let doc = myCustomStyle (prettyDiagnostic withUnicode tabSize diagnostic)
 prettyDiagnostic ::
   Pretty msg =>
   -- | Should we use unicode when printing paths?
@@ -77,7 +83,7 @@
   Int ->
   -- | The diagnostic to print.
   Diagnostic msg ->
-  Doc AnsiStyle
+  Doc Annotation
 prettyDiagnostic withUnicode tabSize (Diagnostic reports file) =
   fold . intersperse hardline $ prettyReport file withUnicode tabSize <$> reports
 {-# INLINE prettyDiagnostic #-}
@@ -93,14 +99,13 @@
   Bool ->
   -- | The number of spaces each TAB character will span.
   Int ->
+  -- | The style in which to output the diagnostic.
+  Style ->
   -- | The diagnostic to output.
   Diagnostic msg ->
   m ()
-printDiagnostic handle withUnicode withColors tabSize diag =
-  liftIO $ hPutDoc handle (unlessId withColors unAnnotate $ prettyDiagnostic withUnicode tabSize diag)
-  where
-    unlessId cond app = if cond then id else app
-    {-# INLINE unlessId #-}
+printDiagnostic handle withUnicode withColors tabSize style diag =
+  liftIO $ hPutDoc handle ((if withColors then style else unAnnotate) $ prettyDiagnostic withUnicode tabSize diag)
 {-# INLINE printDiagnostic #-}
 
 -- | Inserts a new referenceable file within the diagnostic.
@@ -122,7 +127,7 @@
   Report msg ->
   Diagnostic msg
 addReport (Diagnostic reports files) report =
-  Diagnostic (report : reports) files
+  Diagnostic (reports <> [report]) files
 {-# INLINE addReport #-}
 
 #ifdef USE_AESON
diff --git a/src/Error/Diagnose/Position.hs b/src/Error/Diagnose/Position.hs
--- a/src/Error/Diagnose/Position.hs
+++ b/src/Error/Diagnose/Position.hs
@@ -7,7 +7,7 @@
 -- |
 -- Module      : Error.Diagnose.Diagnostic
 -- Description : Defines location information as a simple record.
--- Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021-2022
 -- License     : BSD3
 -- Stability   : experimental
 -- Portability : Portable
diff --git a/src/Error/Diagnose/Report.hs b/src/Error/Diagnose/Report.hs
--- a/src/Error/Diagnose/Report.hs
+++ b/src/Error/Diagnose/Report.hs
@@ -1,7 +1,7 @@
 -- |
 -- Module      : Error.Diagnose.Report
 -- Description : Report definition and pretty printing
--- Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021-2022
 -- License     : BSD3
 -- Stability   : experimental
 -- Portability : Portable
diff --git a/src/Error/Diagnose/Report/Internal.hs b/src/Error/Diagnose/Report/Internal.hs
--- a/src/Error/Diagnose/Report/Internal.hs
+++ b/src/Error/Diagnose/Report/Internal.hs
@@ -10,7 +10,7 @@
 -- |
 -- Module      : Error.Diagnose.Report.Internal
 -- Description : Internal workings for report definitions and pretty printing.
--- Copyright   : (c) Mesabloo, 2021
+-- Copyright   : (c) Mesabloo, 2021-2022
 -- License     : BSD3
 -- Stability   : experimental
 -- Portability : Portable
@@ -38,9 +38,9 @@
 import qualified Data.List.Safe as List
 import Data.Ord (Down (Down))
 import Error.Diagnose.Position
+import Error.Diagnose.Style (Annotation (..))
 import Prettyprinter (Doc, Pretty (..), align, annotate, colon, hardline, lbracket, rbracket, space, width, (<+>))
 import Prettyprinter.Internal (Doc (..))
-import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), bold, color, colorDull)
 
 -- | The type of diagnostic reports with abstract message type.
 data Report msg
@@ -141,7 +141,7 @@
   Int ->
   -- | The whole report to output
   Report msg ->
-  Doc AnsiStyle
+  Doc Annotation
 prettyReport fileContent withUnicode tabSize (Report isError code message markers hints) =
   let sortedMarkers = List.sortOn (fst . begin . fst) markers
       -- sort the markers so that the first lines of the reports are the first lines of the file
@@ -154,7 +154,7 @@
 
       header =
         annotate
-          (bold <> color if isError then Red else Yellow)
+          (KindColor isError)
           ( lbracket
               <> ( if isError
                      then "error"
@@ -189,7 +189,7 @@
         <> {- (6) -} ( if null markers && null hints
                          then mempty
                          else
-                           annotate (bold <> color Black) (pad (maxLineNumberLength + 2) (if withUnicode then '─' else '-') mempty <> if withUnicode then "╯" else "+")
+                           annotate RuleColor (pad (maxLineNumberLength + 2) (if withUnicode then '─' else '-') mempty <> if withUnicode then "╯" else "+")
                              <> hardline
                      )
 
@@ -212,8 +212,8 @@
   Int ->
   -- | Whether to print with unicode characters or not.
   Bool ->
-  Doc AnsiStyle
-dotPrefix leftLen withUnicode = pad leftLen ' ' mempty <+> annotate (bold <> color Black) (if withUnicode then "•" else ":")
+  Doc Annotation
+dotPrefix leftLen withUnicode = pad leftLen ' ' mempty <+> annotate RuleColor (if withUnicode then "•" else ":")
 {-# INLINE dotPrefix #-}
 
 -- | Creates a "pipe"-prefix for a report line where there is no code.
@@ -227,8 +227,8 @@
   Int ->
   -- | Whether to print with unicode characters or not.
   Bool ->
-  Doc AnsiStyle
-pipePrefix leftLen withUnicode = pad leftLen ' ' mempty <+> annotate (bold <> color Black) (if withUnicode then "│" else "|")
+  Doc Annotation
+pipePrefix leftLen withUnicode = pad leftLen ' ' mempty <+> annotate RuleColor (if withUnicode then "│" else "|")
 {-# INLINE pipePrefix #-}
 
 -- | Creates a line-prefix for a report line containing source code
@@ -246,10 +246,10 @@
   Int ->
   -- | Whether to use unicode characters or not.
   Bool ->
-  Doc AnsiStyle
+  Doc Annotation
 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 "|"
+   in annotate RuleColor $ mempty <+> pad (leftLen - lineNoLen) ' ' mempty <> pretty lineNo <+> if withUnicode then "│" else "|"
 {-# INLINE linePrefix #-}
 
 -- | Creates an ellipsis-prefix, when some line numbers are not consecutive.
@@ -261,8 +261,8 @@
 ellipsisPrefix ::
   Int ->
   Bool ->
-  Doc AnsiStyle
-ellipsisPrefix leftLen withUnicode = pad leftLen ' ' mempty <> annotate (bold <> color Black) (if withUnicode then space <> "⋮" else "...")
+  Doc Annotation
+ellipsisPrefix leftLen withUnicode = pad leftLen ' ' mempty <> annotate RuleColor (if withUnicode then space <> "⋮" else "...")
 
 groupMarkersPerFile ::
   Pretty msg =>
@@ -304,7 +304,7 @@
   Bool ->
   -- | The list of line-ordered markers appearing in a single file
   [(Position, Marker msg)] ->
-  Doc AnsiStyle
+  Doc Annotation
 prettySubReport fileContent withUnicode isError tabSize maxLineNumberLength isFirst markers =
   let (markersPerLine, multilineMarkers) = splitMarkersPerLine markers
       -- split the list on whether markers are multiline or not
@@ -320,13 +320,13 @@
         ( if isFirst
             then
               space <> pad maxLineNumberLength ' ' mempty
-                <+> annotate (bold <> color Black) (if withUnicode then "╭──▶" else "+-->")
+                <+> annotate RuleColor (if withUnicode then "╭──▶" else "+-->")
             else
               space <> dotPrefix maxLineNumberLength withUnicode <> hardline
-                <> annotate (bold <> color Black) (pad (maxLineNumberLength + 2) (if withUnicode then '─' else '-') mempty)
-                <> annotate (bold <> color Black) (if withUnicode then "┼──▶" else "+-->")
+                <> annotate RuleColor (pad (maxLineNumberLength + 2) (if withUnicode then '─' else '-') mempty)
+                <> annotate RuleColor (if withUnicode then "┼──▶" else "+-->")
         )
-          <+> annotate (bold <> colorDull Green) reportFile
+          <+> annotate FileColor reportFile
    in {- (2) -} hardline <> fileMarker
         <> hardline
           <+> {- (3) -} pipePrefix maxLineNumberLength withUnicode
@@ -357,7 +357,7 @@
   [(Int, [(Position, Marker msg)])] ->
   [(Position, Marker msg)] ->
   [Int] ->
-  Doc AnsiStyle
+  Doc Annotation
 prettyAllLines files withUnicode isError tabSize leftLen inline multiline lineNumbers =
   case lineNumbers of
     [] ->
@@ -427,19 +427,20 @@
 
     showMultiline _ [] = mempty
     showMultiline isLastMultiline multiline =
-      let colorOfLastMultilineMarker = maybe mempty (markerColor isError . snd) (List.safeLast multiline)
+      let colorOfLastMultilineMarker = markerColor isError . snd <$> List.safeLast multiline
           -- take the color of the last multiline marker in case we need to add additional bars
 
           prefix = hardline <+> dotPrefix leftLen withUnicode <> space
-          prefixWithBar color = prefix <> annotate color (if withUnicode then "│ " else "| ")
 
+          prefixWithBar color = prefix <> maybe id annotate color (if withUnicode then "│ " else "| ")
+
           showMultilineMarkerMessage (_, marker) isLast =
             annotate (markerColor isError marker) $
               ( if isLast && isLastMultiline
                   then if withUnicode then "╰╸ " else "`- "
                   else if withUnicode then "├╸ " else "|- "
               )
-                <> replaceLinesWith (if isLast then prefix <> "   " else prefixWithBar (markerColor isError marker) <> space) (pretty $ markerMessage marker)
+                <> replaceLinesWith (if isLast then prefix <> "   " else prefixWithBar (Just $ markerColor isError marker) <> space) (pretty $ markerMessage marker)
 
           showMultilineMarkerMessages [] = []
           showMultilineMarkerMessages [m] = [showMultilineMarkerMessage m True]
@@ -447,9 +448,9 @@
        in prefixWithBar colorOfLastMultilineMarker <> prefix <> fold (List.intersperse prefix $ showMultilineMarkerMessages $ reverse multiline)
 
 -- |
-getLine_ :: HashMap FilePath [String] -> [(Position, Marker msg)] -> Int -> Int -> Bool -> (IntMap.HashMap Int Int, Doc AnsiStyle)
+getLine_ :: HashMap FilePath [String] -> [(Position, Marker msg)] -> Int -> Int -> Bool -> (IntMap.HashMap Int Int, Doc Annotation)
 getLine_ files markers line tabSize isError = case List.safeIndex (line - 1) =<< (HashMap.!?) files . file . fst =<< List.safeHead markers of
-  Nothing -> (mempty, annotate (bold <> colorDull Magenta) "<no line>")
+  Nothing -> (mempty, annotate NoLineColor "<no line>")
   Just code ->
     let (tabs, code') = indexedWithTabsReplaced code
      in ( tabs,
@@ -462,7 +463,7 @@
                       if bl == el
                         then n >= bc && n < ec
                         else (bl == line && n >= bc) || (el == line && n < ec) || (bl < line && el > line)
-               in maybe id ((\m -> annotate (bold <> markerColor isError m)) . snd) (List.safeHead colorizingMarkers) (pretty c)
+               in maybe id ((\m -> annotate (MarkerStyle $ markerColor isError m)) . snd) (List.safeHead colorizingMarkers) (pretty c)
         )
   where
     indexedWithTabsReplaced :: String -> (IntMap.HashMap Int Int, [(Int, Char)])
@@ -474,7 +475,7 @@
     goIndexed n (x : xs) = bimap (IntMap.insert n (wcwidth x)) ((n, x) :) (goIndexed (n + 1) xs)
 
 -- |
-showAllMarkersInLine :: Pretty msg => Bool -> Bool -> (Doc AnsiStyle -> Doc AnsiStyle) -> Bool -> Bool -> Int -> IntMap.HashMap Int Int -> [(Position, Marker msg)] -> Doc AnsiStyle
+showAllMarkersInLine :: Pretty msg => Bool -> Bool -> (Doc Annotation -> Doc Annotation) -> Bool -> Bool -> Int -> IntMap.HashMap Int Int -> [(Position, Marker msg)] -> Doc Annotation
 showAllMarkersInLine _ _ _ _ _ _ _ [] = mempty
 showAllMarkersInLine hasMultilines inSpanOfMultiline colorMultilinePrefix withUnicode isError leftLen widths ms =
   let maxMarkerColumn = snd $ end $ fst $ List.last $ List.sortOn (snd . end . fst) ms
@@ -579,10 +580,10 @@
   -- | The marker to extract the color from.
   Marker msg ->
   -- | A function used to color a 'Doc'.
-  AnsiStyle
-markerColor isError (This _) = if isError then color Red else color Yellow
-markerColor _ (Where _) = colorDull Blue
-markerColor _ (Maybe _) = color Magenta
+  Annotation
+markerColor isError (This _) = ThisColor isError
+markerColor _ (Where _) = WhereColor
+markerColor _ (Maybe _) = MaybeColor
 {-# INLINE markerColor #-}
 
 -- | Retrieves the message held by a marker.
@@ -593,7 +594,7 @@
 {-# INLINE markerMessage #-}
 
 -- | Pretty prints all hints.
-prettyAllHints :: Pretty msg => [msg] -> Int -> Bool -> Doc AnsiStyle
+prettyAllHints :: Pretty msg => [msg] -> Int -> Bool -> Doc Annotation
 prettyAllHints [] _ _ = mempty
 prettyAllHints (h : hs) leftLen withUnicode =
   {-
@@ -601,5 +602,5 @@
         (1)         : Hint: <hint message>
   -}
   let prefix = hardline <+> pipePrefix leftLen withUnicode
-   in prefix <+> annotate (color Cyan) (annotate bold "Hint:" <+> replaceLinesWith (prefix <+> "      ") (pretty h))
+   in prefix <+> annotate HintColor ("Hint:" <+> replaceLinesWith (prefix <+> "      ") (pretty h))
         <> prettyAllHints hs leftLen withUnicode
diff --git a/src/Error/Diagnose/Style.hs b/src/Error/Diagnose/Style.hs
new file mode 100644
--- /dev/null
+++ b/src/Error/Diagnose/Style.hs
@@ -0,0 +1,102 @@
+-- |
+-- Module      : Error.Diagnose.Style
+-- Description : Custom style definitions
+-- Copyright   : (c) Mesabloo, 2021-2022
+-- License     : BSD3
+-- Stability   : experimental
+-- Portability : Portable
+module Error.Diagnose.Style
+  ( -- * Defining new style
+    Annotation (..),
+    Style,
+    -- $defining_new_styles
+
+    -- * Default style specification
+    defaultStyle,
+
+    -- * Re-exports
+    reAnnotate,
+  )
+where
+
+import Prettyprinter (Doc, reAnnotate)
+import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), bold, color, colorDull)
+
+-- $defining_new_styles
+--
+-- Defining new color styles (one may call them "themes") is actually rather easy.
+--
+-- A 'Style' is a function from an annotated 'Doc'ument to another annotated 'Doc'ument.
+-- Note that only the annotation type changes, hence the need of only providing a unidirectional mapping between those.
+--
+-- 'Annotation's are used when creating a 'Doc'ument and are simply placeholders to specify custom colors.
+-- 'AnsiStyle' is the concrete annotation to specify custom colors when rendering a 'Doc'ument.
+--
+-- One may define additional styles as follows:
+--
+-- > myNewCustomStyle :: Style
+-- > myNewCustomStyle = reAnnotate \case
+-- >   -- all cases for all annotations
+--
+-- For simplicity's sake, a default style is given as 'defaultStyle'.
+
+-- | Some annotations as placeholders for colors in a 'Doc'.
+data Annotation
+  = -- | The color of 'Error.Diagnose.Report.This' markers, depending on whether the report is an error
+    --   report or a warning report.
+    ThisColor
+      Bool
+  | -- | The color of 'Error.Diagnose.Report.Maybe' markers.
+    MaybeColor
+  | -- | The color of 'Error.Diagnose.Report.Where' markers.
+    WhereColor
+  | -- | The color for hints.
+    --
+    --   Note that the beginning @Hint:@ text will always be in bold.
+    HintColor
+  | -- | The color for file names.
+    FileColor
+  | -- | The color of the rule separating the code/markers from the line numbers.
+    RuleColor
+  | -- | The color of the @[error]@/@[warning]@ at the top, depending on whether
+    --   this is an error or warning report.
+    KindColor
+      Bool
+  | -- | The color in which to output the @<no line>@ information when the file was not found.
+    NoLineColor
+  | -- | Additional style to apply to marker rules (e.g. bold) on top of some
+    --   already processed color annotation.
+    MarkerStyle
+      Annotation
+
+-- | A style is a function which can be applied using 'reAnnotate'.
+--
+--   It transforms a 'Doc'ument containing 'Annotation's into a 'Doc'ument containing
+--   color information.
+type Style = Doc Annotation -> Doc AnsiStyle
+
+-------------------------------------------
+
+-- | The default style for diagnostics, where:
+--
+--   * 'Error.Diagnose.Report.This' markers are colored in red for errors and yellow for warnings
+--   * 'Error.Diagnose.Report.Where' markers are colored in dull blue
+--   * 'Error.Diagnose.Report.Maybe' markers are colored in magenta
+--   * Marker rules are of the same color of the marker, but also in bold
+--   * Hints are output in cyan
+--   * The left rules are colored in bold black
+--   * File names are output in dull green
+--   * The @[error]@/@[warning]@ at the top is colored in red for errors and yellow for warnings
+defaultStyle :: Style
+defaultStyle = reAnnotate style
+  where
+    style = \case
+      ThisColor isError -> color if isError then Red else Yellow
+      MaybeColor -> color Magenta
+      WhereColor -> colorDull Blue
+      HintColor -> color Cyan
+      FileColor -> bold <> colorDull Green
+      RuleColor -> bold <> color Black
+      KindColor isError -> bold <> style (ThisColor isError)
+      NoLineColor -> bold <> colorDull Magenta
+      MarkerStyle st -> bold <> style st
diff --git a/test/megaparsec/Instances.hs b/test/megaparsec/Instances.hs
new file mode 100644
--- /dev/null
+++ b/test/megaparsec/Instances.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Instances where
+
+import Data.Void (Void)
+import Error.Diagnose
+import Error.Diagnose.Compat.Megaparsec
+
+instance HasHints Void msg where
+  hints _ = mempty
diff --git a/test/megaparsec/Repro6.hs b/test/megaparsec/Repro6.hs
new file mode 100644
--- /dev/null
+++ b/test/megaparsec/Repro6.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+{-# OPTIONS -Wno-orphans #-}
+
+module Repro6 where
+
+import Data.Bifunctor (first)
+import Data.Char (isAlpha)
+import Data.Text (Text)
+import qualified Data.Text as Text (unpack)
+import Data.Void (Void)
+import Error.Diagnose
+import Error.Diagnose.Compat.Megaparsec
+import Instances ()
+import qualified Text.Megaparsec as MP
+import qualified Text.Megaparsec.Char as MP
+import qualified Text.Megaparsec.Char.Lexer as MP
+
+main :: IO ()
+main = do
+  let filename :: FilePath = "<interactive>"
+      content1 :: Text = "0000000123456"
+      content2 :: Text = "00000a2223266"
+      content3 :: Text = "aaa\naab\naba\na\nb\n"
+
+  let res1 = first (errorDiagnosticFromBundle Nothing "Parse error on input" Nothing) $ MP.runParser @Void (MP.some MP.decimal <* MP.eof) filename content1
+      res2 = first (errorDiagnosticFromBundle Nothing "Parse error on input" Nothing) $ MP.runParser @Void (MP.some MP.decimal <* MP.eof) filename content2
+      res3 =
+        first (errorDiagnosticFromBundle Nothing "Parse error on input" Nothing) $
+          let a = MP.char 'a'
+              errSkip e = do
+                MP.registerParseError e
+                _ <- MP.takeWhileP Nothing isAlpha <* MP.eol
+                return ""
+           in MP.runParser @Void
+                (MP.many (MP.withRecovery errSkip (MP.some a <* MP.eol)) <* MP.eof)
+                filename
+                content3
+
+  case res1 of
+    Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content1) :: Diagnostic String)
+    Right res -> print res
+  case res2 of
+    Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content2) :: Diagnostic String)
+    Right res -> print res
+  putStrLn "------------- res3 ----------------"
+  case res3 of
+    Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content3) :: Diagnostic String)
+    Right res -> print res
diff --git a/test/megaparsec/Spec.hs b/test/megaparsec/Spec.hs
--- a/test/megaparsec/Spec.hs
+++ b/test/megaparsec/Spec.hs
@@ -13,13 +13,12 @@
 import Data.Void (Void)
 import Error.Diagnose
 import Error.Diagnose.Compat.Megaparsec
+import Instances ()
+import qualified Repro6
 import qualified Text.Megaparsec as MP
 import qualified Text.Megaparsec.Char as MP
 import qualified Text.Megaparsec.Char.Lexer as MP
 
-instance HasHints Void msg where
-  hints _ = mempty
-
 main :: IO ()
 main = do
   let filename :: FilePath = "<interactive>"
@@ -30,8 +29,12 @@
       res2 = first (errorDiagnosticFromBundle Nothing "Parse error on input" Nothing) $ MP.runParser @Void (MP.some MP.decimal <* MP.eof) filename content2
 
   case res1 of
-    Left diag -> printDiagnostic stdout True True 4 (addFile diag filename (Text.unpack content1) :: Diagnostic String)
+    Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content1) :: Diagnostic String)
     Right res -> print res
   case res2 of
-    Left diag -> printDiagnostic stdout True True 4 (addFile diag filename (Text.unpack content2) :: Diagnostic String)
+    Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content2) :: Diagnostic String)
     Right res -> print res
+
+  putStrLn "---------------------------------------------------"
+
+  Repro6.main
diff --git a/test/parsec/Repro2.hs b/test/parsec/Repro2.hs
--- a/test/parsec/Repro2.hs
+++ b/test/parsec/Repro2.hs
@@ -29,8 +29,8 @@
 
 main :: IO ()
 main = do
-  either (printDiagnostic stderr True True 4) print $ diagParse parser1 "issues/2.txt" "\\1"
-  either (printDiagnostic stderr True True 4) print $ diagParse parser2 "issues/2.txt" "\\1"
+  either (printDiagnostic stderr True True 4 defaultStyle) print $ diagParse parser1 "issues/2.txt" "\\1"
+  either (printDiagnostic stderr True True 4 defaultStyle) print $ diagParse parser2 "issues/2.txt" "\\1"
 
 -- smaller example
 op' :: String -> Parser String
diff --git a/test/parsec/Spec.hs b/test/parsec/Spec.hs
--- a/test/parsec/Spec.hs
+++ b/test/parsec/Spec.hs
@@ -30,10 +30,10 @@
       res2 = first (errorDiagnosticFromParseError Nothing "Parse error on input" Nothing) $ P.parse (P.many1 P.digit <* P.eof) filename content2
 
   case res1 of
-    Left diag -> printDiagnostic stdout True True 4 (addFile diag filename (Text.unpack content1) :: Diagnostic String)
+    Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content1) :: Diagnostic String)
     Right res -> print res
   case res2 of
-    Left diag -> printDiagnostic stdout True True 4 (addFile diag filename (Text.unpack content2) :: Diagnostic String)
+    Left diag -> printDiagnostic stdout True True 4 defaultStyle (addFile diag filename (Text.unpack content2) :: Diagnostic String)
     Right res -> print res
 
   -- all issue reproduction
diff --git a/test/rendering/Spec.hs b/test/rendering/Spec.hs
--- a/test/rendering/Spec.hs
+++ b/test/rendering/Spec.hs
@@ -13,6 +13,7 @@
     addFile,
     addReport,
     def,
+    defaultStyle,
 #ifdef USE_AESON
     diagnosticToJson,
 #endif
@@ -73,12 +74,12 @@
           beautifulExample
         ]
 
-  let diag = HashMap.foldlWithKey' addFile (foldr (flip addReport) def reports) files
+  let diag = HashMap.foldlWithKey' addFile (foldl addReport def reports) files
 
   hPutStrLn stdout "\n\nWith unicode: ─────────────────────────\n"
-  printDiagnostic stdout True True 4 diag
+  printDiagnostic stdout True True 4 defaultStyle diag
   hPutStrLn stdout "\n\nWithout unicode: ----------------------\n"
-  printDiagnostic stdout False True 4 diag
+  printDiagnostic stdout False True 4 defaultStyle diag
 #ifdef USE_AESON
   hPutStrLn stdout "\n\nAs JSON: ------------------------------\n"
   BS.hPutStr stdout (diagnosticToJson diag)