Refactor pretty to reduce duplication (#1443)

* unify pretty Ann

* refactor keywords

* refactor some auxiliary functions

* remove unused indent option

* add Fixity to Juvix.Data

* move juvixYamlFile

app/Main.hs

@@ -30,6 +30,7 @@ import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking qu
 import Juvix.Compiler.Mono.Pretty qualified as Mono
 import Juvix.Compiler.Mono.Translation.FromInternal qualified as Mono
 import Juvix.Compiler.Pipeline
+import Juvix.Extra.Paths qualified as Paths
 import Juvix.Extra.Process
 import Juvix.Extra.Version (runDisplayVersion)
 import Juvix.Prelude hiding (Doc)
@@ -39,9 +40,6 @@ import System.Environment (getProgName)
 import System.Process qualified as Process
 import Text.Show.Pretty hiding (Html)
 
-juvixYamlFile :: FilePath
-juvixYamlFile = "juvix.yaml"
-
 findRoot :: CommandGlobalOptions -> IO (FilePath, Package)
 findRoot copts = do
   let dir :: Maybe FilePath
@@ -63,7 +61,7 @@ findRoot copts = do
     go :: IO (FilePath, Package)
     go = do
       c <- getCurrentDirectory
-      l <- findFile (possiblePaths c) juvixYamlFile
+      l <- findFile (possiblePaths c) Paths.juvixYamlFile
       case l of
         Nothing -> return (c, emptyPackage)
         Just yaml -> do

src/Juvix/Compiler/Abstract/Data/Name.hs

@@ -1,14 +1,14 @@
 module Juvix.Compiler.Abstract.Data.Name
   ( module Juvix.Compiler.Abstract.Data.Name,
-    module Juvix.Compiler.Concrete.Data.NameKind,
+    module Juvix.Data.NameKind,
     module Juvix.Data.NameId,
     module Juvix.Data.Fixity,
   )
 where
 
-import Juvix.Compiler.Concrete.Data.NameKind
 import Juvix.Data.Fixity
 import Juvix.Data.NameId
+import Juvix.Data.NameKind
 import Juvix.Prelude
 import Juvix.Prelude.Pretty
 

src/Juvix/Compiler/Abstract/Pretty.hs

@@ -4,13 +4,10 @@ module Juvix.Compiler.Abstract.Pretty
   )
 where
 
-import Juvix.Compiler.Abstract.Pretty.Ansi qualified as Ansi
 import Juvix.Compiler.Abstract.Pretty.Base
 import Juvix.Compiler.Abstract.Pretty.Options
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
-
-newtype PPOutput = PPOutput (Doc Ann)
 
 ppOutDefault :: PrettyCode c => c -> AnsiText
 ppOutDefault = AnsiText . PPOutput . doc defaultOptions
@@ -20,11 +17,3 @@ ppOut o = AnsiText . PPOutput . doc o
 
 ppTrace :: PrettyCode c => c -> Text
 ppTrace = toAnsiText True . ppOutDefault
-
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)

src/Juvix/Compiler/Abstract/Pretty/Ann.hs

@@ -1,27 +0,0 @@
-module Juvix.Compiler.Abstract.Pretty.Ann where
-
-import Juvix.Compiler.Concrete.Data.NameKind
-import Juvix.Compiler.Concrete.Pretty.Base qualified as S
-import Juvix.Prelude
-
-data Ann
-  = AnnKind NameKind
-  | AnnKeyword
-  | AnnImportant
-  | AnnLiteralString
-  | AnnLiteralInteger
-
-fromScopedAnn :: S.Ann -> Maybe Ann
-fromScopedAnn s = case s of
-  S.AnnKind nk -> Just (AnnKind nk)
-  S.AnnKeyword -> Nothing
-  S.AnnDelimiter -> Nothing
-  S.AnnComment -> Nothing
-  S.AnnUnkindedSym -> Nothing
-  S.AnnDef {} -> Nothing
-  S.AnnRef {} -> Nothing
-  S.AnnLiteralString -> Just AnnLiteralInteger
-  S.AnnLiteralInteger -> Just AnnLiteralString
-
-instance HasNameKindAnn Ann where
-  annNameKind = AnnKind

src/Juvix/Compiler/Abstract/Pretty/Ansi.hs

@@ -1,17 +0,0 @@
-module Juvix.Compiler.Abstract.Pretty.Ansi
-  ( module Juvix.Compiler.Abstract.Pretty.Base,
-    module Juvix.Compiler.Abstract.Pretty.Ansi,
-  )
-where
-
-import Juvix.Compiler.Abstract.Pretty.Base
-import Juvix.Compiler.Concrete.Data.NameKind
-import Prettyprinter.Render.Terminal
-
-stylize :: Ann -> AnsiStyle
-stylize a = case a of
-  AnnKind k -> nameKindAnsi k
-  AnnKeyword -> colorDull Blue
-  AnnImportant -> bold
-  AnnLiteralString -> colorDull Red
-  AnnLiteralInteger -> colorDull Cyan

src/Juvix/Compiler/Abstract/Pretty/Base.hs

@@ -1,17 +1,16 @@
 module Juvix.Compiler.Abstract.Pretty.Base
   ( module Juvix.Compiler.Abstract.Pretty.Base,
-    module Juvix.Compiler.Abstract.Pretty.Ann,
+    module Juvix.Data.CodeAnn,
     module Juvix.Compiler.Abstract.Pretty.Options,
   )
 where
 
 import Juvix.Compiler.Abstract.Extra
-import Juvix.Compiler.Abstract.Pretty.Ann
 import Juvix.Compiler.Abstract.Pretty.Options
 import Juvix.Compiler.Concrete.Pretty.Base qualified as S
+import Juvix.Data.CodeAnn
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
-import Prettyprinter
 
 doc :: PrettyCode c => Options -> c -> Doc Ann
 doc opts =
@@ -22,8 +21,7 @@ doc opts =
 toSOptions :: Options -> S.Options
 toSOptions Options {..} =
   S.defaultOptions
