parsing

app/Commands/Compile/Anoma.hs

@@ -29,6 +29,6 @@ runCommand opts = do
 outputAnomaResult :: (Members '[EmbedIO, App, Files] r) => Bool -> Path Abs File -> Nockma.AnomaResult -> Sem r ()
 outputAnomaResult debugOutput nockmaFile Nockma.AnomaResult {..} = do
   let code = Encoding.jamToByteString _anomaClosure
-      prettyNockmaFile = replaceExtensions' [".debug", ".nockma"] nockmaFile
+      prettyNockmaFile = replaceExtensions' nockmaDebugFileExts nockmaFile
   writeFileBS nockmaFile code
   when debugOutput (writeFileEnsureLn prettyNockmaFile (Nockma.ppPrint _anomaClosure))

app/Commands/Dev/Nockma/Eval.hs

@@ -10,10 +10,9 @@ import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
 runCommand :: forall r. (Members AppEffects r) => NockmaEvalOptions -> Sem r ()
 runCommand opts = do
   afile <- fromAppPathFile file
-  parsedTerm <- Nockma.parseTermFile afile
+  parsedTerm <- runAppError @JuvixError (Nockma.cueJammedFileOrPretty afile)
   case parsedTerm of
-    Left err -> exitJuvixError (JuvixError err)
-    Right (TermCell c) -> do
+    TermCell c -> do
       (counts, res) <-
         runOpCounts
           . runReader defaultEvalOptions
@@ -22,7 +21,7 @@ runCommand opts = do
       putStrLn (ppPrint res)
       let statsFile = replaceExtension' ".profile" afile
       writeFileEnsureLn statsFile (prettyText counts)
-    Right TermAtom {} -> exitFailMsg "Expected nockma input to be a cell"
+    TermAtom {} -> exitFailMsg "Expected nockma input to be a cell"
   where
     file :: AppPath File
     file = opts ^. nockmaEvalFile

app/Commands/Dev/Nockma/Format.hs

@@ -5,13 +5,11 @@ import Commands.Dev.Nockma.Format.Options
 import Juvix.Compiler.Nockma.Pretty
 import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
 
-runCommand :: forall r. (Members '[EmbedIO, App] r) => NockmaFormatOptions -> Sem r ()
+runCommand :: forall r. (Members AppEffects r) => NockmaFormatOptions -> Sem r ()
 runCommand opts = do
   afile <- fromAppPathFile file
-  parsedTerm <- Nockma.parseTermFile afile
-  case parsedTerm of
-    Left err -> exitJuvixError (JuvixError err)
-    Right t -> putStrLn (ppPrint t)
+  parsedTerm <- runAppError @JuvixError (Nockma.parseTermFile afile)
+  putStrLn (ppPrint parsedTerm)
   where
     file :: AppPath File
     file = opts ^. nockmaFormatFile

app/Commands/Dev/Nockma/Repl.hs

@@ -10,7 +10,7 @@ import Juvix.Compiler.Nockma.Evaluator.Options
 import Juvix.Compiler.Nockma.Language
 import Juvix.Compiler.Nockma.Pretty
 import Juvix.Compiler.Nockma.Pretty qualified as Nockma
-import Juvix.Compiler.Nockma.Translation.FromSource (parseProgramFile, parseReplStatement, parseReplText, parseText)
+import Juvix.Compiler.Nockma.Translation.FromSource (cueJammedFileOrPrettyProgram, parseReplStatement, parseReplText, parseText)
 import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
 import Juvix.Parser.Error
 import Juvix.Prelude qualified as Prelude
@@ -111,7 +111,8 @@ getProgram :: Repl (Maybe (Program Natural))
 getProgram = State.gets (^. replStateProgram)
 
 readProgram :: Prelude.Path Abs File -> Repl (Program Natural)
-readProgram s = fromMegaParsecError <$> parseProgramFile s
+readProgram s = runM . runFilesIO $ do
+  runErrorIO' @JuvixError (cueJammedFileOrPrettyProgram s)
 
 direction' :: String -> Repl ()
 direction' s = Repline.dontCrash $ do

app/Commands/Dev/Nockma/Run.hs

@@ -7,13 +7,12 @@ import Juvix.Compiler.Nockma.EvalCompiled
 import Juvix.Compiler.Nockma.Evaluator
 import Juvix.Compiler.Nockma.Pretty
 import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
-import Juvix.Parser.Error
 
 runCommand :: forall r. (Members AppEffects r) => NockmaRunOptions -> Sem r ()
 runCommand opts = do
   afile <- fromAppPathFile inputFile
   argsFile <- mapM fromAppPathFile (opts ^. nockmaRunArgs)
-  parsedArgs <- mapM (Nockma.parseTermFile >=> checkParsed) argsFile
+  parsedArgs <- runAppError @JuvixError (mapM Nockma.cueJammedFileOrPretty argsFile)
   parsedTerm <- checkCued (Nockma.cueJammedFile afile)
   case parsedTerm of
     t@(TermCell {}) -> do
@@ -31,10 +30,5 @@ runCommand opts = do
     inputFile :: AppPath File
     inputFile = opts ^. nockmaRunFile
 
-    checkParsed :: Either MegaparsecError (Term Natural) -> Sem r (Term Natural)
-    checkParsed = \case
-      Left err -> exitJuvixError (JuvixError err)
-      Right tm -> return tm
-
     checkCued :: Sem (Error JuvixError ': r) a -> Sem r a
     checkCued = runErrorNoCallStackWith exitJuvixError

src/Juvix/Compiler/Nockma/Encoding/Cue.hs

@@ -51,7 +51,7 @@ instance PrettyCodeAnn DecodingError where
     DecodingErrorInvalidBackref -> "Invalid backref"
 
 instance PrettyCode DecodingError where
-  ppCode = return . pretty
+  ppCode = return . ppCodeAnn
 
 -- | Register the start of processing a new entity
 registerElementStart ::

src/Juvix/Compiler/Nockma/Language.hs

@@ -245,6 +245,9 @@ makeLenses ''WithStack
 makeLenses ''AtomInfo
 makeLenses ''CellInfo
 
+singletonProgram :: Term a -> Program a
+singletonProgram t = Program [StatementStandalone t]
+
 isCell :: Term a -> Bool
 isCell = \case
   TermCell {} -> True

src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs

@@ -25,6 +25,28 @@ parseText = runParser noFile
 parseReplText :: Text -> Either MegaparsecError (ReplTerm Natural)
 parseReplText = runParserFor replTerm noFile
 
+-- | If the file ends in .debug.nockma it parses an annotated unjammed term. Otherwise
+-- it is equivalent to cueJammedFile
+cueJammedFileOrPretty ::
+  forall r.
+  (Members '[Files, Error JuvixError] r) =>
+  Prelude.Path Abs File ->
+  Sem r (Term Natural)
+cueJammedFileOrPretty f
+  | f `hasExtensions` nockmaDebugFileExts = parseTermFile f
+  | otherwise = cueJammedFile f
+
+-- | If the file ends in .debug.nockma it parses an annotated unjammed program. Otherwise
+-- it parses program with a single jammed term
+cueJammedFileOrPrettyProgram ::
+  forall r.
+  (Members '[Files, Error JuvixError] r) =>
+  Prelude.Path Abs File ->
+  Sem r (Program Natural)
+cueJammedFileOrPrettyProgram f
+  | f `hasExtensions` nockmaDebugFileExts = parseProgramFile f
+  | otherwise = singletonProgram <$> cueJammedFile f
+
 cueJammedFile :: forall r. (Members '[Files, Error JuvixError] r) => Prelude.Path Abs File -> Sem r (Term Natural)
 cueJammedFile fp = do
   bs <- readFileBS' fp
@@ -55,15 +77,15 @@ cueJammedFile fp = do
         loc :: Loc
         loc = mkInitialLoc fp
 
-parseTermFile :: (MonadIO m) => Prelude.Path Abs File -> m (Either MegaparsecError (Term Natural))
+parseTermFile :: (Members '[Files, Error JuvixError] r) => Prelude.Path Abs File -> Sem r (Term Natural)
 parseTermFile fp = do
-  txt <- readFile fp
-  return (runParser fp txt)
+  txt <- readFile' fp
+  either (throw . JuvixError) return (runParser fp txt)
 
-parseProgramFile :: (MonadIO m) => Prelude.Path Abs File -> m (Either MegaparsecError (Program Natural))
+parseProgramFile :: (Members '[Files, Error JuvixError] r) => Prelude.Path Abs File -> Sem r (Program Natural)
 parseProgramFile fp = do
-  txt <- readFile fp
-  return (runParserProgram fp txt)
+  txt <- readFile' fp
+  either (throw . JuvixError) return (runParserProgram fp txt)
 
 parseReplStatement :: Text -> Either MegaparsecError (ReplStatement Natural)
 parseReplStatement = runParserFor replStatement noFile

src/Juvix/Data/FileExt.hs

@@ -32,9 +32,29 @@ data FileExt
 
 $(genSingletons [''FileExt])
 
+splitExtensions :: Path b File -> (Path b File, [String])
+splitExtensions =
+  swap
+    . run
+    . runAccumListReverse
+    . go
+  where
+    go :: (Members '[Accum String] r) => Path b File -> Sem r (Path b File)
+    go f = case splitExtension f of
+      Nothing -> return f
+      Just (f', ext) -> do
+        accum ext
+        go f'
+
+hasExtensions :: (Foldable l) => Path b File -> l String -> Bool
+hasExtensions f exts = toList exts == snd (splitExtensions f)
+
 juvixFileExt :: (IsString a) => a
 juvixFileExt = ".juvix"
 
+nockmaDebugFileExts :: (IsString a) => NonEmpty a
+nockmaDebugFileExts = ".debug" :| [".nockma"]
+
 juvixMarkdownFileExt :: (IsString a) => a
 juvixMarkdownFileExt = ".juvix.md"
 

src/Juvix/Prelude/Effects/Accum.hs

@@ -22,6 +22,7 @@ newtype instance StaticRep (Accum o) = Accum
 accum :: (Member (Accum o) r) => o -> Sem r ()
 accum o = overStaticRep (\(Accum l) -> Accum (o : l))
 
+-- | Accumulates in LIFO order
 runAccumListReverse :: Sem (Accum o ': r) a -> Sem r ([o], a)
 runAccumListReverse m = do
   (a, Accum s) <- runStaticRep (Accum mempty) m

src/Juvix/Prelude/Path.hs

@@ -88,18 +88,16 @@ removeExtension = fmap fst . splitExtension
 removeExtension' :: Path b File -> Path b File
 removeExtension' = fst . fromJust . splitExtension
 
-addExtensions :: (MonadThrow m) => [String] -> Path b File -> m (Path b File)
-addExtensions ext p = case ext of
-  [] -> return p
-  e : es -> addExtension e p >>= addExtensions es
+addExtensions :: forall m l b. (MonadThrow m, Foldable l) => l String -> Path b File -> m (Path b File)
+addExtensions exts p = foldM (flip addExtension) p exts
 
-replaceExtensions :: (MonadThrow m) => [String] -> Path b File -> m (Path b File)
+replaceExtensions :: (MonadThrow m, Foldable l) => l String -> Path b File -> m (Path b File)
 replaceExtensions ext = addExtensions ext . removeExtensions
 
-replaceExtensions' :: [String] -> Path b File -> Path b File
+replaceExtensions' :: (Foldable l) => l String -> Path b File -> Path b File
 replaceExtensions' ext = fromJust . replaceExtensions ext
 
-addExtensions' :: [String] -> Path b File -> Path b File
+addExtensions' :: (Foldable l) => l String -> Path b File -> Path b File
 addExtensions' ext = fromJust . addExtensions ext
 
 -- | TODO this is ugly. Please, fix it. FileExtJuvixMarkdown needs special