Separate Comment from pretty Options

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

@@ -7,13 +7,17 @@ import Juvix.Prelude
 import Prettyprinter.Render.Terminal qualified as Ansi
 
 ppOutDefault :: (PrettyCode c) => [Comment] -> c -> AnsiText
-ppOutDefault comments = mkAnsiText . PPOutput . doc (defaultOptions comments)
-
-ppOut :: (CanonicalProjection a Options, PrettyCode c) => a -> c -> AnsiText
-ppOut o = mkAnsiText . PPOutput . doc (project o)
+ppOutDefault comments =
+  mkAnsiText
+    . PPOutput
+    . doc defaultOptions comments
 
 ppTrace' :: (CanonicalProjection a Options, PrettyCode c) => a -> c -> Text
-ppTrace' opts = Ansi.renderStrict . reAnnotateS stylize . layoutPretty defaultLayoutOptions . doc (project opts)
+ppTrace' opts =
+  Ansi.renderStrict
+    . reAnnotateS stylize
+    . layoutPretty defaultLayoutOptions
+    . doc (project opts) []
 
 ppTrace :: (PrettyCode c) => c -> Text
 ppTrace = ppTrace' traceOptions

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

@@ -10,39 +10,42 @@ arrow :: Doc Ann
 arrow = "\\<Rightarrow>"
 
 class PrettyCode c where
-  ppCode :: (Member (State Options) r) => c -> Sem r (Doc Ann)
+  ppCode :: (Members '[Reader Options, Input Comment] r) => c -> Sem r (Doc Ann)
 
-doc :: (PrettyCode c) => Options -> c -> Doc Ann
-doc opts = run . evalState opts . ppCode
+doc :: (PrettyCode c) => Options -> [Comment] -> c -> Doc Ann
+doc opts comments =
+  run
+    . runReader opts
+    . runInputList comments
+    . ppCode
 
-ppCodeQuoted :: (HasAtomicity c, PrettyCode c, Member (State Options) r) => c -> Sem r (Doc Ann)
+ppCodeQuoted :: (HasAtomicity c, PrettyCode c, Members '[Reader Options, Input Comment] r) => c -> Sem r (Doc Ann)
 ppCodeQuoted c
   | atomicity c == Atom = ppCode c
   | otherwise = dquotes <$> ppCode c
 
-ppTopCode :: (HasAtomicity c, PrettyCode c, Member (State Options) r) => c -> Sem r (Doc Ann)
+ppTopCode :: (HasAtomicity c, PrettyCode c, Members '[Reader Options, Input Comment] r) => c -> Sem r (Doc Ann)
 ppTopCode c = parensIf (not (isAtomic c)) <$> ppCode c
 
-ppParams :: (HasAtomicity c, PrettyCode c, Member (State Options) r) => [c] -> Sem r (Maybe (Doc Ann))
+ppParams :: (HasAtomicity c, PrettyCode c, Members '[Reader Options, Input Comment] r) => [c] -> Sem r (Maybe (Doc Ann))
 ppParams = \case
   [] -> return Nothing
   [x] -> Just <$> ppRightExpression appFixity x
   params -> do
     ps <- mapM ppCode params
     return $ Just $ parens (hsep (punctuate comma ps))
 
-ppComments :: (Member (State Options) r) => Interval -> Sem r (Doc Ann)
+ppComments :: (Member (Input Comment) r) => Interval -> Sem r (Doc Ann)
 ppComments loc = do
-  comments <- gets (takeWhile cmpLoc . (^. optComments))
-  modify' $ over optComments (dropWhile cmpLoc)
+  comments <- inputWhile cmpLoc
   return
     . mconcatMap (\c -> annotate AnnComment $ "(*" <> pretty (c ^. commentText) <+> "*)" <> line)
     $ comments
   where
     cmpLoc :: Comment -> Bool
     cmpLoc c = c ^. commentInterval . intervalStart <= loc ^. intervalEnd
 
-ppCodeWithComments :: (PrettyCode a, HasLoc a, Member (State Options) r) => a -> Sem r (Doc Ann, Doc Ann)
+ppCodeWithComments :: (PrettyCode a, HasLoc a, Members '[Reader Options, Input Comment] r) => a -> Sem r (Doc Ann, Doc Ann)
 ppCodeWithComments a = do
   comments <- ppComments (getLoc a)
   res <- ppCode a
@@ -192,7 +195,7 @@ instance (PrettyCode a) => PrettyCode (List a) where
     elems <- mapM ppCode _listElements
     return $ brackets $ hsep (punctuate comma elems)
 
-ppRecord :: (PrettyCode a, Member (State Options) r) => Bool -> Record a -> Sem r (Doc Ann)
+ppRecord :: (PrettyCode a, Members '[Reader Options, Input Comment] r) => Bool -> Record a -> Sem r (Doc Ann)
 ppRecord bUpdate Record {..} = do
   recName <- ppCode _recordName
   names <- mapM (ppCode . fst) _recordFields
@@ -335,21 +338,21 @@ instance PrettyCode Theory where
           <> kwEnd
 
 ppRightExpression ::
-  (PrettyCode a, HasAtomicity a, Member (State Options) r) =>
+  (PrettyCode a, HasAtomicity a, Members '[Reader Options, Input Comment] r) =>
   Fixity ->
   a ->
   Sem r (Doc Ann)
 ppRightExpression = ppLRExpression isRightAssoc
 
 ppLeftExpression ::
-  (PrettyCode a, HasAtomicity a, Member (State Options) r) =>
+  (PrettyCode a, HasAtomicity a, Members '[Reader Options, Input Comment] r) =>
   Fixity ->
   a ->
   Sem r (Doc Ann)
 ppLeftExpression = ppLRExpression isLeftAssoc
 
 ppLRExpression ::
-  (HasAtomicity a, PrettyCode a, Member (State Options) r) =>
+  (HasAtomicity a, PrettyCode a, Members '[Reader Options, Input Comment] r) =>
   (Fixity -> Bool) ->
   Fixity ->
   a ->

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

@@ -3,19 +3,17 @@ module Juvix.Compiler.Backend.Isabelle.Pretty.Options where
 import Juvix.Prelude
 
 data Options = Options
-  { _optComments :: [Comment]
-  }
 
 makeLenses ''Options
 
-defaultOptions :: [Comment] -> Options
+defaultOptions :: Options
 defaultOptions = Options
 
 traceOptions :: Options
-traceOptions = defaultOptions []
+traceOptions = defaultOptions
 
 fromGenericOptions :: GenericOptions -> Options
-fromGenericOptions _ = defaultOptions []
+fromGenericOptions _ = defaultOptions
 
 instance CanonicalProjection GenericOptions Options where
   project = fromGenericOptions

src/Juvix/Prelude/Effects/Input.hs

@@ -2,6 +2,7 @@ module Juvix.Prelude.Effects.Input
   ( Input,
     input,
     inputJust,
+    inputWhile,
     peekInput,
     runInputList,
   )
@@ -26,6 +27,14 @@ input =
       Input [] -> (Nothing, Input [])
       Input (i : is) -> (Just i, Input is)
 
+inputWhile :: (Member (Input i) r) => (i -> Bool) -> Sem r [i]
+inputWhile c =
+  stateStaticRep $
+    \case
+      Input l ->
+        let (sat, rest) = span c l
+         in (sat, Input rest)
+
 peekInput :: (Member (Input i) r) => Sem r (Maybe i)
 peekInput = do
   Input l <- getStaticRep