[WIP] Parser19

elm-format.cabal

@@ -76,7 +76,6 @@ library
         Parse.Type
         Reporting.Annotation
         Reporting.Error.Syntax
-        Reporting.Region
         Util.List
 
     other-modules:
@@ -90,6 +89,8 @@ library
         Cheapskate.Types
         Cheapskate.Util
         CommandLine.Helpers
+        Data.Index
+        Elm.Name
         ElmFormat.Execute
         ElmFormat.Filesystem
         ElmFormat.FileStore
@@ -112,8 +113,15 @@ library
         Parse.Declaration
         Parse.Module
         Parse.Parse
-        Parse.State
+        Parse.ParsecAdapter
+        Parse.Primitives
+        Parse.Primitives.Internals
+        Parse.Primitives.Symbol
+        Parse.Primitives.Variable
+        Parse.Primitives.Whitespace
         Parse.Whitespace
+        Reporting.Doc
+        Reporting.Render.Code
         Reporting.Report
         Reporting.Result
         ReversedList
@@ -128,11 +136,9 @@ library
         directory >= 1.3.3.0 && < 2,
         filepath >= 1.4.2.1 && < 2,
         free >= 5.1.1 && < 6,
-        indents >= 0.3.3 && < 0.4,
         json >= 0.9.3 && < 0.10,
         mtl >= 2.2.2 && < 3,
         optparse-applicative >= 0.14.3.0 && < 0.15,
-        parsec >= 3.1.13.0 && < 4,
         process >= 1.6.5.0 && < 2,
         split >= 0.2.3.3 && < 0.3,
         text >= 1.2.3.1 && < 2
@@ -198,7 +204,6 @@ test-Suite elm-format-tests
         cmark >= 0.5.6.3 && < 0.6,
         containers >= 0.6.0.1 && < 0.7,
         mtl >= 2.2.2 && < 3,
-        parsec >= 3.1.13.0 && < 4,
         split >= 0.2.3.3 && < 0.3,
         text >= 1.2.3.1 && < 2,
         elm-format

parser/src/AST/Declaration.hs

@@ -35,7 +35,7 @@ instance A.Strippable Declaration where
   stripRegion d =
     case d of
         Definition a b c e ->
-            Definition (A.stripRegion a) b c (A.stripRegion $ A.map A.stripRegion e)
+            Definition (A.stripRegion a) b c (A.stripRegion $ fmap A.stripRegion e)
         _ -> d
 
 -- INFIX STUFF
@@ -66,5 +66,5 @@ instance A.Strippable a => A.Strippable (TopLevelStructure a) where
   stripRegion d =
     case d of
         Entry d' ->
-            Entry $ A.stripRegion $ A.map A.stripRegion d'
+            Entry $ A.stripRegion $ fmap A.stripRegion d'
         _ -> d

parser/src/AST/Expression.hs

@@ -73,13 +73,13 @@ instance A.Strippable Expr' where
     case d of
       App e0 es b ->
         App
-          (A.stripRegion $ A.map A.stripRegion e0)
-          (map (fmap (A.stripRegion . A.map A.stripRegion)) es)
+          (A.stripRegion $ fmap A.stripRegion e0)
+          (map (fmap (A.stripRegion . fmap A.stripRegion)) es)
           b
 
       Tuple es b ->
         Tuple
-          (map (fmap (A.stripRegion . A.map A.stripRegion)) es)
+          (map (fmap (A.stripRegion . fmap A.stripRegion)) es)
           b
 
       _ -> d

parser/src/AST/Json.hs

@@ -15,7 +15,6 @@ import Text.JSON hiding (showJSON)
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
 import qualified ElmFormat.Version
-import qualified Reporting.Region as Region
 
 
 pleaseReport :: String -> String -> a
@@ -63,19 +62,19 @@ class ToJSON a where
   showJSON :: a -> JSValue
 
 
-instance ToJSON Region.Region where
-    showJSON region =
+instance ToJSON Region where
+    showJSON (Region start end) =
         makeObj
