Merge pull request #4 from juspay/fix/loader-error

Take care of all parser errors in loader error

CHANGELOG.md

@@ -1,5 +1,6 @@
 # Dev
 
+- Export ``ParserError``, and have the loader return it on parsing errors.
 - Remove -O2 optimization flag for test-suite.
 
 # 1.0.0

src/Data/Medea.hs

@@ -48,6 +48,7 @@ module Data.Medea
   ( -- * Schema loading
     Schema,
     LoaderError (..),
+    ParseError (..),
     buildSchema,
     loadSchemaFromFile,
     loadSchemaFromHandle,
@@ -93,6 +94,7 @@ import Data.Medea.Loader
     loadSchemaFromHandle,
   )
 import Data.Medea.Parser.Primitive (Identifier (..), ReservedIdentifier (..), identFromReserved)
+import Data.Medea.Parser.Types (ParseError(..))
 import Data.Medea.Schema (Schema (..))
 import Data.Medea.ValidJSON (ValidJSONF (..))
 import qualified Data.Set as S

src/Data/Medea/Loader.hs

@@ -12,32 +12,27 @@ where
 import Control.Monad.Except (MonadError (..), runExcept)
 import Control.Monad.IO.Class (MonadIO (..))
 import Data.ByteString (ByteString, hGetContents, readFile)
-import qualified Data.List.NonEmpty as NE
 import Data.Medea.Analysis
   ( AnalysisError (..),
     compileSchemata,
   )
 import Data.Medea.Parser.Primitive (toText, unwrap)
 import qualified Data.Medea.Parser.Spec.Schemata as Schemata
+import Data.Medea.Parser.Types (ParseError)
 import Data.Medea.Schema (Schema (..))
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8')
-import Data.Void (Void)
 import System.IO (Handle)
-import Text.Megaparsec (ParseError (..), bundleErrors, parse)
+import Text.Megaparsec (ParseErrorBundle, parse)
 import Prelude hiding (readFile)
 
 -- | Possible errors from loading Medea schemata.
 data LoaderError
   = -- | The data provided wasn't UTF-8.
     NotUtf8
-  | -- | An identifier was longer than allowed.
-    IdentifierTooLong
-  | -- | A length specification had no minimum/maximum specification.
-    EmptyLengthSpec
   | -- | Parsing failed.
-    ParserError 
-      !(ParseError Text Void) -- ^ The error we got. 
+    ParsingFailed
+      !(ParseErrorBundle Text ParseError) -- ^ The errors we got. 
   | -- | No schema labelled @$start@ was provided.
     StartSchemaMissing
   | -- | A schema was typed in terms of itself.
@@ -136,11 +131,7 @@ fromUtf8 ::
   m Schemata.Specification
 fromUtf8 sourceName utf8 =
   case parse Schemata.parseSpecification sourceName utf8 of
-    Left err -> case NE.head . bundleErrors $ err of
-      TrivialError o u e ->
-        throwError . ParserError . TrivialError o u $ e
-      -- TODO: Handle all kinds of ParseError
-      FancyError {} -> throwError IdentifierTooLong
+    Left err -> throwError . ParsingFailed $ err
     Right scm -> pure scm
 
 analyze ::

src/Data/Medea/Parser/Types.hs

@@ -5,14 +5,22 @@ module Data.Medea.Parser.Types (MedeaParser, ParseError (..)) where
 import Data.Text (Text)
 import Text.Megaparsec (Parsec, ShowErrorComponent, showErrorComponent)
 
+-- | All possible errors from the Medea parser.
 data ParseError
-  = IdentifierTooLong {-# UNPACK #-} !Text
-  | ExpectedReservedIdentifier {-# UNPACK #-} !Text
-  | LeadingZero {-# UNPACK #-} !Text
-  | ConflictingSpecRequirements
-  | EmptyLengthArraySpec
-  | EmptyArrayElements
-  | EmptyStringValuesSpec
+  = -- | An identifier exceeded 32 bytes.
+    IdentifierTooLong {-# UNPACK #-} !Text
+  | -- | We saw a non-reserved identifier where we wanted a reserved one.
+    ExpectedReservedIdentifier {-# UNPACK #-} !Text
+  | -- | A Medea natural number had literal zeroes.
+    LeadingZero {-# UNPACK #-} !Text
+  | -- | We were given incompatible requirements within a specification.
+    ConflictingSpecRequirements
+  | -- | We were not given a length in an array specification.
+    EmptyLengthArraySpec
+  | -- | We were not given an element specification in an array specification.
+    EmptyArrayElements
+  | -- | We were given no string values in a string specification.
+    EmptyStringValuesSpec
   deriving stock (Eq, Ord, Show)
 
 instance ShowErrorComponent ParseError where

test/TestM.hs

@@ -25,8 +25,7 @@ runTestM (TestM comp) = runExceptT comp
 
 isParseError :: Either LoaderError a -> Bool
 isParseError (Left NotUtf8) = True
-isParseError (Left IdentifierTooLong) = True
-isParseError (Left (ParserError _)) = True
+isParseError (Left (ParsingFailed _)) = True
 isParseError _ = False
 
 isSchemaError :: Either LoaderError a -> Bool