mirror of
https://github.com/chrisdone/duet.git
synced 2024-10-26 11:30:19 +03:00
Alt, pat, param
This commit is contained in:
parent
aca9fa2a1e
commit
0c79fd26c2
@ -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
|
||||
|
@ -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))
|
||||
|
||||
|
45
web/IDE.hs
45
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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user