-            [ ( "start", showJSON $ Region.start region )
-            , ( "end", showJSON $ Region.end region )
+            [ ( "start", showJSON start )
+            , ( "end", showJSON end )
             ]
 
 
-instance ToJSON Region.Position where
-    showJSON pos =
+instance ToJSON Position where
+    showJSON (Position line column) =
         makeObj
-            [ ( "line", JSRational False $ toRational $ Region.line pos )
-            , ( "col", JSRational False $ toRational $ Region.column pos )
+            [ ( "line", JSRational False $ toRational line )
+            , ( "col", JSRational False $ toRational column )
             ]
 
 
@@ -105,7 +104,7 @@ instance ToJSON DetailedListing where
 
 
 instance ToJSON (TopLevelStructure Declaration) where
-  showJSON (Entry (A region (Definition (A _ (VarPattern (LowercaseIdentifier var))) _ _ expr))) =
+  showJSON (Entry (At region (Definition (At _ (VarPattern (LowercaseIdentifier var))) _ _ expr))) =
     makeObj
       [ type_ "Definition"
       , ("name" , JSString $ toJSString var)
@@ -116,7 +115,7 @@ instance ToJSON (TopLevelStructure Declaration) where
 
 
 instance ToJSON Expr where
-  showJSON (A region expr) =
+  showJSON (At region expr) =
       case expr of
           Unit _ ->
               makeObj [ type_ "UnitLiteral" ]
@@ -261,7 +260,7 @@ instance ToJSON Expr where
           Lambda parameters _ body _ ->
               makeObj
                   [ type_ "AnonymousFunction"
-                  , ("parameters", JSArray $ map (\(_, A _ pat) -> showJSON pat) parameters)
+                  , ("parameters", JSArray $ map (\(_, At _ pat) -> showJSON pat) parameters)
                   , ("body", showJSON body)
                   ]
 
@@ -298,7 +297,7 @@ instance ToJSON Expr where
                   , ( "subject", showJSON subject )
                   , ( "branches"
                     , JSArray $ map
-                        (\(Commented _ (A _ pat) _, (_, body)) ->
+                        (\(Commented _ (At _ pat) _, (_, body)) ->
                            makeObj
                                [ ("pattern", showJSON pat)
                                , ("body", showJSON body)
@@ -312,7 +311,7 @@ instance ToJSON Expr where
               JSString $ toJSString "TODO: Expr"
 
 
-variableReference :: Region.Region -> String -> JSValue
+variableReference :: Region -> String -> JSValue
 variableReference region name =
     makeObj
         [ type_ "VariableReference"
@@ -321,15 +320,15 @@ variableReference region name =
         ]
 
 
-sourceLocation :: Region.Region -> (String, JSValue)
+sourceLocation :: Region -> (String, JSValue)
 sourceLocation region =
     ( "sourceLocation", showJSON region )
 
 
 instance ToJSON LetDeclaration where
   showJSON letDeclaration =
       case letDeclaration of
-          LetDefinition (A _ (VarPattern (LowercaseIdentifier var))) [] _ expr ->
+          LetDefinition (At _ (VarPattern (LowercaseIdentifier var))) [] _ expr ->
               makeObj
                   [ type_ "Definition"
                   , ("name" , JSString $ toJSString var)
@@ -355,11 +354,6 @@ type_ t =
     ("type", JSString $ toJSString t)
 
 
-nowhere :: Region.Position
-nowhere =
-    Region.Position 0 0
-
-
 noRegion :: a -> Located a
 noRegion =
-    at nowhere nowhere
+    At zero

parser/src/Data/Index.hs

@@ -0,0 +1,132 @@
+module Data.Index
+  ( ZeroBased
+  , first
+  , second
+  , third
+  , next
+  , toMachine
+  , toHuman
+  , indexedMap
+  , indexedTraverse
+  , indexedForA
+  , VerifiedList(..)
+  , indexedZipWith
+  , indexedZipWithA
+  )
+  where
+
+
+import Control.Monad (liftM)
+import Data.Binary
+
+
+
+-- ZERO BASED
+
+
+newtype ZeroBased = ZeroBased Int
+  deriving (Eq, Ord)
+
+
+first :: ZeroBased
+first =
+  ZeroBased 0
+
+
+second :: ZeroBased
+second =
+  ZeroBased 1
+
+
+third :: ZeroBased
+third =
+  ZeroBased 2
+
+
+{-# INLINE next #-}
+next :: ZeroBased -> ZeroBased
+next (ZeroBased i) =
+  ZeroBased (i + 1)
+
+
+
+-- DESTRUCT
+
+
+toMachine :: ZeroBased -> Int
+toMachine (ZeroBased index) =
+  index
+
+
+toHuman :: ZeroBased -> Int
+toHuman (ZeroBased index) =
+  index + 1
+
+
+
+-- INDEXED MAP
+
+
+{-# INLINE indexedMap #-}
+indexedMap :: (ZeroBased -> a -> b) -> [a] -> [b]
+indexedMap func xs =
+  zipWith func (map ZeroBased [0 .. length xs]) xs
+
+
+{-# INLINE indexedTraverse #-}
+indexedTraverse :: (Applicative f) => (ZeroBased -> a -> f b) -> [a] -> f [b]
+indexedTraverse func xs =
+  sequenceA (indexedMap func xs)
+
+
+{-# INLINE indexedForA #-}
+indexedForA :: (Applicative f) => [a] -> (ZeroBased -> a -> f b) -> f [b]
+indexedForA xs func =
+  sequenceA (indexedMap func xs)
+
+
+
+-- VERIFIED/INDEXED ZIP
+
+
+data VerifiedList a
+  = LengthMatch [a]
+  | LengthMismatch Int Int
+
+
+indexedZipWith :: (ZeroBased -> a -> b -> c) -> [a] -> [b] -> VerifiedList c
+indexedZipWith func listX listY =
+  indexedZipWithHelp func 0 listX listY []
+
+
+indexedZipWithHelp :: (ZeroBased -> a -> b -> c) -> Int -> [a] -> [b] -> [c] -> VerifiedList c
+indexedZipWithHelp func index listX listY revListZ =
+  case (listX, listY) of
+    ([], []) ->
+      LengthMatch (reverse revListZ)
+
+    (x:xs, y:ys) ->
+      indexedZipWithHelp func (index + 1) xs ys $
+        func (ZeroBased index) x y : revListZ
+
+    (_, _) ->
+      LengthMismatch (index + length listX) (index + length listY)
+
+
+indexedZipWithA :: (Applicative f) => (ZeroBased -> a -> b -> f c) -> [a] -> [b] -> f (VerifiedList c)
+indexedZipWithA func listX listY =
+  case indexedZipWith func listX listY of
+    LengthMatch xs ->
+      LengthMatch <$> sequenceA xs
+
+    LengthMismatch x y ->
+      pure (LengthMismatch x y)
+
+
+
+-- BINARY
+
+
+instance Binary ZeroBased where
+  get = liftM ZeroBased get
+  put (ZeroBased n) = put n