Data constructors and destructors (desugared to records)

build/out/main.css

@@ -96,8 +96,6 @@ code {
 
 .ui-button.close {
   display: inline-block;
-  width: 0.75em;
-  height: 0.75em;
 
   background-color: transparent;
   border: none;

examples/mapListLens_1.elm

@@ -11,24 +11,24 @@ mapListLens =
           ([], []) ->
             acc
 
-          (["Keep"] :: moreDiffOps, oldHead :: oldTail) ->
+          (KeepValue :: moreDiffOps, oldHead :: oldTail) ->
             let newTails = walk moreDiffOps (Just oldHead) oldTail acc in
             List.simpleMap (\newTail -> oldHead::newTail) newTails
 
-          (["Delete"] :: moreDiffOps, oldHead :: oldTail) ->
+          (DeleteValue :: moreDiffOps, oldHead :: oldTail) ->
             let newTails = walk moreDiffOps (Just oldHead) oldTail acc in
             newTails
 
-          (["Update", newVal] :: moreDiffOps, oldHead :: oldTail) ->
+          ((UpdateValue newVal) :: moreDiffOps, oldHead :: oldTail) ->
             let newTails = walk moreDiffOps (Just oldHead) oldTail acc in
             let newHeads = Update.updateApp {fun = f, input = oldHead, output = newVal} in
             List.cartesianProductWith List.cons newHeads.values newTails
 
-          (["Insert", newVal] :: moreDiffOps, _) ->
+          ((InsertValue newVal) :: moreDiffOps, _) ->
             let headOrPreviousHead =
               case (oldInputs, maybePreviousInput) of
                 (oldHead :: _, _) -> oldHead
-                ([], ["Just", previousOldHead]) -> previousOldHead
+                ([], Just previousOldHead) -> previousOldHead
             in
             let newTails = walk moreDiffOps maybePreviousInput oldInputs acc in
             let newHeads = Update.updateApp {fun = f, input = headOrPreviousHead, output = newVal} in
@@ -37,7 +37,10 @@ mapListLens =
       let newInputLists =
         walk (Update.listDiff oldOutputList newOutputList) Nothing oldInputList [[]]
       in
-      { values = List.simpleMap (\newInputList -> (f, newInputList)) newInputLists }
+      let newFuncAndInputLists =
+        List.simpleMap (\newInputList -> (f, newInputList)) newInputLists
+      in
+      { values = newFuncAndInputLists }
   }
 
 mapList f xs =

examples/mapListLens_2.elm

@@ -11,26 +11,26 @@ mapListLens =
           ([], []) ->
             acc
 
-          (["Keep"] :: moreDiffOps, oldHead :: oldTail) ->
+          (KeepValue :: moreDiffOps, oldHead :: oldTail) ->
             let tails = walk moreDiffOps (Just oldHead) oldTail acc in
             List.simpleMap (\newTail -> (f, oldHead) :: newTail) tails
 
-          (["Delete"] :: moreDiffOps, oldHead :: oldTail) ->
+          (DeleteValue :: moreDiffOps, oldHead :: oldTail) ->
             let tails = walk moreDiffOps (Just oldHead) oldTail acc in
             tails
 
-          (["Update", newVal] :: moreDiffOps, oldHead :: oldTail) ->
+          ((UpdateValue newVal) :: moreDiffOps, oldHead :: oldTail) ->
             let tails = walk moreDiffOps (Just oldHead) oldTail acc in
             let heads =
               (Update.updateApp {fun (a,b) = a b, input = (f, oldHead), output = newVal}).values
             in
             List.cartesianProductWith List.cons heads tails
 
-          (["Insert", newVal] :: moreDiffOps, _) ->
+          ((InsertValue newVal) :: moreDiffOps, _) ->
             let headOrPreviousHead =
               case (oldInputs, maybePreviousInput) of
                 (oldHead :: _, _) -> oldHead
-                ([], ["Just", oldPreviousHead]) -> oldPreviousHead
+                ([], Just oldPreviousHead) -> oldPreviousHead
             in
             let tails = walk moreDiffOps maybePreviousInput oldInputs acc in
             let heads =
@@ -41,13 +41,14 @@ mapListLens =
       let newLists =
         walk (Update.listDiff oldOutputList newOutputList) Nothing oldInputList [[]]
       in
-      { values =
-          List.simpleMap (\newList ->
-            let (newFuncs, newInputList) = List.unzip newList in
-            let newFunc = Update.merge f newFuncs in
-            (newFunc, newInputList)
-          ) newLists
-      }
+      let newFuncAndInputLists =
+        List.simpleMap (\newList ->
+          let (newFuncs, newInputList) = List.unzip newList in
+          let newFunc = Update.merge f newFuncs in
+          (newFunc, newInputList)
+        ) newLists
+      in
+      { values = newFuncAndInputLists }
   }
 
 mapList f xs =

