Error on duplicate keys in YAML

package.yaml

@@ -49,6 +49,7 @@ dependencies:
   - gitrev == 1.3.*
   - hashable == 1.4.*
   - language-c == 0.9.*
+  - libyaml == 0.1.*
   - megaparsec == 9.2.*
   - microlens-platform == 0.4.*
   - parser-combinators == 1.3.*

src/Juvix/Compiler/Concrete/Translation/FromSource.hs

@@ -10,7 +10,6 @@ import Data.ByteString.UTF8 qualified as BS
 import Data.List.NonEmpty.Extra qualified as NonEmpty
 import Data.Singletons
 import Data.Text qualified as Text
-import Data.Yaml
 import Juvix.Compiler.Concrete.Data.Highlight.Input (HighlightBuilder, ignoreHighlightBuilder)
 import Juvix.Compiler.Concrete.Data.ParsedInfoTable
 import Juvix.Compiler.Concrete.Data.ParsedInfoTableBuilder
@@ -23,6 +22,7 @@ import Juvix.Compiler.Concrete.Translation.FromSource.Lexer hiding
   ( symbol,
   )
 import Juvix.Compiler.Pipeline.EntryPoint
+import Juvix.Data.Yaml
 import Juvix.Extra.Paths
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Parser.Error
@@ -341,7 +341,7 @@ parseYaml l r = do
             | otherwise -> '{' : str ++ "}"
   space
   let bs = BS.fromString str'
-  case decodeEither' bs of
+  case decodeEither bs of
     Left err -> parseFailure off (prettyPrintParseException err)
     Right yaml -> return $ WithSource (fromString str) yaml
 

src/Juvix/Data/Yaml.hs

@@ -5,18 +5,38 @@ module Juvix.Data.Yaml
   )
 where
 
-import Data.Aeson.BetterErrors hiding ((<|>))
-import Data.Yaml (FromJSON (..))
+import Data.Aeson.BetterErrors hiding (mapError, (<|>))
+import Data.Aeson.Internal (formatError)
+import Data.Yaml (FromJSON (..), ParseException (..), prettyPrintParseException)
+import Data.Yaml.Internal (Warning (..), decodeHelper)
+import GHC.IO (unsafePerformIO)
 import Juvix.Prelude.Base
+import Text.Libyaml qualified as Y
 
 type YamlError = Text
 
 -- | Check that all keys are in the given list.
-checkYamlKeys :: [Text] -> Parse Text ()
+checkYamlKeys :: [Text] -> Parse YamlError ()
 checkYamlKeys keys = do
   forEachInObject
     ( \k ->
         unless (k `elem` keys) $
           throwCustomError ("unknown key: " <> k)
     )
   return ()
+
+decodeEither :: FromJSON a => ByteString -> Either ParseException a
+decodeEither =
+  either Left splitEither
+    . unsafePerformIO
+    . decodeHelper
+    . Y.decode
+  where
+    splitEither :: ([Warning], Either String a) -> Either ParseException a
+    splitEither (_, Left s) = Left (AesonException s)
+    splitEither (w : _, Right _) = Left (AesonException (prettyPrintWarning w))
+    splitEither ([], Right x) = Right x
+
+prettyPrintWarning :: Warning -> String
+prettyPrintWarning = \case
+  DuplicateKey a -> formatError a "duplicate key"

test/Parsing/Negative.hs

@@ -71,6 +71,13 @@ parserErrorTests =
       "Pragmas format error"
       $(mkRelDir ".")
       $(mkRelFile "PragmasFormat.juvix")
+      $ \case
+        ErrMegaparsec {} -> Nothing
+        _ -> wrongError,
+    negTest
+      "Pragmas duplicate keys error"
+      $(mkRelDir ".")
+      $(mkRelFile "PragmasDuplicateKeys.juvix")
       $ \case
         ErrMegaparsec {} -> Nothing
         _ -> wrongError

tests/negative/PragmasDuplicateKeys.juvix

@@ -0,0 +1,6 @@
+module PragmasDuplicateKeys;
+
+type Bool := true | false;
+
+{-# inline: true, inline: false #-}
+main : Bool := true;