-    { S._optShowNameIds = _optShowNameIds,
-      S._optIndent = _optIndent
+    { S._optShowNameIds = _optShowNameIds
     }
 
 class PrettyCode c where
@@ -32,7 +30,7 @@ class PrettyCode c where
 ppSCode :: (Members '[Reader Options] r, S.PrettyCode c) => c -> Sem r (Doc Ann)
 ppSCode c = do
   opts <- asks toSOptions
-  return $ alterAnnotations (maybeToList . fromScopedAnn) (S.runPrettyCode opts c)
+  return $ S.runPrettyCode opts c
 
 ppDefault :: PrettyCode c => c -> Doc Ann
 ppDefault = runPrettyCode defaultOptions
@@ -40,41 +38,12 @@ ppDefault = runPrettyCode defaultOptions
 runPrettyCode :: PrettyCode c => Options -> c -> Doc Ann
 runPrettyCode opts = run . runReader opts . ppCode
 
-keyword :: Text -> Doc Ann
-keyword = annotate AnnKeyword . pretty
-
-kwType :: Doc Ann
-kwType = keyword Str.type_
-
 kwQuestion :: Doc Ann
 kwQuestion = keyword Str.questionMark
 
 kwWaveArrow :: Doc Ann
 kwWaveArrow = keyword Str.waveArrow
 
-kwColon :: Doc Ann
-kwColon = keyword Str.colon
-
-kwTo :: Doc Ann
-kwTo = keyword Str.toUnicode
-
-kwColonZero :: Doc Ann
-kwColonZero = keyword Str.colonZero
-
-kwColonOne :: Doc Ann
-kwColonOne = keyword Str.colonOne
-
-kwColonOmega :: Doc Ann
-kwColonOmega = keyword Str.colonOmegaUnicode
-
-parensCond :: Bool -> Doc Ann -> Doc Ann
-parensCond t d = if t then parens d else d
-
-implicitDelim :: IsImplicit -> Doc Ann -> Doc Ann
-implicitDelim = \case
-  Implicit -> braces
-  Explicit -> parens
-
 ppPostExpression ::
   (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>
   Fixity ->
@@ -165,7 +134,7 @@ instance PrettyCode Function where
   ppCode Function {..} = do
     funParameter' <- ppCode _funParameter
     funReturn' <- ppRightExpression funFixity _funReturn
-    return $ funParameter' <+> kwTo <+> funReturn'
+    return $ funParameter' <+> kwArrow <+> funReturn'
 
 instance PrettyCode FunctionRef where
   ppCode FunctionRef {..} = ppCode _functionRefName

src/Juvix/Compiler/Abstract/Pretty/Options.hs

@@ -4,7 +4,6 @@ import Juvix.Prelude
 
 data Options = Options
   { _optShowNameIds :: Bool,
-    _optIndent :: Int,
     _optShowDecreasingArgs :: ShowDecrArgs
   }
 
@@ -14,7 +13,6 @@ defaultOptions :: Options
 defaultOptions =
   Options
     { _optShowNameIds = False,
-      _optIndent = 2,
       _optShowDecreasingArgs = OnlyRel
     }
 

src/Juvix/Compiler/Abstract/Translation/FromConcrete.hs

@@ -10,13 +10,12 @@ import Juvix.Compiler.Abstract.Language (FunctionDef (_funDefExamples))
 import Juvix.Compiler.Abstract.Language qualified as Abstract
 import Juvix.Compiler.Abstract.Translation.FromConcrete.Data.Context
 import Juvix.Compiler.Builtins
-import Juvix.Compiler.Concrete.Data.NameKind
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language qualified as Concrete
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error
+import Juvix.Data.NameKind
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 
 newtype ModulesCache = ModulesCache
   {_cachedModules :: HashMap S.NameId Abstract.TopModule}

src/Juvix/Compiler/Backend/C/Extra/Serialization.hs

@@ -2,7 +2,7 @@ module Juvix.Compiler.Backend.C.Extra.Serialization where
 
 import Juvix.Compiler.Backend.C.Language
 import Juvix.Extra.Strings qualified as Str
-import Juvix.Prelude
+import Juvix.Prelude hiding (Binary, Unary)
 import Language.C qualified as C
 import Language.C.Data.Ident qualified as C
 import Language.C.Pretty qualified as P

src/Juvix/Compiler/Backend/C/Translation/FromInternal.hs

@@ -24,7 +24,7 @@ import Juvix.Compiler.Internal.Translation.FromAbstract qualified as Internal
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.ArityChecking.Data.Context qualified as Micro1
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context qualified as Micro
 import Juvix.Extra.Strings qualified as Str
-import Juvix.Prelude
+import Juvix.Prelude hiding (Binary, Unary)
 
 type CompileInfoTable = HashMap Scoper.NameId Scoper.CompileInfo
 

src/Juvix/Compiler/Backend/Haskell/Language.hs

@@ -1,14 +1,14 @@
 module Juvix.Compiler.Backend.Haskell.Language
   ( module Juvix.Compiler.Backend.Haskell.Language,
-    module Juvix.Compiler.Concrete.Data.NameKind,
+    module Juvix.Data.NameKind,
     module Juvix.Data.NameId,
   )
 where
 
-import Juvix.Compiler.Concrete.Data.NameKind
 import Juvix.Compiler.Concrete.Language qualified as C
 import Juvix.Data.Fixity
 import Juvix.Data.NameId
+import Juvix.Data.NameKind
 import Juvix.Prelude
 
 type FunctionName = Name

src/Juvix/Compiler/Backend/Haskell/Pretty.hs

@@ -4,24 +4,13 @@ module Juvix.Compiler.Backend.Haskell.Pretty
   )
 where
 
-import Juvix.Compiler.Backend.Haskell.Pretty.Ansi qualified as Ansi
 import Juvix.Compiler.Backend.Haskell.Pretty.Base
 import Juvix.Compiler.Backend.Haskell.Pretty.Options
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
-
-newtype PPOutput = PPOutput (Doc Ann)
 
 ppOutDefault :: PrettyCode c => c -> AnsiText
 ppOutDefault = AnsiText . PPOutput . doc defaultOptions
 
 ppOut :: PrettyCode c => Options -> c -> AnsiText
 ppOut o = AnsiText . PPOutput . doc o
-
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)

src/Juvix/Compiler/Backend/Haskell/Pretty/Ann.hs

@@ -1,9 +0,0 @@
-module Juvix.Compiler.Backend.Haskell.Pretty.Ann where
-
-import Juvix.Compiler.Concrete.Data.NameKind
-
-data Ann
-  = AnnKind NameKind
-  | AnnKeyword
-  | AnnLiteralString
-  | AnnLiteralInteger

src/Juvix/Compiler/Backend/Haskell/Pretty/Ansi.hs

@@ -1,12 +0,0 @@
-module Juvix.Compiler.Backend.Haskell.Pretty.Ansi where
-
-import Juvix.Compiler.Backend.Haskell.Language
-import Juvix.Compiler.Backend.Haskell.Pretty.Ann
-import Prettyprinter.Render.Terminal
-
-stylize :: Ann -> AnsiStyle
-stylize a = case a of
-  AnnKind k -> nameKindAnsi k
-  AnnKeyword -> colorDull Blue
-  AnnLiteralString -> colorDull Red
-  AnnLiteralInteger -> colorDull Cyan

src/Juvix/Compiler/Backend/Haskell/Pretty/Base.hs

@@ -1,18 +1,17 @@
 module Juvix.Compiler.Backend.Haskell.Pretty.Base
   ( module Juvix.Compiler.Backend.Haskell.Pretty.Base,
-    module Juvix.Compiler.Backend.Haskell.Pretty.Ann,
+    module Juvix.Data.CodeAnn,
     module Juvix.Compiler.Backend.Haskell.Pretty.Options,
   )
 where
 
 import Juvix.Compiler.Backend.Haskell.Language
-import Juvix.Compiler.Backend.Haskell.Pretty.Ann
 import Juvix.Compiler.Backend.Haskell.Pretty.Options
 import Juvix.Compiler.Concrete.Data.Literal
+import Juvix.Data.CodeAnn
 import Juvix.Data.Fixity
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 import Juvix.Prelude.Pretty qualified as PP
 
 doc :: PrettyCode c => Options -> c -> Doc Ann
@@ -43,38 +42,14 @@ instance PrettyCode Expression where
     ExpressionVerbatim c -> return (pretty c)
     ExpressionLiteral l -> ppCode (l ^. withLocParam)
 
-keyword :: Text -> Doc Ann
-keyword = annotate AnnKeyword . pretty
-
-kwArrow :: Doc Ann
-kwArrow = keyword Str.toAscii
-
-kwData :: Doc Ann
-kwData = keyword Str.data_
-
-kwEquals :: Doc Ann
-kwEquals = keyword Str.equal
-
-kwColonColon :: Doc Ann
-kwColonColon = keyword (Str.colon <> Str.colon)
-
-kwPipe :: Doc Ann
-kwPipe = keyword Str.pipe
-
-kwWhere :: Doc Ann
-kwWhere = keyword Str.where_
-
-kwModule :: Doc Ann
-kwModule = keyword Str.module_
-
-kwWildcard :: Doc Ann
-kwWildcard = keyword Str.underscore
+kwHaskellArrow :: Doc Ann
+kwHaskellArrow = keyword Str.toAscii
 
 instance PrettyCode Function where
   ppCode (Function l r) = do
     l' <- ppLeftExpression funFixity l
     r' <- ppRightExpression funFixity r
-    return $ l' <+> kwArrow <+> r'
+    return $ l' <+> kwHaskellArrow <+> r'
 
 instance PrettyCode TypeIden where
   ppCode = \case
@@ -92,16 +67,11 @@ instance PrettyCode InductiveConstructorDef where
     constructorParameters' <- mapM ppCode (c ^. constructorParameters)
     return (hsep $ constructorName' : constructorParameters')
 
-indent' :: Member (Reader Options) r => Doc a -> Sem r (Doc a)
-indent' d = do
-  i <- asks (^. optIndent)
-  return $ indent i d
-
 instance PrettyCode InductiveDef where
   ppCode d = do
     inductiveName' <- ppCode (d ^. inductiveName)
     inductiveConstructors' <- mapM ppCode (d ^. inductiveConstructors)
-    rhs <- indent' $ align $ concatWith (\a b -> a <> line <> kwPipe <+> b) inductiveConstructors'
+    let rhs = indent' $ align $ concatWith (\a b -> a <> line <> kwPipe <+> b) inductiveConstructors'
     return $ kwData <+> inductiveName' <+> kwEquals <> line <> rhs
 
 instance PrettyCode ConstructorApp where
@@ -150,15 +120,6 @@ instance PrettyCode Literal where
     LitInteger n -> return $ annotate AnnLiteralInteger (pretty n)
     LitString s -> return $ ppStringLit s
 
-doubleQuotes :: Doc Ann -> Doc Ann
-doubleQuotes = enclose kwDQuote kwDQuote
-
-kwDQuote :: Doc Ann
-kwDQuote = pretty ("\"" :: Text)
-
-ppStringLit :: Text -> Doc Ann
-ppStringLit = annotate AnnLiteralString . doubleQuotes . pretty
-
 instance PrettyCode Module where
   ppCode m = do
     name' <- ppCode (m ^. moduleName)
@@ -172,9 +133,6 @@ instance PrettyCode Module where
           <> body'
           <> line
 
-parensCond :: Bool -> Doc Ann -> Doc Ann
-parensCond t d = if t then parens d else d
-
 ppPostExpression ::
   (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>
   Fixity ->

src/Juvix/Compiler/Backend/Haskell/Pretty/Options.hs

@@ -2,14 +2,9 @@ module Juvix.Compiler.Backend.Haskell.Pretty.Options where
 
 import Juvix.Prelude
 
-newtype Options = Options
-  { _optIndent :: Int
-  }
+data Options = Options
 
 defaultOptions :: Options
-defaultOptions =
-  Options
-    { _optIndent = 2
-    }
+defaultOptions = Options
 
 makeLenses ''Options

src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs

@@ -28,7 +28,6 @@ import Juvix.Extra.Strings qualified as Str
 import Juvix.Extra.Version
 import Juvix.Prelude
 import Juvix.Prelude qualified as Prelude
-import Juvix.Prelude.Pretty
 import Text.Blaze.Html.Renderer.Utf8 qualified as Html
 import Text.Blaze.Html5 as Html hiding (map)
 import Text.Blaze.Html5.Attributes qualified as Attr

src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs

@@ -16,7 +16,6 @@ import Juvix.Compiler.Internal.Pretty qualified as Internal
 import Juvix.Extra.Paths
 import Juvix.Extra.Version
 import Juvix.Prelude
-import Prettyprinter
 import Prettyprinter.Render.Util.SimpleDocTree
 import Text.Blaze.Html
 import Text.Blaze.Html.Renderer.Text qualified as Html
@@ -152,13 +151,7 @@ ppCodeHtmlInternal x = do
     ppCodeHtmlInternal' :: Internal.PrettyCode a => HtmlOptions -> Internal.Options -> a -> Html
     ppCodeHtmlInternal' htmlOpts opts = run . runReader htmlOpts . renderTree . treeForm . docStreamInternal' opts
     docStreamInternal' :: Internal.PrettyCode a => Internal.Options -> a -> SimpleDocStream Ann
-    docStreamInternal' opts m = goTag <$> layoutPretty defaultLayoutOptions (Internal.runPrettyCode opts m)
-    goTag :: Internal.Ann -> Ann
-    goTag = \case
-      Internal.AnnKind k -> AnnKind k
-      Internal.AnnKeyword -> AnnKeyword
-      Internal.AnnLiteralInteger -> AnnLiteralInteger
-      Internal.AnnLiteralString -> AnnLiteralString
+    docStreamInternal' opts m = layoutPretty defaultLayoutOptions (Internal.runPrettyCode opts m)
 
 go :: Members '[Reader HtmlOptions] r => SimpleDocTree Ann -> Sem r Html
 go sdt = case sdt of
@@ -183,6 +176,8 @@ putTag ann x = case ann of
   AnnDelimiter -> return (Html.span ! Attr.class_ "ju-delimiter" $ x)
   AnnDef tmp ni -> boldDefine <*> tagDef tmp ni
   AnnRef tmp ni -> tagRef tmp ni
+  AnnCode -> return x
+  AnnImportant -> return x
   where
     boldDefine :: Sem r (Html -> Html)
     boldDefine =

src/Juvix/Compiler/Builtins/Error.hs

@@ -1,9 +1,8 @@
 module Juvix.Compiler.Builtins.Error where
 
 import Juvix.Compiler.Concrete.Data.Builtins
-import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 
 data AlreadyDefined = AlreadyDefined
   { _alreadyDefinedBuiltin :: BuiltinPrim,
@@ -12,19 +11,16 @@ data AlreadyDefined = AlreadyDefined
 
 makeLenses ''AlreadyDefined
 
-hh :: Doc Eann -> Doc Eann
-hh = annotate Highlight
-
 instance ToGenericError AlreadyDefined where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
       i = e ^. alreadyDefinedLoc
-      msg = "The builtin" <+> hh (pretty (e ^. alreadyDefinedBuiltin)) <+> "has already been defined"
+      msg = "The builtin" <+> code (pretty (e ^. alreadyDefinedBuiltin)) <+> "has already been defined"
 
 data NotDefined = NotDefined
   { _notDefinedBuiltin :: BuiltinPrim,
@@ -37,9 +33,9 @@ instance ToGenericError NotDefined where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
       i = e ^. notDefinedLoc
-      msg = "The builtin" <+> hh (pretty (e ^. notDefinedBuiltin)) <+> "has not been defined"
+      msg = "The builtin" <+> code (pretty (e ^. notDefinedBuiltin)) <+> "has not been defined"

src/Juvix/Compiler/Concrete/Data.hs

@@ -7,7 +7,7 @@ module Juvix.Compiler.Concrete.Data
     module Juvix.Compiler.Concrete.Data.ScopedName,
     module Juvix.Compiler.Concrete.Data.InfoTable,
     module Juvix.Compiler.Concrete.Data.InfoTableBuilder,
-    module Juvix.Compiler.Concrete.Data.NameKind,
+    module Juvix.Data.NameKind,
     module Juvix.Compiler.Concrete.Data.ParsedItem,
     module Juvix.Compiler.Concrete.Data.VisibilityAnn,
     module Juvix.Compiler.Concrete.Data.Literal,
@@ -23,10 +23,10 @@ import Juvix.Compiler.Concrete.Data.InfoTableBuilder
 import Juvix.Compiler.Concrete.Data.Literal
 import Juvix.Compiler.Concrete.Data.ModuleIsTop
 import Juvix.Compiler.Concrete.Data.Name
-import Juvix.Compiler.Concrete.Data.NameKind
 import Juvix.Compiler.Concrete.Data.NameRef
 import Juvix.Compiler.Concrete.Data.ParsedItem
 import Juvix.Compiler.Concrete.Data.PublicAnn
 import Juvix.Compiler.Concrete.Data.ScopedName qualified
 import Juvix.Compiler.Concrete.Data.VisibilityAnn
 import Juvix.Data.NameId
+import Juvix.Data.NameKind

src/Juvix/Compiler/Concrete/Data/ScopedName.hs

@@ -1,15 +1,15 @@
 module Juvix.Compiler.Concrete.Data.ScopedName
   ( module Juvix.Compiler.Concrete.Data.ScopedName,
-    module Juvix.Compiler.Concrete.Data.NameKind,
+    module Juvix.Data.NameKind,
     module Juvix.Data.NameId,
   )
 where
 
 import Juvix.Compiler.Concrete.Data.Name qualified as C
-import Juvix.Compiler.Concrete.Data.NameKind
 import Juvix.Compiler.Concrete.Data.VisibilityAnn
 import Juvix.Data.Fixity qualified as C
 import Juvix.Data.NameId
+import Juvix.Data.NameKind
 import Juvix.Prelude
 import Juvix.Prelude.Pretty
 

src/Juvix/Compiler/Concrete/Language.hs

@@ -19,7 +19,6 @@ import Juvix.Compiler.Concrete.Data.Builtins
 import Juvix.Compiler.Concrete.Data.Literal
 import Juvix.Compiler.Concrete.Data.ModuleIsTop
 import Juvix.Compiler.Concrete.Data.Name
-import Juvix.Compiler.Concrete.Data.NameKind
 import Juvix.Compiler.Concrete.Data.NameRef
 import Juvix.Compiler.Concrete.Data.PublicAnn
 import Juvix.Compiler.Concrete.Data.ScopedName (unqualifiedSymbol)
@@ -27,6 +26,7 @@ import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Data.VisibilityAnn
 import Juvix.Data
 import Juvix.Data.Fixity
+import Juvix.Data.NameKind
 import Juvix.Prelude hiding (show)
 import Prelude (show)
 

src/Juvix/Compiler/Concrete/Pretty.hs

@@ -5,25 +5,13 @@ module Juvix.Compiler.Concrete.Pretty
   )
 where
 
-import Juvix.Compiler.Concrete.Pretty.Ann
-import Juvix.Compiler.Concrete.Pretty.Ansi qualified as Ansi
 import Juvix.Compiler.Concrete.Pretty.Base
 import Juvix.Compiler.Concrete.Pretty.Options
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
-
-newtype PPOutput = PPOutput (Doc Ann)
 
 ppOutDefault :: PrettyCode c => c -> AnsiText
 ppOutDefault = AnsiText . PPOutput . doc defaultOptions
 
 ppOut :: PrettyCode c => Options -> c -> AnsiText
 ppOut o = AnsiText . PPOutput . doc o
-
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)

src/Juvix/Compiler/Concrete/Pretty/Ann.hs

@@ -1,14 +0,0 @@
-module Juvix.Compiler.Concrete.Pretty.Ann where
-
-import Juvix.Compiler.Concrete.Data
-
-data Ann
-  = AnnKind NameKind
-  | AnnKeyword
-  | AnnComment
-  | AnnDelimiter
-  | AnnLiteralString
-  | AnnLiteralInteger
-  | AnnUnkindedSym
-  | AnnDef TopModulePath NameId
-  | AnnRef TopModulePath NameId

src/Juvix/Compiler/Concrete/Pretty/Ansi.hs

@@ -1,18 +0,0 @@
-module Juvix.Compiler.Concrete.Pretty.Ansi where
-
-import Juvix.Compiler.Concrete.Data
-import Juvix.Compiler.Concrete.Pretty.Base
-import Juvix.Prelude
-import Prettyprinter.Render.Terminal
-
-stylize :: Ann -> AnsiStyle
-stylize a = case a of
-  AnnKind k -> nameKindAnsi k
-  AnnDelimiter -> colorDull White
-  AnnComment -> colorDull Cyan
-  AnnKeyword -> colorDull Blue
-  AnnDef {} -> mempty
-  AnnRef {} -> mempty
-  AnnLiteralString -> colorDull Red
-  AnnLiteralInteger -> colorDull Cyan
-  AnnUnkindedSym -> mempty

src/Juvix/Compiler/Concrete/Pretty/Base.hs

@@ -1,6 +1,6 @@
 module Juvix.Compiler.Concrete.Pretty.Base
   ( module Juvix.Compiler.Concrete.Pretty.Base,
-    module Juvix.Compiler.Concrete.Pretty.Ann,
+    module Juvix.Data.CodeAnn,
     module Juvix.Compiler.Concrete.Pretty.Options,
   )
 where
@@ -10,11 +10,10 @@ import Data.Text qualified as T
 import Juvix.Compiler.Concrete.Data.ScopedName (AbsModulePath)
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language
-import Juvix.Compiler.Concrete.Pretty.Ann
 import Juvix.Compiler.Concrete.Pretty.Options
+import Juvix.Data.CodeAnn
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
-import Juvix.Prelude.Pretty hiding (braces, parens)
 
 doc :: PrettyCode c => Options -> c -> Doc Ann
 doc opts =
@@ -28,162 +27,6 @@ class PrettyCode a where
 runPrettyCode :: PrettyCode c => Options -> c -> Doc Ann
 runPrettyCode opts = run . runReader opts . ppCode
 
-keyword' :: Pretty a => a -> Doc Ann
-keyword' = annotate AnnKeyword . pretty
-
-keyword :: Text -> Doc Ann
-keyword = keyword'
-
-delimiter :: Text -> Doc Ann
-delimiter = annotate AnnDelimiter . pretty
-
-kwModule :: Doc Ann
-kwModule = keyword Str.module_
-
-kwEnd :: Doc Ann
-kwEnd = keyword Str.end
-
-kwBuiltin :: Doc Ann
-kwBuiltin = keyword Str.builtin
-
-kwNatural :: Doc Ann
-kwNatural = keyword Str.natural
-
-kwInductive :: Doc Ann
-kwInductive = keyword Str.inductive
-
-kwType :: Doc Ann
-kwType = keyword Str.type_
-
-kwColon :: Doc Ann
-kwColon = keyword Str.colon
-
-kwArrowR :: Doc Ann
-kwArrowR = keyword Str.toUnicode
-
-kwLambda :: Doc Ann
-kwLambda = keyword Str.lambdaUnicode
-
-kwGhc :: Doc Ann
-kwGhc = keyword Str.ghc
-
-kwC :: Doc Ann
-kwC = keyword Str.cBackend
-
-kwWhere :: Doc Ann
-kwWhere = keyword Str.where_
-
-kwLet :: Doc Ann
-kwLet = keyword Str.let_
-
-kwIn :: Doc Ann
-kwIn = keyword Str.in_
-
-kwPublic :: Doc Ann
-kwPublic = keyword Str.public
-
-kwWildcard :: Doc Ann
-kwWildcard = keyword Str.underscore
-
-kwPostfix :: Doc Ann
-kwPostfix = keyword Str.postfix
-
-kwInfixr :: Doc Ann
-kwInfixr = keyword Str.infixr_
-
-kwInfixl :: Doc Ann
-kwInfixl = keyword Str.infixl_
-
-kwInfix :: Doc Ann
-kwInfix = keyword Str.infix_
-
-kwAssignment :: Doc Ann
-kwAssignment = keyword Str.assignUnicode
-
-kwMapsto :: Doc Ann
-kwMapsto = keyword Str.mapstoUnicode
-
-kwColonZero :: Doc Ann
-kwColonZero = keyword Str.colonZero
-
-kwColonOne :: Doc Ann
-kwColonOne = keyword Str.colonOne
-
-kwColonOmega :: Doc Ann
-kwColonOmega = keyword Str.colonOmegaUnicode
-
-kwAxiom :: Doc Ann
-kwAxiom = keyword Str.axiom
-
-kwOpen :: Doc Ann
-kwOpen = keyword Str.open
-
-kwUsing :: Doc Ann
-kwUsing = keyword Str.using
-
-kwHiding :: Doc Ann
-kwHiding = keyword Str.hiding
-
-kwImport :: Doc Ann
-kwImport = keyword Str.import_
-
-kwSemicolon :: Doc Ann
-kwSemicolon = delimiter Str.semicolon
-
-kwCompile :: Doc Ann
-kwCompile = keyword Str.compile
-
-kwForeign :: Doc Ann
-kwForeign = keyword Str.foreign_
-
-kwTerminating :: Doc Ann
-kwTerminating = keyword Str.terminating
-
-kwBraceL :: Doc Ann
-kwBraceL = delimiter "{"
-
-kwBraceR :: Doc Ann
-kwBraceR = delimiter "}"
-
-kwParenL :: Doc Ann
-kwParenL = delimiter "("
-
-kwParenR :: Doc Ann
-kwParenR = delimiter ")"
-
-kwDQuote :: Doc Ann
-kwDQuote = pretty ("\"" :: Text)
-
-kwDot :: Doc Ann
-kwDot = delimiter "."
-
-indented :: Members '[Reader Options] r => Doc Ann -> Sem r (Doc Ann)
-indented d = do
-  ind <- asks (^. optIndent)
-  return (indent ind d)
-
-bracesIndent :: Members '[Reader Options] r => Doc Ann -> Sem r (Doc Ann)
-bracesIndent d = do
-  d' <- indented d
-  return $ braces (line <> d' <> line)
-
-braces :: Doc Ann -> Doc Ann
-braces = enclose kwBraceL kwBraceR
-
-parens :: Doc Ann -> Doc Ann
-parens = enclose kwParenL kwParenR
-
-implicitDelim :: IsImplicit -> Doc Ann -> Doc Ann
-implicitDelim = \case
-  Implicit -> braces
-  Explicit -> parens
-
-doubleQuotes :: Doc Ann -> Doc Ann
-doubleQuotes = enclose kwDQuote kwDQuote
-
-annotateKind :: S.NameKind -> Doc Ann -> Doc Ann
-annotateKind = annotate . AnnKind
-
 ppModulePathType ::
   forall t s r.
   (SingI t, SingI s, Members '[Reader Options] r) =>
@@ -318,14 +161,6 @@ instance PrettyCode BackendItem where
     return $
       backend <+> kwMapsto <+> ppStringLit _backendItemCode
 
-ppStringLit :: Text -> Doc Ann
-ppStringLit = annotate AnnLiteralString . doubleQuotes . escaped
-  where
-    showChar :: Char -> String
-    showChar c = showLitChar c ("" :: String)
-    escaped :: Text -> Doc a
-    escaped = mconcatMap (pretty . showChar) . unpack
-
 ppTopModulePath ::
   forall s r.
   (SingI s, Members '[Reader Options] r) =>
@@ -365,7 +200,7 @@ ppInductiveParameters ps
 
 instance (SingI s, SingI t) => PrettyCode (Module s t) where
   ppCode Module {..} = do
-    moduleBody' <- ppCode _moduleBody >>= indented
+    moduleBody' <- indent' <$> ppCode _moduleBody
     modulePath' <- ppModulePathType _modulePath
     moduleParameters' <- ppInductiveParameters _moduleParameters
     moduleDoc' <- mapM ppCode _moduleDoc
@@ -419,13 +254,13 @@ instance SingI s => PrettyCode (InductiveConstructorDef s) where
     return $ doc' ?<> constructorName' <+> kwColon <+> constructorType'
 
 instance PrettyCode BuiltinInductive where
-  ppCode i = return (kwBuiltin <+> keyword' i)
+  ppCode i = return (kwBuiltin <+> keyword (prettyText i))
 
 instance PrettyCode BuiltinFunction where
-  ppCode i = return (kwBuiltin <+> keyword' i)
+  ppCode i = return (kwBuiltin <+> keyword (prettyText i))
 
 instance PrettyCode BuiltinAxiom where
-  ppCode i = return (kwBuiltin <+> keyword' i)
+  ppCode i = return (kwBuiltin <+> keyword (prettyText i))
 
 ppInductiveSignature :: forall r s. (SingI s, Members '[Reader Options] r) => InductiveDef s -> Sem r (Doc Ann)
 ppInductiveSignature InductiveDef {..} = do
@@ -641,7 +476,7 @@ instance SingI s => PrettyCode (LetClause s) where
     LetFunClause cl -> ppCode cl
 
 ppBlock :: (PrettyCode a, Members '[Reader Options] r, Traversable t) => t a -> Sem r (Doc Ann)
-ppBlock items = mapM (fmap endSemicolon . ppCode) items >>= bracesIndent . vsep . toList
+ppBlock items = bracesIndent . vsep . toList <$> mapM (fmap endSemicolon . ppCode) items
 
 instance SingI s => PrettyCode (LambdaClause s) where
   ppCode LambdaClause {..} = do
@@ -670,7 +505,7 @@ instance SingI s => PrettyCode (FunctionClause s) where
         <+?> ((line <>) <$> clauseWhere')
 
 instance SingI s => PrettyCode (WhereBlock s) where
-  ppCode WhereBlock {..} = ppBlock whereClauses >>= indented . (kwWhere <+>)
+  ppCode WhereBlock {..} = indent' . (kwWhere <+>) <$> ppBlock whereClauses
 
 instance SingI s => PrettyCode (WhereClause s) where
   ppCode c = case c of
@@ -704,7 +539,7 @@ instance SingI s => PrettyCode (Import s) where
         if b
           then case sing :: SStage s of
             SParsed -> return Nothing
-            SScoped -> ppCode m >>= fmap (Just . braces . jumpLines) . indented
+            SScoped -> Just . braces . jumpLines . indent' <$> ppCode m
           else return Nothing
 
 instance PrettyCode PatternScopedIden where
@@ -843,9 +678,6 @@ instance PrettyCode Pattern where
         patPostfixParameter' <- ppLeftExpression (getFixity p) _patPostfixParameter
         return $ patPostfixParameter' <+> patPostfixConstructor'
 
-parensCond :: Bool -> Doc Ann -> Doc Ann
-parensCond t d = if t then parens d else d
-
 ppPostExpression ::
   (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>
   Fixity ->

src/Juvix/Compiler/Concrete/Pretty/Options.hs

@@ -4,16 +4,14 @@ import Juvix.Prelude
 
 data Options = Options
   { _optShowNameIds :: Bool,
-    _optInlineImports :: Bool,
-    _optIndent :: Int
+    _optInlineImports :: Bool
   }
 
 defaultOptions :: Options
 defaultOptions =
   Options
     { _optShowNameIds = False,
-      _optInlineImports = False,
-      _optIndent = 2
+      _optInlineImports = False
     }
 
 makeLenses ''Options

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Ann.hs

@@ -1,8 +0,0 @@
--- TODO: MOVE
-module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Ann where
-
-import Juvix.Compiler.Concrete.Pretty.Base qualified as P
-
-data Eann
-  = Highlight
-  | ScopedAnn P.Ann

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Pretty.hs

@@ -1,44 +1,26 @@
--- TODO: MOVE
 module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty
   ( module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty,
-    module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Ann,
+    module Juvix.Data.CodeAnn,
   )
 where
 
 import Juvix.Compiler.Concrete.Pretty.Base qualified as Scoped
-import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Ann
-import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty.Ansi qualified as Ansi
+import Juvix.Data.CodeAnn
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 import Text.EditDistance
 
-ppCode :: Scoped.PrettyCode c => c -> Doc Eann
+ppCode :: Scoped.PrettyCode c => c -> Doc Ann
 ppCode = runPP . Scoped.ppCode
 
-runPP :: Sem '[Reader Scoped.Options] (Doc Scoped.Ann) -> Doc Eann
-runPP = highlight . reAnnotate ScopedAnn . run . runReader Scoped.defaultOptions
+runPP :: Sem '[Reader Scoped.Options] (Doc Scoped.Ann) -> Doc Ann
+runPP = code . run . runReader Scoped.defaultOptions
 
-newtype PPOutput = PPOutput (Doc Eann)
-
-prettyError :: Doc Eann -> AnsiText
+prettyError :: Doc Ann -> AnsiText
 prettyError = AnsiText . PPOutput
 
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)
-
-highlight :: Doc Eann -> Doc Eann
-highlight = annotate Highlight
-
-ppSymbolT :: Text -> Doc Eann
-ppSymbolT = highlight . pretty
-
-indent' :: Doc ann -> Doc ann
-indent' = indent 2
+ppSymbolT :: Text -> Doc Ann
+ppSymbolT = code . pretty
 
 textDistance :: Text -> Text -> Int
 textDistance a b =

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Pretty/Ansi.hs

@@ -1,11 +0,0 @@
--- TODO: MOVE
-module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty.Ansi where
-
-import Juvix.Compiler.Concrete.Pretty.Ansi qualified as S
-import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Ann
-import Prettyprinter.Render.Terminal
-
-stylize :: Eann -> AnsiStyle
-stylize a = case a of
-  Highlight -> bold
-  ScopedAnn s -> S.stylize s

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs

@@ -1,7 +1,7 @@
 module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Types
   ( module Juvix.Compiler.Concrete.Language,
     module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Types,
-    module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Ann,
+    module Juvix.Data.CodeAnn,
   )
 where
 
@@ -12,11 +12,10 @@ import Juvix.Compiler.Concrete.Data.Scope
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language
 import Juvix.Compiler.Concrete.Language qualified as L
-import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Ann
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error.Pretty
 import Juvix.Compiler.Concrete.Translation.FromSource.Error qualified as Parser
+import Juvix.Data.CodeAnn
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 
 data MultipleDeclarations = MultipleDeclarations
   { _multipleDeclEntry :: SymbolEntry,
@@ -58,7 +57,7 @@ instance ToGenericError InfixError where
       }
     where
       i = getLoc _infixErrorAtoms
-      msg :: Doc Eann
+      msg :: Doc Ann
       msg =
         "Error solving infixities"
           <> line
@@ -79,7 +78,7 @@ instance ToGenericError InfixErrorP where
       }
     where
       i = getLoc _infixErrorAtomsP
-      msg :: Doc Eann
+      msg :: Doc Ann
       msg =
         "Error solving infixities:"
           <> line
@@ -146,7 +145,7 @@ instance ToGenericError ImportCycle where
           <> line
           <> indent' (vsep (intersperse "⇓" (map pp (toList (tie _importCycleImports)))))
 
-      pp :: Import 'Parsed -> Doc Eann
+      pp :: Import 'Parsed -> Doc Ann
       pp t = ppCode t <+> parens ("at" <+> pretty (getLoc t))
 
       tie :: NonEmpty a -> NonEmpty a
@@ -504,7 +503,7 @@ instance ToGenericError WrongKindExpressionCompileBlock where
           <+> "is not a constructor, inductive data type, axiom nor a function."
             <> "Thus, it cannot have a compile rule."
 
-infixErrorAux :: Doc Eann -> Doc Eann -> Doc Eann
+infixErrorAux :: Doc Ann -> Doc Ann -> Doc Ann
 infixErrorAux kind pp =
   "Error while resolving infixities in the"
     <+> kind
@@ -512,7 +511,7 @@ infixErrorAux kind pp =
       <> line
       <> indent' pp
 
-ambiguousMessage :: Name -> [SymbolEntry] -> Doc Eann
+ambiguousMessage :: Name -> [SymbolEntry] -> Doc Ann
 ambiguousMessage n es =
   "The symbol"
     <+> ppCode n
@@ -568,7 +567,7 @@ instance ToGenericError DoubleBracesPattern where
       i = getLoc pat
       msg =
         "Double braces are not valid:"
-          <+> highlight (braces (ppCode pat))
+          <+> code (braces (ppCode pat))
 
 newtype ImplicitPatternLeftApplication = ImplicitPatternLeftApplication
   { _implicitPatternLeftApplication :: PatternApp

src/Juvix/Compiler/Internal/Pretty.hs

@@ -2,19 +2,16 @@ module Juvix.Compiler.Internal.Pretty
   ( module Juvix.Compiler.Internal.Pretty,
     module Juvix.Compiler.Internal.Pretty.Base,
     module Juvix.Compiler.Internal.Pretty.Options,
+    module Juvix.Data.PPOutput,
   )
 where
 
-import Juvix.Compiler.Internal.Pretty.Ann
-import Juvix.Compiler.Internal.Pretty.Ansi qualified as Ansi
 import Juvix.Compiler.Internal.Pretty.Base
 import Juvix.Compiler.Internal.Pretty.Options
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 import Prettyprinter.Render.Terminal qualified as Ansi
 
-newtype PPOutput = PPOutput (Doc Ann)
-
 ppOutDefault :: PrettyCode c => c -> AnsiText
 ppOutDefault = AnsiText . PPOutput . doc defaultOptions
 
@@ -22,12 +19,4 @@ ppOut :: PrettyCode c => Options -> c -> AnsiText
 ppOut o = AnsiText . PPOutput . doc o
 
 ppTrace :: PrettyCode c => c -> Text
-ppTrace = Ansi.renderStrict . reAnnotateS Ansi.stylize . layoutPretty defaultLayoutOptions . doc defaultOptions
-
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)
+ppTrace = Ansi.renderStrict . reAnnotateS stylize . layoutPretty defaultLayoutOptions . doc defaultOptions

src/Juvix/Compiler/Internal/Pretty/Ann.hs

@@ -1,12 +0,0 @@
-module Juvix.Compiler.Internal.Pretty.Ann where
-
-import Juvix.Compiler.Concrete.Data.NameKind
-
-data Ann
-  = AnnKind NameKind
-  | AnnKeyword
-  | AnnLiteralString
-  | AnnLiteralInteger
-
-instance HasNameKindAnn Ann where
-  annNameKind = AnnKind

src/Juvix/Compiler/Internal/Pretty/Ansi.hs

@@ -1,12 +0,0 @@
-module Juvix.Compiler.Internal.Pretty.Ansi where
-
-import Juvix.Compiler.Internal.Language
-import Juvix.Compiler.Internal.Pretty.Base
-import Prettyprinter.Render.Terminal
-
-stylize :: Ann -> AnsiStyle
-stylize a = case a of
-  AnnKind k -> nameKindAnsi k
-  AnnKeyword -> colorDull Blue
-  AnnLiteralString -> colorDull Red
-  AnnLiteralInteger -> colorDull Cyan

src/Juvix/Compiler/Internal/Pretty/Base.hs

@@ -1,17 +1,15 @@
 module Juvix.Compiler.Internal.Pretty.Base
   ( module Juvix.Compiler.Internal.Pretty.Base,
-    module Juvix.Compiler.Internal.Pretty.Ann,
+    module Juvix.Data.CodeAnn,
     module Juvix.Compiler.Internal.Pretty.Options,
   )
 where
 
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Internal.Extra
-import Juvix.Compiler.Internal.Pretty.Ann
 import Juvix.Compiler.Internal.Pretty.Options
-import Juvix.Extra.Strings qualified as Str
+import Juvix.Data.CodeAnn
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 
 doc :: PrettyCode c => Options -> c -> Doc Ann
 doc opts =
@@ -72,69 +70,6 @@ instance PrettyCode Expression where
     ExpressionLiteral l -> return (pretty l)
     ExpressionLambda l -> ppCode l
 
-keyword :: Text -> Doc Ann
-keyword = annotate AnnKeyword . pretty
-
-kwLambda :: Doc Ann
-kwLambda = keyword Str.lambdaUnicode
-
-kwInclude :: Doc Ann
-kwInclude = keyword Str.include
-
-kwArrow :: Doc Ann
-kwArrow = keyword Str.toUnicode
-
-kwMapsto :: Doc Ann
-kwMapsto = keyword Str.mapstoUnicode
-
-kwForeign :: Doc Ann
-kwForeign = keyword Str.foreign_
-
-kwCompile :: Doc Ann
-kwCompile = keyword Str.compile
-
-kwC :: Doc Ann
-kwC = keyword Str.cBackend
-
-kwGhc :: Doc Ann
-kwGhc = keyword Str.ghc
-
-kwColon :: Doc Ann
-kwColon = keyword Str.colon
-
-kwData :: Doc Ann
-kwData = keyword Str.data_
-
-kwAssign :: Doc Ann
-kwAssign = keyword Str.assignUnicode
-
-kwEquals :: Doc Ann
-kwEquals = keyword Str.equal
-
-kwColonColon :: Doc Ann
-kwColonColon = keyword (Str.colon <> Str.colon)
-
-kwPipe :: Doc Ann
-kwPipe = keyword Str.pipe
-
-kwHole :: Doc Ann
-kwHole = keyword Str.underscore
-
-kwAxiom :: Doc Ann
-kwAxiom = keyword Str.axiom
-
-kwWhere :: Doc Ann
-kwWhere = keyword Str.where_
-
-kwModule :: Doc Ann
-kwModule = keyword Str.module_
-
-kwType :: Doc Ann
-kwType = keyword Str.type_
-
-kwWildcard :: Doc Ann
-kwWildcard = keyword Str.underscore
-
 instance PrettyCode BackendItem where
   ppCode BackendItem {..} = do
     backend <- ppCode _backendItemBackend
@@ -165,26 +100,11 @@ instance PrettyCode InductiveConstructorDef where
     constructorParameters' <- mapM ppCodeAtom (c ^. inductiveConstructorParameters)
     return (hsep $ constructorName' : constructorParameters')
 
-indent' :: Member (Reader Options) r => Doc a -> Sem r (Doc a)
-indent' d = do
-  i <- asks (^. optIndent)
-  return $ indent i d
-
 ppBlock ::
   (PrettyCode a, Members '[Reader Options] r, Traversable t) =>
   t a ->
   Sem r (Doc Ann)
-ppBlock items = mapM ppCode items >>= bracesIndent . vsep . toList
-
-implicitDelim :: IsImplicit -> Doc Ann -> Doc Ann
-implicitDelim = \case
-  Implicit -> braces
-  Explicit -> parens
-
-bracesIndent :: Members '[Reader Options] r => Doc Ann -> Sem r (Doc Ann)
-bracesIndent d = do
-  d' <- indent' d
-  return $ braces (line <> d' <> line)
+ppBlock items = bracesIndent . vsep . toList <$> mapM ppCode items
 
 instance PrettyCode InductiveParameter where
   ppCode (InductiveParameter v) = do
@@ -196,13 +116,13 @@ instance PrettyCode InductiveDef where
     inductiveName' <- ppCode (d ^. inductiveName)
     params <- hsepMaybe <$> mapM ppCode (d ^. inductiveParameters)
     inductiveConstructors' <- mapM ppCode (d ^. inductiveConstructors)
-    rhs <- indent' $ align $ concatWith (\a b -> a <> line <> kwPipe <+> b) inductiveConstructors'
+    let rhs = indent' $ align $ concatWith (\a b -> a <> line <> kwPipe <+> b) inductiveConstructors'
     return $ kwData <+> inductiveName' <+?> params <+> kwEquals <> line <> rhs
 
 instance PrettyCode PatternArg where
   ppCode a = do
     p <- ppCode (a ^. patternArgPattern)
-    return (bracesIf (Implicit == a ^. patternArgIsImplicit) p)
+    return (bracesCond (Implicit == a ^. patternArgIsImplicit) p)
 
 instance PrettyCode ConstructorApp where
   ppCode c = do
@@ -331,12 +251,6 @@ instance PrettyCode TypeCalls where
     elems' <- mapM ppCode elems
     return $ title <> line <> vsep elems' <> line
 
-parensIf :: Bool -> Doc Ann -> Doc Ann
-parensIf t = if t then parens else id
-
-bracesIf :: Bool -> Doc Ann -> Doc Ann
-bracesIf t = if t then braces else id
-
 ppPostExpression ::
   (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>
   Fixity ->
@@ -365,7 +279,7 @@ ppLRExpression ::
   a ->
   Sem r (Doc Ann)
 ppLRExpression associates fixlr e =
-  parensIf (atomParens associates (atomicity e) fixlr)
+  parensCond (atomParens associates (atomicity e) fixlr)
     <$> ppCode e
 
 ppCodeAtom :: (HasAtomicity c, PrettyCode c, Members '[Reader Options] r) => c -> Sem r (Doc Ann)

src/Juvix/Compiler/Internal/Pretty/Options.hs

@@ -2,16 +2,14 @@ module Juvix.Compiler.Internal.Pretty.Options where
 
 import Juvix.Prelude
 
-data Options = Options
-  { _optIndent :: Int,
-    _optShowNameIds :: Bool
+newtype Options = Options
+  { _optShowNameIds :: Bool
   }
 
 defaultOptions :: Options
 defaultOptions =
   Options
-    { _optIndent = 2,
-      _optShowNameIds = False
+    { _optShowNameIds = False
     }
 
 makeLenses ''Options

src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Data/FunctionCall.hs

@@ -5,7 +5,6 @@ import Juvix.Compiler.Abstract.Language
 import Juvix.Compiler.Abstract.Pretty.Base
 import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Data.SizeRelation
 import Juvix.Prelude
-import Prettyprinter as PP
 
 newtype CallMap = CallMap
   { _callMap :: HashMap FunctionRef (HashMap FunctionRef [FunCall])

src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Data/Graph.hs

@@ -9,8 +9,7 @@ import Juvix.Compiler.Abstract.Pretty.Base
 import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Data.FunctionCall
 import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Data.SizeRelation
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
-import Prettyprinter as PP
+import Prettyprinter qualified as PP
 
 type Graph = HashMap (FunctionName, FunctionName) Edge
 

src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error.hs

@@ -1,11 +1,9 @@
 module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error
   ( module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error,
-    module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty,
     module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Types,
   )
 where
 
-import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty
 import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Types
 import Juvix.Prelude
 

src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty.hs

@@ -1,32 +0,0 @@
-module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty
-  ( module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty,
-    module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty.Ann,
-  )
-where
-
-import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty.Ann
-import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty.Ansi qualified as Ansi
-import Juvix.Prelude
-import Juvix.Prelude.Pretty
-
-newtype PPOutput = PPOutput (Doc Eann)
-
-prettyError :: Doc Eann -> AnsiText
-prettyError = AnsiText . PPOutput
-
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)
-
-indent' :: Doc ann -> Doc ann
-indent' = indent 2
-
-prettyT :: Text -> Doc Eann
-prettyT = pretty
-
-highlight :: Doc Eann -> Doc Eann
-highlight = annotate Highlight

src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty/Ann.hs

@@ -1,7 +0,0 @@
-module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty.Ann where
-
-import Juvix.Compiler.Abstract.Pretty.Ann
-
-data Eann
-  = Highlight
-  | AbstractAnn Ann

src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty/Ansi.hs

@@ -1,18 +0,0 @@
-module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty.Ansi
-  ( module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty.Ansi,
-  )
-where
-
-import Juvix.Compiler.Abstract.Pretty.Ansi qualified as M
-import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty.Ann
-import Juvix.Prelude
-import Prettyprinter
-import Prettyprinter.Render.Terminal
-
-renderAnsi :: SimpleDocStream Eann -> Text
-renderAnsi = renderStrict . reAnnotateS stylize
-
-stylize :: Eann -> AnsiStyle
-stylize a = case a of
-  Highlight -> bold
-  AbstractAnn m -> M.stylize m

src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Types.hs

@@ -1,9 +1,8 @@
 module Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Types where
 
 import Juvix.Compiler.Abstract.Language
-import Juvix.Compiler.Internal.Translation.FromAbstract.Analysis.Termination.Error.Pretty
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 
 newtype NoLexOrder = NoLexOrder
   { _noLexOrderFun :: Name
@@ -16,15 +15,15 @@ instance ToGenericError NoLexOrder where
   genericError NoLexOrder {..} =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
       name = _noLexOrderFun
       i = getLoc name
 
-      msg :: Doc Eann
+      msg :: Doc Ann
       msg =
         "The function"
-          <+> highlight (pretty name)
+          <+> code (pretty name)
           <+> "fails the termination checker."

src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/ArityChecking/Error/Types.hs

@@ -4,6 +4,7 @@ module Juvix.Compiler.Internal.Translation.FromInternal.Analysis.ArityChecking.E
 
 import Juvix.Compiler.Internal.Extra
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty
+import Juvix.Data.PPOutput
 import Juvix.Prelude
 
 data WrongConstructorAppLength = WrongConstructorAppLength
@@ -17,7 +18,7 @@ instance ToGenericError WrongConstructorAppLength where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -49,7 +50,7 @@ instance ToGenericError LhsTooManyPatterns where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -76,7 +77,7 @@ instance ToGenericError WrongPatternIsImplicit where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -103,7 +104,7 @@ instance ToGenericError ExpectedExplicitArgument where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -134,7 +135,7 @@ instance ToGenericError PatternFunction where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -155,7 +156,7 @@ instance ToGenericError TooManyArguments where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -195,7 +196,7 @@ instance ToGenericError FunctionApplied where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where

src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty.hs

@@ -1,50 +1,31 @@
 module Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty
   ( module Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty,
-    module Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty.Ann,
-    module Juvix.Prelude.Pretty,
+    module Juvix.Data.CodeAnn,
   )
 where
 
 import Juvix.Compiler.Internal.Extra
 import Juvix.Compiler.Internal.Pretty.Base qualified as Micro
-import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty.Ann
-import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty.Ansi qualified as Ansi
+import Juvix.Data.CodeAnn
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 
-ppCode :: Micro.PrettyCode c => c -> Doc Eann
+ppCode :: Micro.PrettyCode c => c -> Doc Ann
 ppCode = runPP . Micro.ppCode
 
-ppAtom :: (Micro.PrettyCode c, HasAtomicity c) => c -> Doc Eann
+ppAtom :: (Micro.PrettyCode c, HasAtomicity c) => c -> Doc Ann
 ppAtom = runPP . Micro.ppCodeAtom
 
-runPP :: Sem '[Reader Micro.Options] (Doc Micro.Ann) -> Doc Eann
-runPP = highlight_ . reAnnotate MicroAnn . run . runReader Micro.defaultOptions
+runPP :: Sem '[Reader Micro.Options] (Doc Micro.Ann) -> Doc Ann
+runPP = highlight_ . run . runReader Micro.defaultOptions
 
-newtype PPOutput = PPOutput (Doc Eann)
+highlight_ :: Doc Ann -> Doc Ann
+highlight_ = annotate AnnCode
 
-prettyError :: Doc Eann -> AnsiText
-prettyError = AnsiText . PPOutput
-
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)
-
-indent' :: Doc ann -> Doc ann
-indent' = indent 2
-
-highlight_ :: Doc Eann -> Doc Eann
-highlight_ = annotate Highlight
-
-ppApp :: (Expression, [(IsImplicit, Expression)]) -> Doc Eann
+ppApp :: (Expression, [(IsImplicit, Expression)]) -> Doc Ann
 ppApp (fun, args) =
   hsep (ppAtom fun : map (uncurry ppArg) args)
 
-ppArg :: IsImplicit -> Expression -> Doc Eann
+ppArg :: IsImplicit -> Expression -> Doc Ann
 ppArg im arg = case im of
   Implicit -> braces (ppCode arg)
   Explicit -> ppAtom arg

src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty/Ann.hs

@@ -1,7 +0,0 @@
-module Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty.Ann where
-
-import Juvix.Compiler.Internal.Pretty.Ann qualified as Micro
-
-data Eann
-  = Highlight
-  | MicroAnn Micro.Ann

src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty/Ansi.hs

@@ -1,15 +0,0 @@
-module Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty.Ansi where
-
-import Juvix.Compiler.Internal.Pretty.Ansi qualified as M
-import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty.Ann
-import Juvix.Prelude
-import Prettyprinter
-import Prettyprinter.Render.Terminal
-
-renderAnsi :: SimpleDocStream Eann -> Text
-renderAnsi = renderStrict . reAnnotateS stylize
-
-stylize :: Eann -> AnsiStyle
-stylize a = case a of
-  Highlight -> bold
-  MicroAnn m -> M.stylize m

src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Types.hs

@@ -2,6 +2,7 @@ module Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Er
 
 import Juvix.Compiler.Internal.Language
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Error.Pretty
+import Juvix.Data.PPOutput
 import Juvix.Prelude
 
 -- | the type of the constructor used in a pattern does
@@ -19,7 +20,7 @@ instance ToGenericError WrongConstructorType where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -48,7 +49,7 @@ instance ToGenericError WrongReturnType where
   genericError e =
     GenericError
       { _genericErrorLoc = j,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i, j]
       }
     where
@@ -77,7 +78,7 @@ instance ToGenericError UnsolvedMeta where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -99,7 +100,7 @@ instance ToGenericError WrongConstructorAppArgs where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -123,7 +124,7 @@ instance ToGenericError WrongConstructorAppArgs where
       numTypes :: Doc ann
       numTypes = pat (length (e ^. wrongCtorAppTypes))
 
-      ctorName :: Doc Eann
+      ctorName :: Doc Ann
       ctorName = ppCode (e ^. wrongCtorAppApp . constrAppConstructor)
 
       pat :: Int -> Doc ann
@@ -142,7 +143,7 @@ instance ToGenericError WrongType where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -179,7 +180,7 @@ instance ToGenericError ExpectedFunctionType where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -213,7 +214,7 @@ instance ToGenericError WrongNumberArgumentsIndType where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -248,7 +249,7 @@ instance ToGenericError ImpracticalPatternMatching where
   genericError e =
     GenericError
       { _genericErrorLoc = i,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i]
       }
     where
@@ -272,7 +273,7 @@ instance ToGenericError NoPositivity where
   genericError e =
     GenericError
       { _genericErrorLoc = j,
-        _genericErrorMessage = prettyError msg,
+        _genericErrorMessage = ppOutput msg,
         _genericErrorIntervals = [i, j]
       }
     where

src/Juvix/Compiler/Mono/Language.hs

@@ -1,6 +1,6 @@
 module Juvix.Compiler.Mono.Language
   ( module Juvix.Compiler.Mono.Language,
-    module Juvix.Compiler.Concrete.Data.NameKind,
+    module Juvix.Data.NameKind,
     module Juvix.Compiler.Concrete.Data.ScopedName,
     module Juvix.Compiler.Abstract.Data.Name,
     module Juvix.Compiler.Concrete.Data.Builtins,
@@ -9,9 +9,9 @@ where
 
 import Juvix.Compiler.Abstract.Data.Name
 import Juvix.Compiler.Concrete.Data.Builtins
-import Juvix.Compiler.Concrete.Data.NameKind
 import Juvix.Compiler.Concrete.Data.ScopedName (NameId (..))
 import Juvix.Compiler.Concrete.Language qualified as C
+import Juvix.Data.NameKind
 import Juvix.Prelude
 
 data Module = Module

src/Juvix/Compiler/Mono/Pretty.hs

@@ -4,25 +4,13 @@ module Juvix.Compiler.Mono.Pretty
   )
 where
 
-import Juvix.Compiler.Mono.Pretty.Ann
-import Juvix.Compiler.Mono.Pretty.Ansi qualified as Ansi
 import Juvix.Compiler.Mono.Pretty.Base
 import Juvix.Compiler.Mono.Pretty.Options
+import Juvix.Data.PPOutput
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
-
-newtype PPOutput = PPOutput (Doc Ann)
 
 ppOutDefault :: PrettyCode c => c -> AnsiText
 ppOutDefault = AnsiText . PPOutput . doc defaultOptions
 
 ppOut :: PrettyCode c => Options -> c -> AnsiText
 ppOut o = AnsiText . PPOutput . doc o
-
-instance HasAnsiBackend PPOutput where
-  toAnsiStream (PPOutput o) = reAnnotateS Ansi.stylize (layoutPretty defaultLayoutOptions o)
-  toAnsiDoc (PPOutput o) = reAnnotate Ansi.stylize o
-
-instance HasTextBackend PPOutput where
-  toTextDoc (PPOutput o) = unAnnotate o
-  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)

src/Juvix/Compiler/Mono/Pretty/Ann.hs

@@ -1,9 +0,0 @@
-module Juvix.Compiler.Mono.Pretty.Ann where
-
-import Juvix.Compiler.Concrete.Data.NameKind
-
-data Ann
-  = AnnKind NameKind
-  | AnnKeyword
-  | AnnLiteralString
-  | AnnLiteralInteger

src/Juvix/Compiler/Mono/Pretty/Ansi.hs

@@ -1,31 +0,0 @@
-module Juvix.Compiler.Mono.Pretty.Ansi where
-
-import Juvix.Compiler.Mono.Language
-import Juvix.Compiler.Mono.Pretty.Ann
-import Juvix.Compiler.Mono.Pretty.Base
-import Juvix.Prelude
-import Prettyprinter
-import Prettyprinter.Render.Terminal
-
-printPrettyCodeDefault :: PrettyCode c => c -> IO ()
-printPrettyCodeDefault = printPrettyCode defaultOptions
-
-printPrettyCode :: PrettyCode c => Options -> c -> IO ()
-printPrettyCode = hPrintPrettyCode stdout
-
-hPrintPrettyCode :: PrettyCode c => Handle -> Options -> c -> IO ()
-hPrintPrettyCode h opts = renderIO h . docStream' opts
-
-renderPrettyCode :: PrettyCode c => Options -> c -> Text
-renderPrettyCode opts = renderStrict . docStream' opts
-
-docStream' :: PrettyCode c => Options -> c -> SimpleDocStream AnsiStyle
-docStream' opts =
-  reAnnotateS stylize . docStream opts
-
-stylize :: Ann -> AnsiStyle
-stylize a = case a of
-  AnnKind k -> nameKindAnsi k
-  AnnKeyword -> colorDull Blue
-  AnnLiteralString -> colorDull Red
-  AnnLiteralInteger -> colorDull Cyan

src/Juvix/Compiler/Mono/Pretty/Base.hs

@@ -1,15 +1,14 @@
 module Juvix.Compiler.Mono.Pretty.Base
   ( module Juvix.Compiler.Mono.Pretty.Base,
     module Juvix.Compiler.Mono.Pretty.Options,
+    module Juvix.Data.CodeAnn,
   )
 where
 
 import Juvix.Compiler.Mono.Language
-import Juvix.Compiler.Mono.Pretty.Ann
 import Juvix.Compiler.Mono.Pretty.Options
-import Juvix.Extra.Strings qualified as Str
+import Juvix.Data.CodeAnn
 import Juvix.Prelude
-import Juvix.Prelude.Pretty
 
 docStream :: PrettyCode c => Options -> c -> SimpleDocStream Ann
 docStream opts = layoutPretty defaultLayoutOptions . doc opts
@@ -61,57 +60,6 @@ instance PrettyCode Expression where
     ExpressionApplication a -> ppCode a
     ExpressionLiteral l -> return (pretty l)
 
-keyword :: Text -> Doc Ann
-keyword = annotate AnnKeyword . pretty
-
-kwArrow :: Doc Ann
-kwArrow = keyword Str.toAscii
-
-kwMapsto :: Doc Ann
-kwMapsto = keyword Str.mapstoUnicode
-
-kwForeign :: Doc Ann
-kwForeign = keyword Str.foreign_
-
-kwCompile :: Doc Ann
-kwCompile = keyword Str.compile
-
-kwC :: Doc Ann
-kwC = keyword Str.cBackend
-
-kwGhc :: Doc Ann
-kwGhc = keyword Str.ghc
-
-kwColon :: Doc Ann
-kwColon = keyword Str.colon
-
-kwData :: Doc Ann
-kwData = keyword Str.data_
-
-kwEquals :: Doc Ann
-kwEquals = keyword Str.equal
-
-kwColonColon :: Doc Ann
-kwColonColon = keyword (Str.colon <> Str.colon)
-
-kwPipe :: Doc Ann
-kwPipe = keyword Str.pipe
-
-kwAxiom :: Doc Ann
-kwAxiom = keyword Str.axiom
-
-kwWhere :: Doc Ann
-kwWhere = keyword Str.where_
-
-kwModule :: Doc Ann
-kwModule = keyword Str.module_
-
-kwType :: Doc Ann
-kwType = keyword Str.type_
-
-kwWildcard :: Doc Ann
-kwWildcard = keyword Str.underscore
-
 instance PrettyCode BackendItem where
   ppCode BackendItem {..} = do
     backend <- ppCode _backendItemBackend
@@ -141,24 +89,14 @@ instance PrettyCode InductiveConstructorDef where
     constructorParameters' <- mapM ppCodeAtom (c ^. constructorParameters)
     return (hsep $ constructorName' : constructorParameters')
 
-indent' :: Member (Reader Options) r => Doc a -> Sem r (Doc a)
-indent' d = do
-  i <- asks (^. optIndent)
-  return $ indent i d
-
 ppBlock :: (PrettyCode a, Members '[Reader Options] r, Traversable t) => t a -> Sem r (Doc Ann)
-ppBlock items = mapM ppCode items >>= bracesIndent . vsep . toList
-
-bracesIndent :: Members '[Reader Options] r => Doc Ann -> Sem r (Doc Ann)
-bracesIndent d = do
-  d' <- indent' d
-  return $ braces (line <> d' <> line)
+ppBlock items = bracesIndent . vsep . toList <$> mapM ppCode items
 
 instance PrettyCode InductiveDef where
   ppCode d = do
     inductiveName' <- ppCode (d ^. inductiveName)
     inductiveConstructors' <- mapM ppCode (d ^. inductiveConstructors)
-    rhs <- indent' $ align $ concatWith (\a b -> a <> line <> kwPipe <+> b) inductiveConstructors'
+    let rhs = indent' $ align $ concatWith (\a b -> a <> line <> kwPipe <+> b) inductiveConstructors'
     return $ kwData <+> inductiveName' <+> kwEquals <> line <> rhs
 
 instance PrettyCode ConstructorApp where
@@ -240,9 +178,6 @@ instance PrettyCode Module where
           <> body'
           <> line
 
-parensCond :: Bool -> Doc Ann -> Doc Ann
-parensCond t d = if t then parens d else d
-
 ppPostExpression ::
   (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>
   Fixity ->

src/Juvix/Compiler/Mono/Pretty/Options.hs

@@ -2,16 +2,14 @@ module Juvix.Compiler.Mono.Pretty.Options where
 
 import Juvix.Prelude
 
-data Options = Options
-  { _optIndent :: Int,
-    _optShowNameIds :: Bool
+newtype Options = Options
+  { _optShowNameIds :: Bool
   }
 
 defaultOptions :: Options
 defaultOptions =
   Options
-    { _optIndent = 2,
-      _optShowNameIds = False
+    { _optShowNameIds = False
     }
 
 makeLenses ''Options

src/Juvix/Compiler/Mono/Pretty/Text.hs

@@ -2,7 +2,7 @@ module Juvix.Compiler.Mono.Pretty.Text where
 
 import Juvix.Compiler.Mono.Pretty.Base
 import Juvix.Prelude
-import Prettyprinter.Render.Text
+import Prettyprinter.Render.Text as Text
 
 printPrettyCodeDefault :: PrettyCode c => c -> IO ()
 printPrettyCodeDefault = printPrettyCode defaultOptions
@@ -11,7 +11,7 @@ printPrettyCode :: PrettyCode c => Options -> c -> IO ()
 printPrettyCode = hPrintPrettyCode stdout
 
 hPrintPrettyCode :: PrettyCode c => Handle -> Options -> c -> IO ()
-hPrintPrettyCode h opts = renderIO h . docStream opts
+hPrintPrettyCode h opts = Text.renderIO h . docStream opts
 
 renderPrettyCodeDefault :: PrettyCode c => c -> Text
 renderPrettyCodeDefault = renderStrict . docStream defaultOptions

src/Juvix/Data.hs

@@ -2,7 +2,7 @@ module Juvix.Data
   ( module Juvix.Data.Backends,
     module Juvix.Data.Effect,
     module Juvix.Data.Error,
-    -- module Juvix.Data.Fixity,
+    module Juvix.Data.Fixity,
     module Juvix.Data.ForeignBlock,
     module Juvix.Data.Hole,
     module Juvix.Data.IsImplicit,
@@ -17,11 +17,10 @@ module Juvix.Data
 where
 
 import Juvix.Data.Backends
--- import Juvix.Data.Fixity
-
 import Juvix.Data.DependencyInfo
 import Juvix.Data.Effect
 import Juvix.Data.Error
+import Juvix.Data.Fixity
 import Juvix.Data.ForeignBlock
 import Juvix.Data.Hole
 import Juvix.Data.IsImplicit

src/Juvix/Data/CodeAnn.hs

@@ -0,0 +1,230 @@
+module Juvix.Data.CodeAnn
+  ( module Juvix.Data.CodeAnn,
+    module Juvix.Prelude.Pretty,
+  )
+where
+
+import Juvix.Compiler.Concrete.Data
+import Juvix.Extra.Strings qualified as Str
+import Juvix.Prelude
+import Juvix.Prelude.Pretty hiding (braces, parens)
+import Prettyprinter.Render.Terminal (Color (..), bold, colorDull)
+
+type Ann = CodeAnn
+
+data CodeAnn
+  = AnnKind NameKind
+  | AnnKeyword
+  | AnnCode
+  | AnnComment
+  | AnnImportant
+  | AnnDelimiter
+  | AnnLiteralString
+  | AnnLiteralInteger
+  | AnnUnkindedSym
+  | AnnDef TopModulePath NameId
+  | AnnRef TopModulePath NameId
+
+instance HasNameKindAnn Ann where
+  annNameKind = AnnKind
+
+stylize :: Ann -> AnsiStyle
+stylize a = case a of
+  AnnKind k -> nameKindAnsi k
+  AnnUnkindedSym -> mempty
+  AnnKeyword -> colorDull Blue
+  AnnCode -> bold
+  AnnImportant -> bold
+  AnnComment -> colorDull Cyan
+  AnnDelimiter -> colorDull White
+  AnnLiteralString -> colorDull Red
+  AnnLiteralInteger -> colorDull Cyan
+  AnnDef {} -> mempty
+  AnnRef {} -> mempty
+
+keyword :: Text -> Doc Ann
+keyword = annotate AnnKeyword . pretty
+
+kwLambda :: Doc Ann
+kwLambda = keyword Str.lambdaUnicode
+
+kwInclude :: Doc Ann
+kwInclude = keyword Str.include
+
+kwArrow :: Doc Ann
+kwArrow = keyword Str.toUnicode
+
+kwMapsto :: Doc Ann
+kwMapsto = keyword Str.mapstoUnicode
+
+kwForeign :: Doc Ann
+kwForeign = keyword Str.foreign_
+
+kwCompile :: Doc Ann
+kwCompile = keyword Str.compile
+
+kwC :: Doc Ann
+kwC = keyword Str.cBackend
+
+kwGhc :: Doc Ann
+kwGhc = keyword Str.ghc
+
+kwColon :: Doc Ann
+kwColon = keyword Str.colon
+
+kwData :: Doc Ann
+kwData = keyword Str.data_
+
+kwAssign :: Doc Ann
+kwAssign = keyword Str.assignUnicode
+
+kwEquals :: Doc Ann
+kwEquals = keyword Str.equal
+
+kwColonColon :: Doc Ann
+kwColonColon = keyword (Str.colon <> Str.colon)
+
+kwPipe :: Doc Ann
+kwPipe = keyword Str.pipe
+
+kwHole :: Doc Ann
+kwHole = keyword Str.underscore
+
+kwAxiom :: Doc Ann
+kwAxiom = keyword Str.axiom
+
+kwWhere :: Doc Ann
+kwWhere = keyword Str.where_
+
+kwModule :: Doc Ann
+kwModule = keyword Str.module_
+
+kwType :: Doc Ann
+kwType = keyword Str.type_
+
+kwWildcard :: Doc Ann
+kwWildcard = keyword Str.underscore
+
+kwEnd :: Doc Ann
+kwEnd = keyword Str.end
+
+kwBuiltin :: Doc Ann
+kwBuiltin = keyword Str.builtin
+
+kwNatural :: Doc Ann
+kwNatural = keyword Str.natural
+
+kwInductive :: Doc Ann
+kwInductive = keyword Str.inductive
+
+kwArrowR :: Doc Ann
+kwArrowR = keyword Str.toUnicode
+
+kwLet :: Doc Ann
+kwLet = keyword Str.let_
+
+kwIn :: Doc Ann
+kwIn = keyword Str.in_
+
+kwPublic :: Doc Ann
+kwPublic = keyword Str.public
+
+kwPostfix :: Doc Ann
+kwPostfix = keyword Str.postfix
+
+kwInfixr :: Doc Ann
+kwInfixr = keyword Str.infixr_
+
+kwInfixl :: Doc Ann
+kwInfixl = keyword Str.infixl_
+
+kwInfix :: Doc Ann
+kwInfix = keyword Str.infix_
+
+kwAssignment :: Doc Ann
+kwAssignment = keyword Str.assignUnicode
+
+kwColonZero :: Doc Ann
+kwColonZero = keyword Str.colonZero
+
+kwColonOne :: Doc Ann
+kwColonOne = keyword Str.colonOne
+
+kwColonOmega :: Doc Ann
+kwColonOmega = keyword Str.colonOmegaUnicode
+
+kwOpen :: Doc Ann
+kwOpen = keyword Str.open
+
+kwUsing :: Doc Ann
+kwUsing = keyword Str.using
+
+kwHiding :: Doc Ann
+kwHiding = keyword Str.hiding
+
+kwImport :: Doc Ann
+kwImport = keyword Str.import_
+
+delimiter :: Text -> Doc Ann
+delimiter = annotate AnnDelimiter . pretty
+
+kwSemicolon :: Doc Ann
+kwSemicolon = delimiter Str.semicolon
+
+kwTerminating :: Doc Ann
+kwTerminating = keyword Str.terminating
+
+kwBraceL :: Doc Ann
+kwBraceL = delimiter "{"
+
+kwBraceR :: Doc Ann
+kwBraceR = delimiter "}"
+
+kwParenL :: Doc Ann
+kwParenL = delimiter "("
+
+kwParenR :: Doc Ann
+kwParenR = delimiter ")"
+
+kwDQuote :: Doc Ann
+kwDQuote = pretty ("\"" :: Text)
+
+kwDot :: Doc Ann
+kwDot = delimiter "."
+
+code :: Doc Ann -> Doc Ann
+code = annotate AnnCode
+
+braces :: Doc Ann -> Doc Ann
+braces = enclose kwBraceL kwBraceR
+
+parens :: Doc Ann -> Doc Ann
+parens = enclose kwParenL kwParenR
+
+implicitDelim :: IsImplicit -> Doc Ann -> Doc Ann
+implicitDelim = \case
+  Implicit -> braces
+  Explicit -> parens
+
+doubleQuotes :: Doc Ann -> Doc Ann
+doubleQuotes = enclose kwDQuote kwDQuote
+
+annotateKind :: NameKind -> Doc Ann -> Doc Ann
+annotateKind = annotate . AnnKind
+
+parensCond :: Bool -> Doc Ann -> Doc Ann
+parensCond t d = if t then parens d else d
+
+bracesCond :: Bool -> Doc Ann -> Doc Ann
+bracesCond t d = if t then braces d else d
+
+ppStringLit :: Text -> Doc Ann
+ppStringLit = annotate AnnLiteralString . doubleQuotes . escaped
+  where
+    showChar :: Char -> String
+    showChar c = showLitChar c ("" :: String)
+    escaped :: Text -> Doc a
+    escaped = mconcatMap (pretty . showChar) . unpack
+
+bracesIndent :: Doc Ann -> Doc Ann
+bracesIndent d = braces (line <> indent' d <> line)

src/Juvix/Data/NameKind.hs

@@ -1,4 +1,4 @@
-module Juvix.Compiler.Concrete.Data.NameKind where
+module Juvix.Data.NameKind where
 
 import Juvix.Prelude
 import Juvix.Prelude.Pretty

src/Juvix/Data/PPOutput.hs

@@ -0,0 +1,21 @@
+module Juvix.Data.PPOutput
+  ( module Juvix.Data.PPOutput,
+    module Juvix.Data.CodeAnn,
+  )
+where
+
+import Juvix.Data.CodeAnn
+import Juvix.Prelude.Base
+
+newtype PPOutput = PPOutput (Doc Ann)
+
+instance HasAnsiBackend PPOutput where
+  toAnsiStream (PPOutput o) = reAnnotateS stylize (layoutPretty defaultLayoutOptions o)
+  toAnsiDoc (PPOutput o) = reAnnotate stylize o
+
+instance HasTextBackend PPOutput where
+  toTextDoc (PPOutput o) = unAnnotate o
+  toTextStream (PPOutput o) = unAnnotateS (layoutPretty defaultLayoutOptions o)
+
+ppOutput :: Doc Ann -> AnsiText
+ppOutput = AnsiText . PPOutput

src/Juvix/Extra/Paths.hs

@@ -6,3 +6,6 @@ import Language.Haskell.TH.Syntax
 
 assetsDir :: Q Exp
 assetsDir = FE.makeRelativeToProject "assets" >>= FE.embedDir
+
+juvixYamlFile :: FilePath
+juvixYamlFile = "juvix.yaml"

src/Juvix/Extra/Strings.hs

@@ -1,6 +1,6 @@
 module Juvix.Extra.Strings where
 
-import Juvix.Prelude
+import Juvix.Prelude.Base
 
 module_ :: IsString s => s
 module_ = "module"

src/Juvix/Prelude/Pretty.hs

@@ -91,6 +91,9 @@ hsepMaybe l
   | null l = Nothing
   | otherwise = Just (hsep l)
 
+indent' :: Doc ann -> Doc ann
+indent' = indent 2
+
 ordinal :: Int -> Doc a
 ordinal = \case
   1 -> "first"