Misc refactors to the Elm compiler's parser integration code

elm-format-lib/elm-format-lib.cabal

@@ -63,7 +63,6 @@ common common-options
         Parse.Number
         Parse.Parse
         Parse.ParsecAdapter
-        Parse.ParsecAdapter.Message
         Parse.Pattern
         Parse.Primitives
         Parse.State
@@ -117,9 +116,7 @@ library
         ElmVersion
         Parse.Markdown
         Reporting.Annotation
-        Reporting.Annotation.New
         Reporting.Error.Syntax
-        Reporting.Region
         Reporting.Result
 
 
@@ -147,9 +144,7 @@ test-suite efl-tests
         ElmVersion
         Parse.Markdown
         Reporting.Annotation
-        Reporting.Annotation.New
         Reporting.Error.Syntax
-        Reporting.Region
         Reporting.Result
 
     other-modules:

elm-format-lib/src/ElmFormat/AST/PatternMatching.hs

@@ -5,7 +5,7 @@ module ElmFormat.AST.PatternMatching where
 import ElmFormat.AST.Shared
 import AST.V0_16
 import AST.Structure
-import Reporting.Annotation (Located(A))
+import Reporting.Annotation (Located(At))
 import Data.Indexed as I
 
 
@@ -23,12 +23,12 @@ matchType ::
        , ASTNS Located ns 'TypeNK
        )
 matchType [] typ = ( [], typ )
-matchType (pat : restPat) (I.Fix (A region (FunctionType (C eol typ) restTyp multiline))) =
+matchType (pat : restPat) (I.Fix (At region (FunctionType (C eol typ) restTyp multiline))) =
     let
         nextTyp =
             case toCommentedList restTyp of
                 [ (C _ single) ] -> single
-                ( (C (_, _, eol2) first) : rest ) -> I.Fix $ A region $ FunctionType (C eol2 first) (Sequence rest) multiline
+                ( (C (_, _, eol2) first) : rest ) -> I.Fix $ At region $ FunctionType (C eol2 first) (Sequence rest) multiline
 
         ( pats, retType ) =
             matchType restPat nextTyp

elm-format-lib/src/ElmFormat/AST/PublicAST/Core.hs

@@ -13,7 +13,6 @@ module ElmFormat.AST.PublicAST.Core
     , module AST.V0_16
     , module AST.Structure
     , module Reporting.Annotation
-    , module Reporting.Region
     , module Data.Coapplicative
     , module ElmFormat.AST.PublicAST.MaybeF
     , module ElmFormat.AST.PublicAST.Config
@@ -39,10 +38,8 @@ import qualified AST.V0_16 as AST
 import qualified AST.Module as AST
 import qualified AST.Listing as AST
 import Data.Indexed as I
-import Reporting.Annotation (Located(A))
-import qualified Reporting.Annotation
-import Reporting.Region (Region)
-import qualified Reporting.Region as Region
+import Reporting.Annotation (Located, Region, Position)
+import qualified Reporting.Annotation as A
 import Data.Coapplicative
 import qualified Data.List as List
 import qualified Data.Text as Text
@@ -189,25 +186,25 @@ instance (FromJSON a) => FromJSON (LocatedIfRequested a) where
 
 instance ToPairs a => ToJSON (Located a) where
     toJSON = undefined
-    toEncoding (A region a) =
+    toEncoding (A.At region a) =
         pairs (toPairs a <> "sourceLocation" .= region)
 
 
 instance ToJSON Region where
     toJSON = undefined
-    toEncoding region =
+    toEncoding (A.Region start end) =
         pairs $ mconcat
