mirror of
https://github.com/ilyakooo0/ormolu.git
synced 2024-10-27 11:41:17 +03:00
Format unboxed sum pattern
This commit is contained in:
parent
54749b889a
commit
be53b3e504
@ -0,0 +1,24 @@
|
|||||||
|
{-# LANGUAGE UnboxedSums #-}
|
||||||
|
|
||||||
|
v = True
|
||||||
|
where
|
||||||
|
(# _x #) = (# True #)
|
||||||
|
|
||||||
|
p = True
|
||||||
|
where
|
||||||
|
(# _x | #) = (# | True #)
|
||||||
|
|
||||||
|
q = True
|
||||||
|
where
|
||||||
|
(# | _x | #) = (# | True | #)
|
||||||
|
|
||||||
|
z = True
|
||||||
|
where
|
||||||
|
(# | | _x #) = (# | | True #)
|
||||||
|
|
||||||
|
z_multiline = True
|
||||||
|
where
|
||||||
|
(# | | _x
|
||||||
|
#) =
|
||||||
|
(# | | True
|
||||||
|
#)
|
@ -0,0 +1,23 @@
|
|||||||
|
{-# LANGUAGE UnboxedSums #-}
|
||||||
|
|
||||||
|
v = True
|
||||||
|
where
|
||||||
|
(# _x #) = (# True #)
|
||||||
|
|
||||||
|
p = True
|
||||||
|
where
|
||||||
|
(# _x | #) = (# | True #)
|
||||||
|
|
||||||
|
q = True
|
||||||
|
where
|
||||||
|
(# | _x | #) = (# | True | #)
|
||||||
|
|
||||||
|
z = True
|
||||||
|
where
|
||||||
|
(# | | _x #) = (# | | True #)
|
||||||
|
|
||||||
|
z_multiline = True
|
||||||
|
where
|
||||||
|
(# |
|
||||||
|
| _x #) = (# |
|
||||||
|
| True #)
|
@ -484,21 +484,8 @@ p_hsExpr = \case
|
|||||||
sep comma (located' p_hsTupArg) args
|
sep comma (located' p_hsTupArg) args
|
||||||
else switchLayout (getLoc <$> args) . parens' . sitcc $
|
else switchLayout (getLoc <$> args) . parens' . sitcc $
|
||||||
sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
|
sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
|
||||||
ExplicitSum NoExt tag arity e -> do
|
ExplicitSum NoExt tag arity e ->
|
||||||
let before = tag - 1
|
p_unboxedSum tag arity (located e p_hsExpr)
|
||||||
after = arity - before - 1
|
|
||||||
args = replicate before Nothing <> [Just e] <> replicate after Nothing
|
|
||||||
f (x,i) = do
|
|
||||||
let isFirst = i == 0
|
|
||||||
isLast = i == arity - 1
|
|
||||||
case x of
|
|
||||||
Nothing ->
|
|
||||||
unless (isFirst || isLast) space
|
|
||||||
Just l -> do
|
|
||||||
unless isFirst space
|
|
||||||
located l p_hsExpr
|
|
||||||
unless isLast space
|
|
||||||
parensHash $ sep (txt "|") f (zip args [0..])
|
|
||||||
HsCase NoExt e mgroup -> do
|
HsCase NoExt e mgroup -> do
|
||||||
txt "case "
|
txt "case "
|
||||||
located e p_hsExpr
|
located e p_hsExpr
|
||||||
@ -710,9 +697,8 @@ p_pat = \case
|
|||||||
Boxed -> parens
|
Boxed -> parens
|
||||||
Unboxed -> parensHash
|
Unboxed -> parensHash
|
||||||
f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
|
f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
|
||||||
SumPat NoExt pat _ _ -> do
|
SumPat NoExt pat tag arity ->
|
||||||
-- XXX I'm not sure about this one.
|
p_unboxedSum tag arity (located pat p_pat)
|
||||||
located pat p_pat
|
|
||||||
ConPatIn pat details ->
|
ConPatIn pat details ->
|
||||||
case details of
|
case details of
|
||||||
PrefixCon xs -> sitcc $ do
|
PrefixCon xs -> sitcc $ do
|
||||||
@ -765,6 +751,23 @@ p_pat_hsRecField HsRecField {..} = do
|
|||||||
breakpoint
|
breakpoint
|
||||||
inci (located hsRecFieldArg p_pat)
|
inci (located hsRecFieldArg p_pat)
|
||||||
|
|
||||||
|
p_unboxedSum :: ConTag -> Arity -> R () -> R ()
|
||||||
|
p_unboxedSum tag arity m = do
|
||||||
|
let before = tag - 1
|
||||||
|
after = arity - before - 1
|
||||||
|
args = replicate before Nothing <> [Just m] <> replicate after Nothing
|
||||||
|
f (x,i) = do
|
||||||
|
let isFirst = i == 0
|
||||||
|
isLast = i == arity - 1
|
||||||
|
case x :: Maybe (R ()) of
|
||||||
|
Nothing ->
|
||||||
|
unless (isFirst || isLast) space
|
||||||
|
Just m' -> do
|
||||||
|
unless isFirst space
|
||||||
|
m'
|
||||||
|
unless isLast space
|
||||||
|
parensHash $ sep (txt "|") f (zip args [0..])
|
||||||
|
|
||||||
p_hsSplice :: HsSplice GhcPs -> R ()
|
p_hsSplice :: HsSplice GhcPs -> R ()
|
||||||
p_hsSplice = \case
|
p_hsSplice = \case
|
||||||
HsTypedSplice NoExt deco _ expr -> p_hsSpliceTH True expr deco
|
HsTypedSplice NoExt deco _ expr -> p_hsSpliceTH True expr deco
|
||||||
|
Loading…
Reference in New Issue
Block a user