examples/preludeLeo.elm

@@ -175,47 +175,47 @@ Update =
     in
     applyLens constantInputLens x
   in
-  --   type SimpleListDiffOp = Keep | Delete | Insert Value | Update Value
-  let SimpleListDiffOp =
-    { Keep = ["Keep"]
-    , Delete = ["Delete"]
-    , Insert v = ["Insert", v]
-    , Update v = ["Update", v]
-    }
-  in
+  type SimpleListDiffOp = KeepValue | DeleteValue | InsertValue Value | UpdateValue Value
+  -- let SimpleListDiffOp =
+  --   { Keep = ["Keep"]
+  --   , Delete = ["Delete"]
+  --   , Insert v = ["Insert", v]
+  --   , Update v = ["Update", v]
+  --   }
+  -- in
   let listDiffOp diffOp oldValues newValues =
    -- listDiffOp : DiffOp -> List Value -> List Value -> List SimpleListDiffOp
 
-     let {Keep, Delete, Insert, Update} = SimpleListDiffOp in
+    -- let {Keep, Delete, Insert, Update} = SimpleListDiffOp in
      let {append} = LensLess in
      case diffOp oldValues newValues of
         ["Ok", ["Just", ["VListDiffs", listDiffs]]] ->
           letrec aux i revAcc oldValues newValues listDiffs =
             case listDiffs of
               [] ->
-                reverse (map1 (\_ -> Keep) oldValues ++ revAcc)
+                reverse (map1 (\_ -> KeepValue) oldValues ++ revAcc)
               [j, listDiff]::diffTail ->
                 if j > i then
                   case [oldValues, newValues] of
                     [_::oldTail, _::newTail] ->
-                      aux (i + 1) (Keep::revAcc) oldTail newTail listDiffs
+                      aux (i + 1) (KeepValue::revAcc) oldTail newTail listDiffs
                     _ -> error <| "[Internal error] Expected two non-empty tails, got  " + toString [oldValues, newValues]
                 else if j == i then
                   case listDiff of
                     ["ListElemUpdate", _] ->
                       case [oldValues, newValues] of
                         [oldHead::oldTail, newHead::newTail] ->
-                          aux (i + 1) (Update newHead :: revAcc) oldTail newTail diffTail
+                          aux (i + 1) (UpdateValue newHead :: revAcc) oldTail newTail diffTail
                         _ -> error <| "[Internal error] update but missing element"
                     ["ListElemInsert", count] ->
                       case newValues of
                         newHead::newTail ->
-                          aux i (Insert newHead::revAcc) oldValues newTail (if count == 1 then diffTail else [i, ["ListElemInsert", count - 1]]::diffTail)
+                          aux i (InsertValue newHead::revAcc) oldValues newTail (if count == 1 then diffTail else [i, ["ListElemInsert", count - 1]]::diffTail)
                         _ -> error <| "[Internal error] insert but missing element"
                     ["ListElemDelete", count] ->
                       case oldValues of
                         oldHead::oldTail ->
