diff --git a/app/Main.hs b/app/Main.hs index bef98f5cb..ccd070bb3 100644 --- a/app/Main.hs +++ b/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 diff --git a/src/Juvix/Compiler/Abstract/Data/Name.hs b/src/Juvix/Compiler/Abstract/Data/Name.hs index ba91617f0..a62d53320 100644 --- a/src/Juvix/Compiler/Abstract/Data/Name.hs +++ b/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 diff --git a/src/Juvix/Compiler/Abstract/Pretty.hs b/src/Juvix/Compiler/Abstract/Pretty.hs index b33edb87d..0358b12b6 100644 --- a/src/Juvix/Compiler/Abstract/Pretty.hs +++ b/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) diff --git a/src/Juvix/Compiler/Abstract/Pretty/Ann.hs b/src/Juvix/Compiler/Abstract/Pretty/Ann.hs deleted file mode 100644 index d5db43c8d..000000000 --- a/src/Juvix/Compiler/Abstract/Pretty/Ann.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Abstract/Pretty/Ansi.hs b/src/Juvix/Compiler/Abstract/Pretty/Ansi.hs deleted file mode 100644 index 8b5820316..000000000 --- a/src/Juvix/Compiler/Abstract/Pretty/Ansi.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Abstract/Pretty/Base.hs b/src/Juvix/Compiler/Abstract/Pretty/Base.hs index 290fd9f89..fa217ee23 100644 --- a/src/Juvix/Compiler/Abstract/Pretty/Base.hs +++ b/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 diff --git a/src/Juvix/Compiler/Abstract/Pretty/Options.hs b/src/Juvix/Compiler/Abstract/Pretty/Options.hs index 6a6baf9b1..f896b800e 100644 --- a/src/Juvix/Compiler/Abstract/Pretty/Options.hs +++ b/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 } diff --git a/src/Juvix/Compiler/Abstract/Translation/FromConcrete.hs b/src/Juvix/Compiler/Abstract/Translation/FromConcrete.hs index 8a7e6a88c..5d00492d8 100644 --- a/src/Juvix/Compiler/Abstract/Translation/FromConcrete.hs +++ b/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} diff --git a/src/Juvix/Compiler/Backend/C/Extra/Serialization.hs b/src/Juvix/Compiler/Backend/C/Extra/Serialization.hs index 0cba8e94d..e53f666c5 100644 --- a/src/Juvix/Compiler/Backend/C/Extra/Serialization.hs +++ b/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 diff --git a/src/Juvix/Compiler/Backend/C/Translation/FromInternal.hs b/src/Juvix/Compiler/Backend/C/Translation/FromInternal.hs index 2f1b932e5..183f0fcf4 100644 --- a/src/Juvix/Compiler/Backend/C/Translation/FromInternal.hs +++ b/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 diff --git a/src/Juvix/Compiler/Backend/Haskell/Language.hs b/src/Juvix/Compiler/Backend/Haskell/Language.hs index 8aa38ff68..e63d3f4ef 100644 --- a/src/Juvix/Compiler/Backend/Haskell/Language.hs +++ b/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 diff --git a/src/Juvix/Compiler/Backend/Haskell/Pretty.hs b/src/Juvix/Compiler/Backend/Haskell/Pretty.hs index a1c39aa7b..12eb18f94 100644 --- a/src/Juvix/Compiler/Backend/Haskell/Pretty.hs +++ b/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) diff --git a/src/Juvix/Compiler/Backend/Haskell/Pretty/Ann.hs b/src/Juvix/Compiler/Backend/Haskell/Pretty/Ann.hs deleted file mode 100644 index f294d4ba9..000000000 --- a/src/Juvix/Compiler/Backend/Haskell/Pretty/Ann.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Backend/Haskell/Pretty/Ansi.hs b/src/Juvix/Compiler/Backend/Haskell/Pretty/Ansi.hs deleted file mode 100644 index c4d45d4d2..000000000 --- a/src/Juvix/Compiler/Backend/Haskell/Pretty/Ansi.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Backend/Haskell/Pretty/Base.hs b/src/Juvix/Compiler/Backend/Haskell/Pretty/Base.hs index 2e6a7972d..72334b108 100644 --- a/src/Juvix/Compiler/Backend/Haskell/Pretty/Base.hs +++ b/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 -> diff --git a/src/Juvix/Compiler/Backend/Haskell/Pretty/Options.hs b/src/Juvix/Compiler/Backend/Haskell/Pretty/Options.hs index e4ff88696..5c9b07277 100644 --- a/src/Juvix/Compiler/Backend/Haskell/Pretty/Options.hs +++ b/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 diff --git a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs index 72d1a5bdd..da5a5329d 100644 --- a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs +++ b/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 diff --git a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs index 781c7a5ef..580d82fb4 100644 --- a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs +++ b/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 = diff --git a/src/Juvix/Compiler/Builtins/Error.hs b/src/Juvix/Compiler/Builtins/Error.hs index b137210ab..e0e73808a 100644 --- a/src/Juvix/Compiler/Builtins/Error.hs +++ b/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" diff --git a/src/Juvix/Compiler/Concrete/Data.hs b/src/Juvix/Compiler/Concrete/Data.hs index 5ea155324..4f2055e1c 100644 --- a/src/Juvix/Compiler/Concrete/Data.hs +++ b/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 diff --git a/src/Juvix/Compiler/Concrete/Data/ScopedName.hs b/src/Juvix/Compiler/Concrete/Data/ScopedName.hs index 1d6b9693b..a32f63a1b 100644 --- a/src/Juvix/Compiler/Concrete/Data/ScopedName.hs +++ b/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 diff --git a/src/Juvix/Compiler/Concrete/Language.hs b/src/Juvix/Compiler/Concrete/Language.hs index 78a2a769f..773ae82a8 100644 --- a/src/Juvix/Compiler/Concrete/Language.hs +++ b/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) diff --git a/src/Juvix/Compiler/Concrete/Pretty.hs b/src/Juvix/Compiler/Concrete/Pretty.hs index 0a85ddd16..e181cd041 100644 --- a/src/Juvix/Compiler/Concrete/Pretty.hs +++ b/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) diff --git a/src/Juvix/Compiler/Concrete/Pretty/Ann.hs b/src/Juvix/Compiler/Concrete/Pretty/Ann.hs deleted file mode 100644 index 0465beca6..000000000 --- a/src/Juvix/Compiler/Concrete/Pretty/Ann.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Concrete/Pretty/Ansi.hs b/src/Juvix/Compiler/Concrete/Pretty/Ansi.hs deleted file mode 100644 index d20eda569..000000000 --- a/src/Juvix/Compiler/Concrete/Pretty/Ansi.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Concrete/Pretty/Base.hs b/src/Juvix/Compiler/Concrete/Pretty/Base.hs index 01e6be22b..3840cf669 100644 --- a/src/Juvix/Compiler/Concrete/Pretty/Base.hs +++ b/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 -> diff --git a/src/Juvix/Compiler/Concrete/Pretty/Options.hs b/src/Juvix/Compiler/Concrete/Pretty/Options.hs index 4ee21af3d..46934f642 100644 --- a/src/Juvix/Compiler/Concrete/Pretty/Options.hs +++ b/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 diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Ann.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Ann.hs deleted file mode 100644 index 7033ab383..000000000 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Ann.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Pretty.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Pretty.hs index ba9d110dd..632b30e67 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Pretty.hs +++ b/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 = diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Pretty/Ansi.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Pretty/Ansi.hs deleted file mode 100644 index 969dde5ce..000000000 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Pretty/Ansi.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs index 5083f3366..4a27c3b8f 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs +++ b/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 diff --git a/src/Juvix/Compiler/Internal/Pretty.hs b/src/Juvix/Compiler/Internal/Pretty.hs index 33fa0bfe4..43f840303 100644 --- a/src/Juvix/Compiler/Internal/Pretty.hs +++ b/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 diff --git a/src/Juvix/Compiler/Internal/Pretty/Ann.hs b/src/Juvix/Compiler/Internal/Pretty/Ann.hs deleted file mode 100644 index 845731ef5..000000000 --- a/src/Juvix/Compiler/Internal/Pretty/Ann.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Internal/Pretty/Ansi.hs b/src/Juvix/Compiler/Internal/Pretty/Ansi.hs deleted file mode 100644 index ac37cf4d2..000000000 --- a/src/Juvix/Compiler/Internal/Pretty/Ansi.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Internal/Pretty/Base.hs b/src/Juvix/Compiler/Internal/Pretty/Base.hs index 63b16b70c..9f071050f 100644 --- a/src/Juvix/Compiler/Internal/Pretty/Base.hs +++ b/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) diff --git a/src/Juvix/Compiler/Internal/Pretty/Options.hs b/src/Juvix/Compiler/Internal/Pretty/Options.hs index 54258a759..0706ea4c9 100644 --- a/src/Juvix/Compiler/Internal/Pretty/Options.hs +++ b/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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Data/FunctionCall.hs b/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Data/FunctionCall.hs index 550a0bff8..31cd6d05e 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Data/FunctionCall.hs +++ b/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]) diff --git a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Data/Graph.hs b/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Data/Graph.hs index 2973280d8..68cfbef4a 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Data/Graph.hs +++ b/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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error.hs b/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error.hs index c4fdf305c..96d3f3a68 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error.hs +++ b/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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty.hs b/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty.hs deleted file mode 100644 index 936fd0e84..000000000 --- a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty/Ann.hs b/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty/Ann.hs deleted file mode 100644 index 47f7626ab..000000000 --- a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty/Ann.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty/Ansi.hs b/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty/Ansi.hs deleted file mode 100644 index 3615e0ffb..000000000 --- a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Pretty/Ansi.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Types.hs b/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Types.hs index e3067e58e..408784fea 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromAbstract/Analysis/Termination/Error/Types.hs +++ b/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." diff --git a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/ArityChecking/Error/Types.hs b/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/ArityChecking/Error/Types.hs index dcba0b5a2..d7aa67211 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/ArityChecking/Error/Types.hs +++ b/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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty.hs b/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty.hs index 431c2f02f..cde58c1f2 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty.hs +++ b/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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty/Ann.hs b/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty/Ann.hs deleted file mode 100644 index 6534084fb..000000000 --- a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty/Ann.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty/Ansi.hs b/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty/Ansi.hs deleted file mode 100644 index 285246ce6..000000000 --- a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Pretty/Ansi.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Types.hs b/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Types.hs index eb8929d6d..c8496a33d 100644 --- a/src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Error/Types.hs +++ b/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 diff --git a/src/Juvix/Compiler/Mono/Language.hs b/src/Juvix/Compiler/Mono/Language.hs index d2a4c0b6b..24688f9e5 100644 --- a/src/Juvix/Compiler/Mono/Language.hs +++ b/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 diff --git a/src/Juvix/Compiler/Mono/Pretty.hs b/src/Juvix/Compiler/Mono/Pretty.hs index 5de81fb9d..0f64fac18 100644 --- a/src/Juvix/Compiler/Mono/Pretty.hs +++ b/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) diff --git a/src/Juvix/Compiler/Mono/Pretty/Ann.hs b/src/Juvix/Compiler/Mono/Pretty/Ann.hs deleted file mode 100644 index 5b6db2581..000000000 --- a/src/Juvix/Compiler/Mono/Pretty/Ann.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Juvix.Compiler.Mono.Pretty.Ann where - -import Juvix.Compiler.Concrete.Data.NameKind - -data Ann - = AnnKind NameKind - | AnnKeyword - | AnnLiteralString - | AnnLiteralInteger diff --git a/src/Juvix/Compiler/Mono/Pretty/Ansi.hs b/src/Juvix/Compiler/Mono/Pretty/Ansi.hs deleted file mode 100644 index 1a9c6750e..000000000 --- a/src/Juvix/Compiler/Mono/Pretty/Ansi.hs +++ /dev/null @@ -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 diff --git a/src/Juvix/Compiler/Mono/Pretty/Base.hs b/src/Juvix/Compiler/Mono/Pretty/Base.hs index 31566aa2b..3dd72989d 100644 --- a/src/Juvix/Compiler/Mono/Pretty/Base.hs +++ b/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 -> diff --git a/src/Juvix/Compiler/Mono/Pretty/Options.hs b/src/Juvix/Compiler/Mono/Pretty/Options.hs index f4ac84080..383baa997 100644 --- a/src/Juvix/Compiler/Mono/Pretty/Options.hs +++ b/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 diff --git a/src/Juvix/Compiler/Mono/Pretty/Text.hs b/src/Juvix/Compiler/Mono/Pretty/Text.hs index a05c81d16..032f50401 100644 --- a/src/Juvix/Compiler/Mono/Pretty/Text.hs +++ b/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 diff --git a/src/Juvix/Data.hs b/src/Juvix/Data.hs index b906cfd02..a828c20f6 100644 --- a/src/Juvix/Data.hs +++ b/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 diff --git a/src/Juvix/Data/CodeAnn.hs b/src/Juvix/Data/CodeAnn.hs new file mode 100644 index 000000000..dc4358819 --- /dev/null +++ b/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) diff --git a/src/Juvix/Compiler/Concrete/Data/NameKind.hs b/src/Juvix/Data/NameKind.hs similarity index 97% rename from src/Juvix/Compiler/Concrete/Data/NameKind.hs rename to src/Juvix/Data/NameKind.hs index 10758a9b9..8938d7ffd 100644 --- a/src/Juvix/Compiler/Concrete/Data/NameKind.hs +++ b/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 diff --git a/src/Juvix/Data/PPOutput.hs b/src/Juvix/Data/PPOutput.hs new file mode 100644 index 000000000..814357bbc --- /dev/null +++ b/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 diff --git a/src/Juvix/Extra/Paths.hs b/src/Juvix/Extra/Paths.hs index 0298d4346..8d485600d 100644 --- a/src/Juvix/Extra/Paths.hs +++ b/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" diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs index 680208862..198bb8b3d 100644 --- a/src/Juvix/Extra/Strings.hs +++ b/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" diff --git a/src/Juvix/Prelude/Pretty.hs b/src/Juvix/Prelude/Pretty.hs index c23f1801a..0d056d77a 100644 --- a/src/Juvix/Prelude/Pretty.hs +++ b/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"