JSON AST: distinguish paramers from return type in top-level definitions

parser/src/AST/Declaration.hs

@@ -62,6 +62,12 @@ data TopLevelStructure a
     deriving (Eq, Show)
 
 
+instance Functor TopLevelStructure where
+    fmap f (Entry a) = Entry (fmap f a)
+    fmap _ (DocComment blocks) = DocComment blocks
+    fmap _ (BodyComment comment) = BodyComment comment
+
+
 instance A.Strippable a => A.Strippable (TopLevelStructure a) where
   stripRegion d =
     case d of

parser/src/AST/Json.hs

@@ -20,6 +20,8 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Maybe as Maybe
 import qualified ElmFormat.Version
 import qualified Reporting.Region as Region
+import qualified ReversedList
+import ReversedList (Reversed)
 
 
 pleaseReport :: String -> String -> a
@@ -138,7 +140,12 @@ instance ToJSON Region.Position where
 
 
 instance ToJSON (List UppercaseIdentifier) where
-    showJSON = JSString . toJSString . List.intercalate "." . fmap (\(UppercaseIdentifier v) -> v)
+    showJSON [] = JSNull
+    showJSON namespace = (JSString . toJSString . List.intercalate "." . fmap (\(UppercaseIdentifier v) -> v)) namespace
+
+
+instance ToJSON UppercaseIdentifier where
+    showJSON (UppercaseIdentifier name) = JSString $ toJSString name
 
 
 showImportListingJSON :: Listing DetailedListing -> JSValue
@@ -295,7 +302,7 @@ instance ToJSON Expr where
           ExplicitList terms _ _ ->
               makeObj
                   [ type_ "ListLiteral"
-                  , ("terms", JSArray $ fmap showJSON (map (\(_, (_, (term, _))) -> term) terms))
+                  , ("terms", JSArray $ fmap showJSON (map (\(_, (_, WithEol term _)) -> term) terms))
                   ]
 
           AST.Expression.Tuple exprs _ ->
