better errors

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

@@ -10,7 +10,7 @@ import Juvix.Prelude.Base
 import VectorBuilder.Builder as Builder
 import VectorBuilder.Vector
 
-data CueState a = CueState
+newtype CueState a = CueState
   { _cueStateCache :: HashMap Int (Term a)
   }
 
@@ -20,7 +20,7 @@ initCueState =
     { _cueStateCache = mempty
     }
 
-data CueEnv = CueEnv
+newtype CueEnv = CueEnv
   {_cueEnvStartPos :: Int}
 
 initCueEnv :: CueEnv
@@ -38,14 +38,20 @@ data DecodingError
   | DecodingErrorInvalidBackref
   deriving stock (Show)
 
+instance Pretty DecodingError where
+  pretty = unAnnotate . ppCodeAnn
+
+instance PrettyCodeAnn DecodingError where
+  ppCodeAnn = \case
+    DecodingErrorInvalidTag -> "Invalid tag"
+    DecodingErrorCacheMiss -> "Cache miss"
+    DecodingErrorInvalidLength -> "Invalid length"
+    DecodingErrorExpectedAtom -> "Expected atom"
+    DecodingErrorInvalidAtom -> "Invalid atom"
+    DecodingErrorInvalidBackref -> "Invalid backref"
+
 instance PrettyCode DecodingError where
-  ppCode = \case
-    DecodingErrorInvalidTag -> return "Invalid tag"
-    DecodingErrorCacheMiss -> return "Cache miss"
-    DecodingErrorInvalidLength -> return "Invalid length"
-    DecodingErrorExpectedAtom -> return "Expected atom"
-    DecodingErrorInvalidAtom -> return "Invalid atom"
-    DecodingErrorInvalidBackref -> return "Invalid backref"
+  ppCode = return . pretty
 
 -- | Register the start of processing a new entity
 registerElementStart ::

src/Juvix/Compiler/Nockma/Language.hs

@@ -11,8 +11,8 @@ import GHC.Base (Type)
 import Juvix.Compiler.Core.Language.Base (Symbol)
 import Juvix.Compiler.Nockma.Language.Path
 import Juvix.Compiler.Nockma.StdlibFunction.Base
+import Juvix.Data.CodeAnn
 import Juvix.Prelude hiding (Atom, Path)
-import Juvix.Prelude.Pretty
 
 data ReplStatement a
   = ReplStatementExpression (ReplExpression a)

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

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module Juvix.Compiler.Nockma.Pretty.Base
   ( module Juvix.Compiler.Nockma.Pretty.Base,
     module Juvix.Data.CodeAnn,
@@ -12,6 +14,9 @@ import Juvix.Data.CodeAnn
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude hiding (Atom, Path)
 
+docDefault :: (PrettyCode c) => c -> Doc Ann
+docDefault = doc defaultOptions
+
 doc :: (PrettyCode c) => Options -> c -> Doc Ann
 doc opts =
   run
@@ -24,6 +29,11 @@ class PrettyCode c where
 runPrettyCode :: (PrettyCode c) => Options -> c -> Doc Ann
 runPrettyCode opts = run . runReader opts . ppCode
 
+instance PrettyCodeAnn NockNaturalNaturalError where
+  ppCodeAnn = \case
+    NaturalInvalidPath a -> "Invalid path" <+> docDefault a
+    NaturalInvalidOp a -> "Invalid operator code" <+> docDefault a
+
 instance forall a. (PrettyCode a, NockNatural a) => PrettyCode (Atom a) where
   ppCode atm = do
     t <- runFail $ do

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

@@ -6,6 +6,7 @@ import Data.Text qualified as Text
 import Juvix.Compiler.Nockma.Encoding.ByteString (textToNatural)
 import Juvix.Compiler.Nockma.Encoding.Cue qualified as Cue
 import Juvix.Compiler.Nockma.Language
+import Juvix.Data.CodeAnn
 import Juvix.Extra.Paths
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Parser.Error
@@ -24,13 +25,35 @@ parseText = runParser noFile
 parseReplText :: Text -> Either MegaparsecError (ReplTerm Natural)
 parseReplText = runParserFor replTerm noFile
 
-cueJammedFile :: (Members '[Files, Error JuvixError] r) => Prelude.Path Abs File -> Sem r (Term Natural)
+cueJammedFile :: forall r. (Members '[Files, Error JuvixError] r) => Prelude.Path Abs File -> Sem r (Term Natural)
 cueJammedFile fp = do
   bs <- readFileBS' fp
   case Cue.cueFromByteString'' @Natural bs of
-    Left _ -> error "nock natural error"
-    Right (Left _) -> error "cue decoding error"
+    Left e -> natErr e
+    Right (Left e) -> decodingErr e
     Right (Right t) -> return t
+  where
+    err :: AnsiText -> Sem r x
+    err msg =
+      throw $
+        JuvixError
+          GenericError
+            { _genericErrorLoc = i,
+              _genericErrorIntervals = [i],
+              _genericErrorMessage = msg
+            }
+
+    decodingErr :: Cue.DecodingError -> Sem r x
+    decodingErr e = err (mkAnsiText (ppCodeAnn e))
+
+    natErr :: NockNaturalNaturalError -> Sem r x
+    natErr e = err (mkAnsiText (ppCodeAnn e))
+
+    i :: Interval
+    i = mkInterval loc loc
+      where
+        loc :: Loc
+        loc = mkInitialLoc fp
 
 parseTermFile :: (MonadIO m) => Prelude.Path Abs File -> m (Either MegaparsecError (Term Natural))
 parseTermFile fp = do