-            [ "start" .= Region.start region
-            , "end" .= Region.end region
+            [ "start" .= start
+            , "end" .= end
             ]
 
 
-instance ToJSON Region.Position where
+instance ToJSON A.Position where
     toJSON = undefined
-    toEncoding pos =
+    toEncoding (A.Position row col) =
         pairs $ mconcat
-            [ "line" .= Region.line pos
-            , "col" .= Region.column pos
+            [ "line" .= row
+            , "col" .= col
             ]
 
 
@@ -482,11 +479,11 @@ instance (FromJSON (f a)) => FromJSON (MaybeF f a) where
 --
 
 
-nowhere :: Region.Position
+nowhere :: A.Position
 nowhere =
-    Region.Position 0 0
+    A.Position 0 0
 
 
-noRegion :: a -> Reporting.Annotation.Located a
+noRegion :: a -> Located a
 noRegion =
-    Reporting.Annotation.at nowhere nowhere
+    A.at nowhere nowhere

elm-format-lib/src/ElmFormat/AST/PublicAST/Expression.hs

@@ -17,6 +17,7 @@ import qualified Data.Maybe as Maybe
 import ElmFormat.AST.PublicAST.Pattern
 import ElmFormat.AST.PublicAST.Type
 import ElmFormat.AST.PublicAST.Comment
+import Reporting.Annotation (Located(At))
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Text (Text)
 import qualified Data.Either as Either
@@ -49,7 +50,7 @@ mkLetDeclarations config decls =
     let
         toDefBuilder :: ASTNS1 Located [UppercaseIdentifier] 'LetDeclarationNK -> DefinitionBuilder LetDeclaration
         toDefBuilder = \case
-            AST.LetCommonDeclaration (I.Fix (A _ def)) ->
+            AST.LetCommonDeclaration (I.Fix (At _ def)) ->
                 Right def
 
             AST.LetComment comment ->
@@ -716,7 +717,7 @@ mkDefinitions config fromDef items =
         merge :: DefinitionBuilder a -> Maybe a
         merge decl =
             case decl of
-                Right (AST.Definition (I.Fix (A _ pat)) args comments expr) ->
+                Right (AST.Definition (I.Fix (At _ pat)) args comments expr) ->
                     let
                         annotation =
                             case pat of

elm-format-lib/src/ElmFormat/AST/PublicAST/Module.hs

@@ -8,6 +8,7 @@ import ElmFormat.AST.PublicAST.Core
 import ElmFormat.AST.PublicAST.Comment
 import ElmFormat.AST.PublicAST.Expression
 import ElmFormat.AST.PublicAST.Type
+import Reporting.Annotation (Located(At))
 import qualified AST.V0_16 as AST
 import qualified AST.Module as AST
 import qualified AST.Listing as AST
@@ -140,16 +141,16 @@ data TopLevelStructure
     | TODO_TopLevelStructure String
 
 fromTopLevelStructures :: Config -> ASTNS Located [UppercaseIdentifier] 'TopLevelNK -> List (MaybeF LocatedIfRequested TopLevelStructure)
-fromTopLevelStructures config (I.Fix (A _ (AST.TopLevel decls))) =
+fromTopLevelStructures config (I.Fix (At _ (AST.TopLevel decls))) =
     let
         toDefBuilder :: AST.TopLevelStructure
                      (ASTNS Located [UppercaseIdentifier] 'TopLevelDeclarationNK) -> MaybeF LocatedIfRequested (DefinitionBuilder TopLevelStructure)
         toDefBuilder decl =
             case fmap I.unFix decl of
-                AST.Entry (A region entry) ->
-                    JustF $ fromLocated config $ A region $
+                AST.Entry (At region entry) ->
+                    JustF $ fromLocated config $ At region $
                     case entry of
-                        AST.CommonDeclaration (I.Fix (A _ def)) ->
+                        AST.CommonDeclaration (I.Fix (At _ def)) ->
                             Right def
 
                         AST.TypeAlias c1 (C (c2, c3) (AST.NameWithArgs name args)) (C c4 t) ->

elm-format-lib/src/ElmFormat/Render/Box.hs

@@ -38,8 +38,7 @@ import qualified ElmFormat.Render.ElmStructure as ElmStructure
 import qualified ElmFormat.Render.Markdown
 import qualified ElmVersion
 import qualified Parse.Parse as Parse
-import qualified Reporting.Annotation as RA
-import qualified Reporting.Region as Region
+import qualified Reporting.Annotation as A
 import qualified Reporting.Result as Result
 import Text.Printf (printf)
 
@@ -1715,14 +1714,14 @@ formatRange_0_17 elmVersion importInfo left right multiline =
                 , line $ punc "]"
                 ]
 
-nowhere :: Region.Position
+nowhere :: A.Position
 nowhere =
-    Region.Position 0 0
+    A.Position 0 0
 
 
-noRegion :: a -> RA.Located a
+noRegion :: a -> A.Located a
 noRegion =
-    RA.at nowhere nowhere
+    A.at nowhere nowhere
 
 formatRange_0_18 ::
     Coapplicative annf =>

elm-format-lib/src/Parse/Expression.hs

@@ -7,7 +7,7 @@ import Data.Coapplicative
 import qualified Data.Indexed as I
 import Data.Maybe (fromMaybe)
 
-import Parse.ParsecAdapter hiding (newline, spaces)
+import Parse.ParsecAdapter
 import qualified Parse.Binop as Binop
 import Parse.Helpers
 import Parse.Common
@@ -157,10 +157,10 @@ head' (a:_) = Just a
 appExpr :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'ExpressionNK)
 appExpr elmVersion =
   expecting "an expression" $
-  do  start <- getMyPosition
+  do  start <- getPosition
       (t, initialTermMultiline) <- trackNewline (term elmVersion)
       ts <- constrainedSpacePrefix (term elmVersion)
-      end <- getMyPosition
+      end <- getPosition
       return $
           case ts of
             [] ->
@@ -291,13 +291,13 @@ letExpr :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'Expressio
 letExpr elmVersion =
   fmap I.Fix $ addLocation $
   do  try (reserved elmVersion "let")
-      A.A cal commentsAfterLet' <- addLocation whitespace
-      let commentsAfterLet = fmap (I.Fix . A.A cal . LetComment) commentsAfterLet'
+      A.At cal commentsAfterLet' <- addLocation whitespace
+      let commentsAfterLet = fmap (I.Fix . A.At cal . LetComment) commentsAfterLet'
       defs <-
         block $
           do  def <- fmap I.Fix $ addLocation $ fmap (LetCommonDeclaration . I.Fix) $ addLocation (typeAnnotation elmVersion TypeAnnotation <|> definition elmVersion Definition)
-              A.A cad commentsAfterDef' <- addLocation whitespace
-              let commentsAfterDef = fmap (I.Fix . A.A cad . LetComment) commentsAfterDef'
+              A.At cad commentsAfterDef' <- addLocation whitespace
+              let commentsAfterDef = fmap (I.Fix . A.At cad . LetComment) commentsAfterDef'
               return (def : commentsAfterDef)
       _ <- reserved elmVersion "in"
       bodyComments <- whitespace

elm-format-lib/src/Parse/Helpers.hs

@@ -16,10 +16,10 @@ import qualified Parse.State as State
 import Parse.Comments
 import Parse.IParser
 import Parse.Whitespace
-import qualified Parse.Primitives as EP
+import qualified Parse.Primitives as P
+import qualified Parse.ParsecAdapter as Parsec
 import qualified Reporting.Annotation as A
 import qualified Reporting.Error.Syntax as Syntax
-import qualified Reporting.Region as R
 
 
 reserveds :: [String]
@@ -42,14 +42,14 @@ expecting = flip (<?>)
 
 -- SETUP
 
-iParse :: IParser a -> String -> Either ParseError a
+iParse :: IParser a -> String -> Either ParsecError a
 iParse =
-    iParseWithState "" State.init
+    iParseWithState State.init
 
 
-iParseWithState :: SourceName -> State.State -> IParser a -> String -> Either ParseError a
-iParseWithState sourceName state aParser input =
-  runIndent sourceName $ runParserT aParser state sourceName input
+iParseWithState :: State.State -> IParser a -> String -> Either ParsecError a
+iParseWithState state aParser input =
+  runIndent $ runParserT aParser state input
 
 
 -- VARIABLES
@@ -98,7 +98,7 @@ makeVar :: ElmVersion -> IParser Char -> IParser String
 makeVar elmVersion firstChar =
   do  variable <- (:) <$> firstChar <*> many (innerVarChar elmVersion)
       if variable `elem` reserveds
-        then fail (Syntax.keyword variable)
+        then parserFail $ parseError (Message (Syntax.keyword variable))
         else return variable
 
 
@@ -290,11 +290,11 @@ keyValue parseSep parseKey parseVal =
       )
 
 
-separated :: IParser sep -> IParser e -> IParser (Either e (R.Region, C0Eol e, Sequence e, Bool))
+separated :: IParser sep -> IParser e -> IParser (Either e (A.Region, C0Eol e, Sequence e, Bool))
 separated sep expr' =
   let
     subparser =
-      do  start <- getMyPosition
+      do  start <- Parsec.getPosition
           t1 <- expr'
           arrow <- optionMaybe $ try ((,) <$> restOfLine <*> whitespace <* sep)
           case arrow of
@@ -303,11 +303,11 @@ separated sep expr' =
             Just (eolT1, preArrow) ->
                 do  postArrow <- whitespace
                     t2 <- separated sep expr'
-                    end <- getMyPosition
+                    end <- Parsec.getPosition
                     case t2 of
                         Right (_, C eolT2 t2', Sequence ts, _) ->
                           return $ \multiline -> Right
-                            ( R.Region start end
+                            ( A.Region start end
                             , C eolT1 t1
                             , Sequence (C (preArrow, postArrow, eolT2) t2' : ts)
                             , multiline
@@ -316,7 +316,7 @@ separated sep expr' =
                           do
                             eol <- restOfLine
                             return $ \multiline -> Right
-                              ( R.Region start end
+                              ( A.Region start end
                               , C eolT1 t1
                               , Sequence [ C (preArrow, postArrow, eol) t2' ]
                               , multiline)
@@ -459,28 +459,23 @@ surround'' leftDelim rightDelim inner =
 
 -- HELPERS FOR EXPRESSIONS
 
-getMyPosition :: IParser R.Position
-getMyPosition =
-  R.fromSourcePos <$> getPosition
-
-
 addLocation :: IParser a -> IParser (A.Located a)
 addLocation expr =
   do  (start, e, end) <- located expr
       return (A.at start end e)
 
 
-located :: IParser a -> IParser (R.Position, a, R.Position)
+located :: IParser a -> IParser (A.Position, a, A.Position)
 located parser =
-  do  start <- getMyPosition
+  do  start <- Parsec.getPosition
       value <- parser
-      end <- getMyPosition
+      end <- Parsec.getPosition
       return (start, value, end)
 
 
 accessible :: ElmVersion -> IParser (FixAST A.Located typeRef ctorRef varRef 'ExpressionNK) -> IParser (FixAST A.Located typeRef ctorRef varRef 'ExpressionNK)
 accessible elmVersion exprParser =
-  do  start <- getMyPosition
+  do  start <- Parsec.getPosition
       rootExpr <- exprParser
       access <- optionMaybe (try dot <?> "a field access like .name")
 
@@ -491,7 +486,7 @@ accessible elmVersion exprParser =
         Just _ ->
           accessible elmVersion $
             do  v <- lowVar elmVersion
-                end <- getMyPosition
+                end <- Parsec.getPosition
                 return $ I.Fix $ A.at start end $ Access rootExpr v
 
 
@@ -516,9 +511,9 @@ commentedKeyword elmVersion word parser =
 -- continuation is called instead of the empty continuation.
 failure :: String -> IParser String
 failure msg =
-  EP.Parser $ \s _ _ cerr _ ->
+  P.Parser $ \s _ _ cerr _ ->
     let
-      (EP.Parser p) = fail msg
+      (P.Parser p) = parserFail $ parseError (Message msg)
     in
     -- This looks really unsound, but `p` which was created with `fail` will
     -- only ever call the empty error continuation (which in this case
@@ -570,4 +565,4 @@ processAs processor s =
   where
     calloutParser :: String -> IParser a -> IParser a
     calloutParser inp p =
-      either (fail . show) return (iParse p inp)
+      either (parserFail . const . const) return (iParse p inp)

elm-format-lib/src/Parse/IParser.hs

@@ -1,7 +1,7 @@
 module Parse.IParser where
 
 import Parse.Primitives (Parser)
-import Parse.ParsecAdapter (ParseError)
+import Reporting.Error.Syntax (ParsecError)
 
 
-type IParser a = Parser ParseError a
+type IParser a = Parser ParsecError a