@@ -315,7 +322,7 @@ instance ToJSON Expr where
                   fieldsJSON =
                       ( "fields"
                       , makeObj $ fmap
-                          (\(_, (_, (Pair (LowercaseIdentifier key, _) (_, value) _, _))) ->
+                          (\(_, (_, WithEol (Pair (LowercaseIdentifier key, _) (_, value) _) _)) ->
                              (key, showJSON value)
                           )
                           fields
@@ -325,7 +332,7 @@ instance ToJSON Expr where
                       ( "fieldOrder"
                       , JSArray $
                             fmap (JSString . toJSString) $
-                            fmap (\(_, (_, (Pair (LowercaseIdentifier key, _) _ _, _))) -> key) fields
+                            fmap (\(_, (_, WithEol (Pair (LowercaseIdentifier key, _) _ _) _)) -> key) fields
                       )
               in
               case base of
@@ -465,11 +472,11 @@ instance ToJSON Pattern' where
 instance ToJSON Type where
     showJSON (A _ type') =
         case type' of
-            TypeConstruction (NamedConstructor name) args ->
+            TypeConstruction (NamedConstructor namespace name) args ->
                 makeObj
                     [ type_ "TypeReference"
                     , ( "name", showJSON name )
-                    , ( "module", JSNull )
+                    , ( "module", showJSON namespace )
                     , ( "arguments", JSArray $ fmap (showJSON . snd) args )
                     ]
 
@@ -479,15 +486,29 @@ instance ToJSON Type where
                     , ( "name", JSString $ toJSString name )
                     ]
 
-            FunctionType (first, _) rest _ ->
-                makeObj
-                    [ type_ "FunctionType"
-                    , ( "returnType", showJSON first) -- TODO
-                    , ( "argumentTypes", JSNull )
-                    ]
+            FunctionType first rest _ ->
+                case firstRestToRestLast first rest of
+                    (args, WithEol last _) ->
+                        makeObj
+                            [ type_ "FunctionType"
+                            , ( "returnType", showJSON last)
+                            , ( "argumentTypes", JSArray $ fmap (\(WithEol t _, _, _) -> showJSON t) $ args )
+                            ]
 
             _ ->
                 JSString $ toJSString $ "TODO: Type (" ++ show type' ++ ")"
+        where
+            firstRestToRestLast :: WithEol x -> List (a, b, x, Maybe String) -> (List (WithEol x, a, b), WithEol x)
+            firstRestToRestLast first rest =
+                done $ foldl (flip step) (ReversedList.empty, first) rest
+                where
+                    step :: (a, b, x, Maybe String) -> (Reversed (WithEol x, a, b), WithEol x) -> (Reversed (WithEol x, a, b), WithEol x)
+                    step (a, b, next, dn) (acc, last) =
+                        (ReversedList.push (last, a, b) acc, WithEol next dn)
+
+                    done :: (Reversed (WithEol x, a, b), WithEol x) -> (List (WithEol x, a, b), WithEol x)
+                    done (acc, last) =
+                        (ReversedList.toList acc, last)
 
 
 type_ :: String -> (String, JSValue)

parser/src/AST/Pattern.hs

@@ -21,7 +21,7 @@ data Pattern'
     | EmptyListPattern Comments
     | List [Commented Pattern]
     | ConsPattern
-        { first :: (Pattern, Maybe String)
+        { first :: WithEol Pattern
         , rest :: [(Comments, Comments, Pattern, Maybe String)]
         }
     | EmptyRecordPattern Comments

parser/src/AST/V0_16.hs

@@ -61,7 +61,12 @@ type PreCommented a = (Comments, a)
 type PostCommented a = (a, Comments)
 
 
-type WithEol a = (a, Maybe String)
+data WithEol a = WithEol a (Maybe String)
+    deriving (Eq, Show)
+
+
+instance Functor WithEol where
+    fmap f (WithEol a eol) = WithEol (f a) eol
 
 
 {-| This represents a list of things separated by comments.
@@ -121,6 +126,12 @@ data OpenCommentedList a
     = OpenCommentedList [Commented (WithEol a)] (PreCommented (WithEol a))
     deriving (Eq, Show)
 
+
+instance Functor OpenCommentedList where
+    fmap f (OpenCommentedList rest (pre, last)) =
+        OpenCommentedList (fmap (fmap $ fmap f) rest) (pre, fmap f last)
+
+
 exposedToOpen :: Comments -> ExposedCommentedList a -> OpenCommentedList a
 exposedToOpen pre exposed =
     case exposed of
@@ -149,6 +160,11 @@ data Pair key value =
     deriving (Show, Eq)
 
 
+instance Functor (Pair key) where
+    fmap f (Pair key (pre, value) forceMultiline) =
+        Pair key (pre, f value) forceMultiline
+
+
 data Multiline
     = JoinAll
     | SplitAll
@@ -188,7 +204,7 @@ data Literal
 
 
 data TypeConstructor
-    = NamedConstructor [UppercaseIdentifier]
+    = NamedConstructor [UppercaseIdentifier] UppercaseIdentifier
     | TupleConstructor Int -- will be 2 or greater, indicating the number of elements in the tuple
     deriving (Eq, Show)
 

parser/src/Parse/Comments.hs

@@ -26,5 +26,5 @@ withEol a =
     do
         (result, multiline) <- trackNewline a
         case multiline of
-            SplitAll -> return (result, Nothing)
-            JoinAll -> (,) result <$> restOfLine
+            SplitAll -> return $ WithEol result Nothing
+            JoinAll -> WithEol result <$> restOfLine

parser/src/Parse/Helpers.hs

@@ -223,14 +223,14 @@ spaceySepBy1'' sep parser =
     do
         result <- spaceySepBy1 sep parser
         case result of
-            Single (item, eol) ->
+            Single (WithEol item eol) ->
                 return $ \pre post -> [item pre (combine eol post)]
 
-            Multiple ((first, firstEol), postFirst) rest (preLast, (last, eol)) ->
+            Multiple (WithEol first firstEol, postFirst) rest (preLast, WithEol last eol) ->
                 return $ \preFirst postLast ->
                     concat
                         [ [first preFirst $ combine firstEol postFirst]
-                        , fmap (\(Commented pre (item, eol) post) -> item pre $ combine eol post) rest
+                        , fmap (\(Commented pre (WithEol item eol) post) -> item pre $ combine eol post) rest
                         , [last preLast $ combine eol postLast ]
                         ]
 
@@ -290,7 +290,7 @@ keyValue parseSep parseKey parseVal =
       )
 
 
-separated :: IParser sep -> IParser e -> IParser (Either e (R.Region, (e,Maybe String), [(Comments, Comments, e, Maybe String)], Bool))
+separated :: IParser sep -> IParser e -> IParser (Either e (R.Region, (WithEol e), [(Comments, Comments, e, Maybe String)], Bool))
 separated sep expr' =
   let
     subparser =
@@ -305,10 +305,10 @@ separated sep expr' =
                     t2 <- separated sep expr'
                     end <- getMyPosition
                     case t2 of
-                        Right (_, (t2',eolT2), ts, _) ->
+                        Right (_, WithEol t2' eolT2, ts, _) ->
                           return $ \multiline -> Right
                             ( R.Region start end
-                            , (t1, eolT1)
+                            , WithEol t1 eolT1
                             , (preArrow, postArrow, t2', eolT2):ts
                             , multiline
                             )
@@ -317,7 +317,7 @@ separated sep expr' =
                             eol <- restOfLine
                             return $ \multiline -> Right
                               ( R.Region start end
-                              , (t1, eolT1)
+                              , WithEol t1 eolT1
                               , [(preArrow, postArrow, t2', eol)]
                               , multiline)
   in

parser/src/Parse/Type.hs

@@ -27,9 +27,9 @@ tuple elmVersion =
             return $ AST.UnitType comments
         Right [] ->
             return $ AST.UnitType []
-        Right [AST.Commented [] (t, Nothing) []] ->
+        Right [AST.Commented [] (AST.WithEol t Nothing) []] ->
             return $ A.drop t
-        Right [AST.Commented pre (t, eol) post] ->
+        Right [AST.Commented pre (AST.WithEol t eol) post] ->
             return $ AST.TypeParens (AST.Commented pre t (maybeToList (fmap AST.LineComment eol) ++ post))
         Right types' ->
             return $ AST.TupleType types'
@@ -52,7 +52,10 @@ capTypeVar elmVersion =
 constructor0 :: ElmVersion -> IParser AST.TypeConstructor
 constructor0 elmVersion =
   do  name <- capTypeVar elmVersion
-      return (AST.NamedConstructor name)
+      case reverse name of
+        [] -> error "Impossible empty TypeConstructor name"
+        last:rest ->
+            return (AST.NamedConstructor (reverse rest) last)
 
 
 constructor0' :: ElmVersion -> IParser AST.Type

parser/src/Reporting/Annotation.hs

@@ -12,6 +12,11 @@ data Located a =
     deriving (Eq)
 
 
+instance Functor Located where
+    fmap f (A region a) =
+        A region (f a)
+
+
 instance (Show a) => Show (Located a) where
     showsPrec p (A r a) = showParen (p > 10) $
         showString $ String.unwords

src/AST/MapExpr.hs

@@ -25,7 +25,7 @@ instance MapExpr a => MapExpr (PreCommented a) where
 
 
 instance MapExpr a => MapExpr (WithEol a) where
-    mapExpr f (a, eol) = (mapExpr f a, eol)
+    mapExpr f = fmap (mapExpr f)
 
 
 instance MapExpr a => MapExpr [a] where

src/AST/MapNamespace.hs

@@ -1,11 +1,12 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 module AST.MapNamespace where
 
 import AST.Declaration
 import AST.Expression
 import AST.MapExpr
 import AST.Variable
 import AST.V0_16
-import Reporting.Annotation
 
 
 class MapNamespace a where
@@ -24,13 +25,60 @@ instance MapNamespace Expr' where
                 mapExpr (mapNamespace f) expr
 
 
+instance MapNamespace Type' where
+    mapNamespace f typ =
+        case typ of
+            UnitType comments ->
+                UnitType comments
+
+            TypeVariable name ->
+                TypeVariable name
+
+            TypeConstruction ctor args ->
+                TypeConstruction (mapNamespace f ctor) (mapNamespace f args)
+
+            TypeParens nested ->
+                TypeParens (mapNamespace f nested)
+
+            TupleType entries ->
+                TupleType (mapNamespace f entries)
+
+            RecordType base fields trailingComments forceMultiline ->
+                RecordType base (mapNamespace f fields) trailingComments forceMultiline
+
+            FunctionType first rest forceMultiline ->
+                FunctionType (mapNamespace f first) (fmap (\(a, b, x, d) -> (a, b, mapNamespace f x, d)) rest) forceMultiline
+
+
+instance MapNamespace TypeConstructor where
+    mapNamespace f ctor =
+        case ctor of
+            NamedConstructor namespace name ->
+                NamedConstructor (f namespace) name
+
+            TupleConstructor n ->
+                TupleConstructor n
+
+
 instance MapNamespace Declaration where
     mapNamespace f decl =
         case decl of
             -- TODO: map references in patterns
             Definition first rest comments expr ->
                 Definition first rest comments (mapNamespace f expr)
 
+            TypeAnnotation name typ ->
+                TypeAnnotation name (mapNamespace f typ)
+
+            Datatype nameWithArgs tags ->
+                Datatype nameWithArgs (fmap (\(name, args) -> (name, fmap (mapNamespace f) args)) tags)
+
+            TypeAlias comments name typ ->
+                TypeAlias comments name (mapNamespace f typ)
+
+            PortAnnotation name comments typ ->
+                PortAnnotation name comments (mapNamespace f typ)
+
             PortDefinition name comments expr ->
                 PortDefinition name comments (mapNamespace f expr)
 
@@ -45,15 +93,5 @@ instance MapNamespace Ref where
             OpRef name -> OpRef name
 
 
-instance MapNamespace a => MapNamespace [a] where
-    mapNamespace f list = fmap (mapNamespace f) list
-
-
-instance MapNamespace a => MapNamespace (TopLevelStructure a) where
-    mapNamespace f struct =
-        case struct of
-            Entry a -> Entry $ mapNamespace f a
-            _ -> struct
-
-instance MapNamespace a => MapNamespace (Located a) where
-    mapNamespace f (A region a) = A region (mapNamespace f a)
+instance (MapNamespace a, Functor f) => MapNamespace (f a) where
+    mapNamespace f = fmap (mapNamespace f)