diff --git a/src/Duet/Parser.hs b/src/Duet/Parser.hs index ddd6cb8..ee0a436 100644 --- a/src/Duet/Parser.hs +++ b/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 diff --git a/src/Duet/Printer.hs b/src/Duet/Printer.hs index d77a088..afecb62 100644 --- a/src/Duet/Printer.hs +++ b/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 _ -> "") 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)) diff --git a/web/IDE.hs b/web/IDE.hs index e5a61fb..9143af1 100644 --- a/web/IDE.hs +++ b/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