Alt, pat, param

src/Duet/Parser.hs

@@ -574,14 +574,14 @@ case' = do
   loc <- equalToken Case
   setState (locationStartColumn loc)
   e <- expParser <?> "expression to do case analysis e.g. case e of ..."
-  _ <-  equalToken Of
+  _ <- equalToken Of
   p <- lookAhead altPat <?> "case pattern"
-  alts <- many (altParser e (locationStartColumn (patternLabel p)))
+  alts <- many (altParser (Just e) (locationStartColumn (patternLabel p)))
   setState u
   pure (CaseExpression loc e alts)
 
 altParser
-  :: Expression UnkindedType Identifier Location
+  :: Maybe (Expression UnkindedType Identifier Location)
   -> Int
   -> TokenParser (Pattern UnkindedType Identifier Location, Expression UnkindedType Identifier Location)
 altParser e' startCol =
@@ -599,13 +599,15 @@ altParser e' startCol =
       e <- expParser
       setState u
       pure (p, e)) <?>
-  "indented case alternative e.g.\n\n\
-  \case " ++
-  printExpression
-    defaultPrint
-    e' ++
-  " of\n\
-  \  Just bar -> bar"
+  ("case alternative" ++
+   (case e' of
+      Just e' ->
+        " e.g.\n\n\
+                             \case " ++
+        printExpression defaultPrint e' ++
+        " of\n\
+                             \  Just bar -> bar"
+      Nothing -> ""))
 
 altPat :: TokenParser (Pattern UnkindedType Identifier Location)
 altPat = varp <|> intliteral <|> consParser <|> stringlit

src/Duet/Printer.hs

@@ -151,17 +151,7 @@ printExpression printer e =
        CaseExpression _ e alts ->
          "case " ++
          indent 5 (printExpressionIfPred printer e) ++
-         " of\n" ++
-         indented
-           (intercalate
-              "\n"
-              (map
-                 (\(p, e') ->
-                    let inner = printExpression printer e'
-                    in if any (== '\n') inner
-                         then printPat printer p ++ " ->\n" ++ indented inner
-                         else printPat printer p ++ " -> " ++ indent 2 inner)
-                 alts))
+         " of\n" ++ indented (intercalate "\n" (map (printAlt printer) alts))
        ApplicationExpression _ f x ->
          case x of
            VariableExpression _ (nonrenamableName -> Just (DictName {}))
@@ -174,17 +164,15 @@ printExpression printer e =
                    inner = printExpressionAppArg printer x
        LambdaExpression _ (Alternative _ args e) ->
          if null filteredArgs
-            then inner
-            else if any (== '\n') inner
-                   then "\\" ++ prefix ++ "->\n" ++ indented inner
-                   else "\\" ++ prefix ++ "-> " ++ indent (length prefix + 4) inner
+           then inner
+           else if any (== '\n') inner
+                  then "\\" ++ prefix ++ "->\n" ++ indented inner
+                  else "\\" ++
+                       prefix ++ "-> " ++ indent (length prefix + 4) inner
          where inner = (printExpression printer e)
                filteredArgs = filter dictPred args
                prefix =
-                 concat
-                   (map
-                      (\x -> printPattern printer x ++ " ")
-                      filteredArgs)
+                 concat (map (\x -> printPattern printer x ++ " ") filteredArgs)
                dictPred =
                  if printDictionaries printer
                    then const True
@@ -201,8 +189,9 @@ printExpression printer e =
          printExpressionAppArg printer f ++
          " " ++
          (if printDictionaries printer
-             then "`" ++ printExpression printer ov ++ "`"
-             else o) ++ " " ++ printExpressionAppArg printer x
+            then "`" ++ printExpression printer ov ++ "`"
+            else o) ++
+         " " ++ printExpressionAppArg printer x
        _ -> "<TODO>")
   where
     wrapType x =
@@ -216,6 +205,16 @@ printExpression printer e =
                     then "(" ++ k ++ ")"
                     else k
 
+printAlt
+  :: (PrintableType t, PrintableType t1, Printable i)
+  => Print i l -> (Pattern t1 i l, Expression t i l) -> [Char]
+printAlt printer =
+  \(p, e') ->
+    let inner = printExpression printer e'
+    in if any (== '\n') inner
+         then printPat printer p ++ " ->\n" ++ indented inner
+         else printPat printer p ++ " -> " ++ indent 2 inner
+
 indented :: String -> [Char]
 indented x = intercalate "\n" (map ("  "++) (lines x))
 

web/IDE.hs

@@ -103,6 +103,51 @@ operatorEditor =
        text string
        pure (updated (constDyn (Just (Right (string, op))))))
 
+--------------------------------------------------------------------------------
+-- Parameter editor
+
+parameterEditor
+  :: MonadWidget t m
+  => Maybe (Pattern UnkindedType Identifier Location)
+  -> m (Event t (Pattern UnkindedType Identifier Location))
+parameterEditor =
+  someEditor
+    (printPat defaultPrint)
+    (parseTextWith funcParam "parameter" . T.pack)
+    (\pat -> do
+       text (printPat defaultPrint pat)
+       pure (updated (constDyn (Just (Right pat)))))
+
+--------------------------------------------------------------------------------
+-- Pattern editor
+
+patternEditor
+  :: MonadWidget t m
+  => Maybe (Pattern UnkindedType Identifier Location)
+  -> m (Event t (Pattern UnkindedType Identifier Location))
+patternEditor =
+  someEditor
+    (printPat defaultPrint)
+    (parseTextWith altPat "pattern" . T.pack)
+    (\pat -> do
+       text (printPat defaultPrint pat)
+       pure (updated (constDyn (Just (Right pat)))))
+
+--------------------------------------------------------------------------------
+-- Alt editor
+
+alternativeEditor
+  :: MonadWidget t m
+  => Maybe (Pattern UnkindedType Identifier Location, Expression UnkindedType Identifier Location)
+  -> m (Event t (Pattern UnkindedType Identifier Location, Expression UnkindedType Identifier Location))
+alternativeEditor =
+  someEditor
+    (printAlt defaultPrint)
+    (parseTextWith (altParser Nothing 0) "alternative" . T.pack)
+    (\alt -> do
+       text (printAlt defaultPrint alt)
+       pure (updated (constDyn (Just (Right alt)))))
+
 --------------------------------------------------------------------------------
 -- Editor combinators