-                          aux (i + 1) (Delete::revAcc) oldTail newValues (if count == 1 then diffTail else [i + 1, ["ListElemDelete", count - 1]]::diffTail)
+                          aux (i + 1) (DeleteValue::revAcc) oldTail newValues (if count == 1 then diffTail else [i + 1, ["ListElemDelete", count - 1]]::diffTail)
                         _ -> error <| "[Internal error] insert but missing element"
                 else error <| "[Internal error] Differences not in order, got index " + toString j + " but already at index " + toString i
           in aux 0 [] oldValues newValues listDiffs
@@ -242,6 +242,44 @@ Update =
       modifiedStr
   }
 
+-- getSimpleListDiffOps : List Value -> List Value -> VDiffs -> List SimpleListDiffOp
+getSimpleListDiffOps oldValues newValues vDiffs =
+   -- let {Keep, Delete, Insert, Update} = SimpleListDiffOp in
+   let append = __update_append__ in
+   case vDiffs of
+      ["VListDiffs", listDiffs] ->
+        letrec aux i revAcc oldValues newValues listDiffs =
+          case listDiffs of
+            [] ->
+              reverse (map1 (\_ -> KeepValue) oldValues ++ revAcc)
+            [j, listDiff]::diffTail ->
+              if j > i then
+                case [oldValues, newValues] of
+                  [_::oldTail, _::newTail] ->
+                    aux (i + 1) (KeepValue::revAcc) oldTail newTail listDiffs
+                  _ -> error <| "[Internal error] Expected two non-empty tails, got  " + toString [oldValues, newValues]
+              else if j == i then
+                case listDiff of
+                  ["VListElemUpdate", _] ->
+                    case [oldValues, newValues] of
+                      [oldHead::oldTail, newHead::newTail] ->
+                        aux (i + 1) (UpdateValue newHead :: revAcc) oldTail newTail diffTail
+                      _ -> error <| "[Internal error] update but missing element"
+                  ["VListElemInsert", count] ->
+                    case newValues of
+                      newHead::newTail ->
+                        aux i (InsertValue newHead::revAcc) oldValues newTail (if count == 1 then diffTail else [i, ["VListElemInsert", count - 1]]::diffTail)
+                      _ -> error <| "[Internal error] insert but missing element"
+                  ["VListElemDelete", count] ->
+                    case oldValues of
+                      oldHead::oldTail ->
+                        aux (i + 1) (DeleteValue::revAcc) oldTail newValues (if count == 1 then diffTail else [i + 1, ["VListElemDelete", count - 1]]::diffTail)
+                      _ -> error <| "[Internal error] insert but missing element"
+              else error <| "[Internal error] Differences not in order, got index " + toString j + " but already at index " + toString i
+        in aux 0 [] oldValues newValues listDiffs
+
+      _ -> error ("Expected VListDiffs, got " + toString vDiffs)
+
 __extendUpdateModule__ {updateApp,diff,merge} =
   { Update
      | updateApp = updateApp
@@ -1129,35 +1167,46 @@ List =
 
 -- Maybe --
 
+-- TODO remove these and their uses
 -- old version
 nothing = ["Nothing"]
 just x  = ["Just", x]
 
--- new version
-Maybe = {
-  Nothing = ["Nothing"]
-  Just x  = ["Just", x]
-  withDefault x mb = case mb of
+Maybe =
+  type Maybe a = Nothing | Just a
+  -- TODO use data constructor patterns instead
+  let withDefault x mb = case mb of
     ["Nothing"] -> x
     ["Just", j] -> j
-  withDefaultLazy lazyX mb = case mb of
+  in
+  let withDefaultLazy lazyX mb = case mb of
     ["Nothing"] -> lazyX []
     ["Just", j] -> j
-}
-
-{Nothing, Just} = Maybe
+  in
+  { withDefault = withDefault
+    withDefaultLazy = withDefaultLazy
+  }
 
--- Sample deconstructors once generalized pattern matching works.
-Nothing$ = {
-  unapplySeq exp = case exp of
-    ["Nothing"] -> Just []
-    _ -> Nothing
-}
-Just$ = {
-  unapplySeq exp = case exp of
-    ["Just", x] -> Just [x]
-    _ -> Nothing
-}
+-- if we decide to allow types to be defined within (and exported from) modules
+--
+-- {Nothing, Just} = Maybe
+--
+-- might look something more like
+--
+-- {Maybe(Nothing,Just)} = Maybe
+-- {Maybe(..)} = Maybe
+--
+-- -- Sample deconstructors once generalized pattern matching works.
+-- Nothing$ = {
+--   unapplySeq exp = case exp of
+--     ["Nothing"] -> Just []
+--     _ -> Nothing
+-- }
+-- Just$ = {
+--   unapplySeq exp = case exp of
+--     ["Just", x] -> Just [x]
+--     _ -> Nothing
+-- }
 
 -- Tuple --
 

src/DependenceGraph.elm

@@ -311,13 +311,14 @@ traverse env exp acc =
     ETypeCase _ _ tbranches _ ->
       let _ = Debug.log "TODO: scope tree ETypeCase" () in acc
 
-    EComment _ _ e        -> recurse [e]
-    EOption _ _ _ _ e     -> recurse [e]
-    ETyp _ _ _ e _        -> recurse [e]
-    EColonType _ e _ _ _  -> recurse [e]
-    ETypeAlias _ _ _ e _  -> recurse [e]
-    EParens _ e _ _       -> recurse [e]
-    EHole _ _             -> let _ = Utils.log "DependenceGraph.traverse: EHole in exp!!" in acc
+    EComment _ _ e         -> recurse [e]
+    EOption _ _ _ _ e      -> recurse [e]
+    ETyp _ _ _ e _         -> recurse [e]
+    EColonType _ e _ _ _   -> recurse [e]
+    ETypeAlias _ _ _ e _   -> recurse [e]
+    ETypeDef _ _ _ _ _ e _ -> recurse [e]
+    EParens _ e _ _        -> recurse [e]
+    EHole _ _              -> let _ = Utils.log "DependenceGraph.traverse: EHole in exp!!" in acc
 
 -- In a let [pattern] = [definition], map each subpattern to its corresponding definition
 traverseAndAddDependencies newScopeId =

src/DeuceTools.elm

@@ -1859,6 +1859,25 @@ makeSingleLineTool model selections =
                             EColonType (deLine ws1) e (deLine ws2) tipe space0
                           ETypeAlias ws1 pat tipe e ws2 ->
                             ETypeAlias (deLine ws1) pat tipe e space0
+                          ETypeDef ws1 (wsIdent, ident) vars ws2 dcs e ws3 ->
+                            ETypeDef
+                              (deLine ws1)
+                              (deLine wsIdent, ident)
+                              ( List.map
+                                  ( \(ws, name) ->
+                                      (deLine ws, name)
+                                  )
+                                  vars
+                              )
+                              (deLine ws2)
+                              ( List.map
+                                  ( \(wsa, name, ts, wsb) ->
+                                      (deLine wsa, name, ts, deLine wsb)
+                                  )
+                                  dcs
+                              )
+                              e
+                              space0
                           EParens ws1 e pStyle ws2 ->
                             EParens (deLine ws1) e pStyle (deLine ws2)
                           EHole ws mv ->

src/Draw.elm

@@ -473,7 +473,7 @@ addPoint old (x, y) =
     [pointName, xName, yName] ->
       let
         programWithPoint =
-          LangTools.addFirstDef originalProgram (pAs pointName (pList [pVar0 xName, pVar yName])) (eColonType (eTuple0 [eConstDummyLoc0 (toFloat x), eConstDummyLoc (toFloat y)]) (TNamed space1 "Point"))
+          LangTools.addFirstDef originalProgram (pAs pointName (pList [pVar0 xName, pVar yName])) (eColonType (eTuple0 [eConstDummyLoc0 (toFloat x), eConstDummyLoc (toFloat y)]) (TApp space1 "Point" []))
       in
       { old | code = Syntax.unparser old.syntax programWithPoint }
 
@@ -546,7 +546,7 @@ addOffsetAndMaybePoint old snap (x1, y1) maybeExistingPoint (x2, y2) =
             programWithOffset =
               LangTools.addFirstDef originalProgram (pVar offsetName) (eOp plusOrMinus [eVar offsetFromName, eConstDummyLoc (toFloat offsetAmount)]) |> Parser.freshen
             programWithOffsetAndPoint =
-              LangTools.addFirstDef programWithOffset (pAs pointName (pList [pVar0 xName, pVar yName])) (eColonType (eTuple0 [eConstDummyLoc0 x1, eConstDummyLoc y1]) (TNamed space1 "Point"))
+              LangTools.addFirstDef programWithOffset (pAs pointName (pList [pVar0 xName, pVar yName])) (eColonType (eTuple0 [eConstDummyLoc0 x1, eConstDummyLoc y1]) (TApp space1 "Point" []))
           in
           { old | code = Syntax.unparser old.syntax programWithOffsetAndPoint }
 
@@ -766,7 +766,7 @@ addStickyPath old keysAndPoints =
 eAsPoint e =
   let e_ = replacePrecedingWhitespace "" e in
   withDummyExpInfo <|
-    EColonType space1 e_ space1 (withDummyRange <| TNamed space1 "Point") space1
+    EColonType space1 e_ space1 (withDummyRange <| TApp space1 "Point" []) space1
 
 {-
 addLambda old (_,pt2) (_,pt1) =
@@ -843,8 +843,8 @@ addFunction fName old (_, (x2, y2)) (_, (x1, y1)) =
       TUnion _ (firstType::_) _      -> fillInArgPrimitive firstType
       TVar _ _                       -> Just <| eTuple []
       TWildcard _                    -> Just <| eTuple []
-      TNamed _ "Color"               -> Just <| eConstDummyLoc 0
-      TNamed _ "Point"               -> Just <| eTuple (makeInts [0,0])
+      TApp _ "Color" _               -> Just <| eConstDummyLoc 0
+      TApp _ "Point" _               -> Just <| eTuple (makeInts [0,0])
       _                              -> Nothing
   in
   case getDrawableFunctions old |> Utils.maybeFind fName |> Maybe.andThen Types.typeToMaybeArgTypesAndReturnType of
@@ -854,14 +854,14 @@ addFunction fName old (_, (x2, y2)) (_, (x1, y1)) =
         |> List.foldl
             (\argType (ptsRemaining, argMaybeExps) ->
               case (ptsRemaining, argType.val) of
-                ((x,y)::otherPts, TNamed _ "Point") -> (otherPts,     argMaybeExps ++ [Just (eTuple (makeInts [x,y]))])
+                ((x,y)::otherPts, TApp _ "Point" _) -> (otherPts,     argMaybeExps ++ [Just (eTuple (makeInts [x,y]))])
                 _                                   -> (ptsRemaining, argMaybeExps ++ [fillInArgPrimitive argType])
             )
             ([(x1, y1), (x2, y2)], [])
       in
       case (Utils.projJusts argMaybeExps, returnType.val) of
-        (Just argExps, TNamed _ "Point") -> addToEndOfProgram old fName (eCall fName argExps)
-        (Just argExps, TNamed _ "Shape") -> addShapeToModel   old fName (eCall fName argExps)
+        (Just argExps, TApp _ "Point" _) -> addToEndOfProgram old fName (eCall fName argExps)
+        (Just argExps, TApp _ "Shape" _) -> addShapeToModel   old fName (eCall fName argExps)
         _                                -> let _ = Utils.log <| "Could not draw function " ++ fName ++ "!" in old
 
     Nothing -> let _ = Utils.log <| "Could not find function " ++ fName ++ " to draw!" in old
@@ -1142,7 +1142,7 @@ isDrawableType tipe =
   case tipe.val of
     TArrow _ argTypes _ ->
       case (Utils.maybeLast argTypes |> Maybe.map .val, Utils.dropLast 1 argTypes) of
-        (Just (TNamed _ retAliasName), otherArgs) ->
+        (Just (TApp _ retAliasName _), otherArgs) ->
           if retAliasName == "Shape" || retAliasName == "Point" then
             let aliasArgIdents = List.filterMap Types.typeToMaybeAliasIdent otherArgs in
             Utils.count ((==) "Point") aliasArgIdents == 2