hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Respect special where ind.; Some layouting fixes

pull/1/head
Lennart Spitzner 2016-08-04 19:53:37 +02:00
parent 9949ed7225
commit 6b748ea3eb
6 changed files with 81 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
brittany.cabal
View File

@ -74,6 +74,7 @@ library {
, strict >=0.3.2 && <0.4
, monad-memo >=0.4.1 && <0.5
, unsafe >=0.0 && <0.1
, safe >=0.3.9 && <0.4
, deepseq >=1.4.2.0 && <1.5
}
default-extensions: {
@ -129,6 +130,7 @@ executable brittany
, uniplate
, strict
, monad-memo
, safe
}
hs-source-dirs: src-brittany
default-language: Haskell2010
@ -193,6 +195,7 @@ test-suite unittests
, uniplate
, strict
, monad-memo
, safe
}
ghc-options: -Wall
main-is: TestMain.hs

10
src/Language/Haskell/Brittany/BriLayouter.hs
View File

@ -768,6 +768,8 @@ transformSimplifyFloating = stepBO .> stepFull
-- note that semantically, stepFull is completely sufficient.
-- but the bottom-up switch-to-top-down-on-match transformation has much
-- better complexity.
-- UPDATE: by now, stepBO does more than stepFull; for semantic equivalence
-- the push/pop cases would need to be copied over
where
descendPost = transformDownMay $ \case
-- post floating in
@ -796,19 +798,19 @@ transformSimplifyFloating = stepBO .> stepFull
Just $ BDAddBaseY indent $ BDAnnotationPrior annKey1 x
_ -> Nothing
descendBYPush = transformDownMay $ \case
BDBaseYPushCur (BDCols sig cols) ->
BDBaseYPushCur (BDCols sig cols@(_:_)) ->
Just $ BDCols sig (BDBaseYPushCur (List.head cols) : List.tail cols)
_ -> Nothing
descendBYPop = transformDownMay $ \case
BDBaseYPop (BDCols sig cols) ->
BDBaseYPop (BDCols sig cols@(_:_)) ->
Just $ BDCols sig (List.init cols ++ [BDBaseYPop (List.last cols)])
_ -> Nothing
descendILPush = transformDownMay $ \case
BDIndentLevelPushCur (BDCols sig cols) ->
BDIndentLevelPushCur (BDCols sig cols@(_:_)) ->
Just $ BDCols sig (BDIndentLevelPushCur (List.head cols) : List.tail cols)
_ -> Nothing
descendILPop = transformDownMay $ \case
BDIndentLevelPop (BDCols sig cols) ->
BDIndentLevelPop (BDCols sig cols@(_:_)) ->
Just $ BDCols sig (List.init cols ++ [BDIndentLevelPop (List.last cols)])
_ -> Nothing
descendAddB = transformDownMay $ \case

126
src/Language/Haskell/Brittany/Layouters/Decl.hs
View File

@ -149,11 +149,25 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
patPartParWrap = case mPatDoc of
Nothing -> id
Just patDoc -> docPar (return patDoc)
_whereIndent <- mAsk
whereIndent <- mAsk
<&> _conf_layout
.> _lconfig_indentWhereSpecial
.> runIdentity
.> Bool.bool BrIndentRegular (BrIndentSpecial 1)
-- TODO: apart from this, there probably are more nodes below which could
-- be shared between alternatives.
wherePartMultiLine :: [ToBriDocM BriDocNumbered] <- case mWhereDocs of
Nothing -> return $ []
Just ws -> fmap (fmap return) $ sequence $ return @[]
$ docEnsureIndent whereIndent
$ docLines
[ docLit $ Text.pack "where"
, docEnsureIndent whereIndent
$ docSetIndentLevel
$ docNonBottomSpacing
$ docLines
$ return <$> ws
]
docAlt $
-- one-line solution
[ docCols ColBindingLine
@ -177,38 +191,48 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
++ [docSeparator]
, let
wherePart = case mWhereDocs of
Nothing -> docEmpty
Just [w] -> docAlt
[ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w
]
, docAddBaseY BrIndentRegular
$ docPar docEmpty
$ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "where")
(docSetIndentLevel $ return w)
, wherePart <- case mWhereDocs of
Nothing -> return @[] $ docEmpty
Just [w] -> return @[] $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w
]
Just ws ->
docAddBaseY BrIndentRegular
$ docPar docEmpty
$ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "where")
(docSetIndentLevel $ docLines $ return <$> ws)
_ -> []
] ++
-- two-line solution
-- one-line solution + where in next line(s)
[ docLines
$ [ docCols ColBindingLine
[ docSeq
(patPartInline ++ [guardPart])
, docSeq
[ appSep $ return binderDoc
, lineMod $ return body
]
]
] ++ wherePartMultiLine
| [(guards, body, bodyRaw)] <- [clauseDocs]
, let lineMod = case mWhereDocs of
Nothing | isExpressionTypeHeadPar bodyRaw ->
docAddBaseY BrIndentRegular
_ -> docForceSingleline
, let guardPart = case guards of
[] -> docEmpty
[g] -> docSeq [appSep $ docLit $ Text.pack "|", return g, docSeparator]
gs -> docSeq
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
++ [docSeparator]
, Data.Maybe.isJust mWhereDocs
] ++
-- two-line solution + where in next line(s)
[ docLines
$ [ docForceSingleline
$ docSeq (patPartInline ++ [guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular
$ docForceSingleline
$ return body
] ++ wherePart
] ++ wherePartMultiLine
| [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = case guards of
[] -> docEmpty
@ -217,14 +241,9 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
++ [docSeparator]
, let wherePart = case mWhereDocs of
Nothing -> []
Just ws -> pure $ docEnsureIndent BrIndentRegular $ docPar
(docLit $ Text.pack "where")
(docSetIndentLevel $ docLines $ return <$> ws)
] ++
-- pattern and exactly one clause in single line, body and where
-- indented if necessary.
-- pattern and exactly one clause in single line, body as par;
-- where in following lines
[ docLines
$ [ docCols ColBindingLine
[ docSeq
@ -238,7 +257,7 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
-- ]
]
]
] ++ wherePart
] ++ wherePartMultiLine
| [(guards, body, bodyRaw)] <- [clauseDocs]
, let lineMod = case () of
_ | isExpressionTypeHeadPar bodyRaw -> id
@ -249,20 +268,15 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
gs -> docSeq
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
, let wherePart = case mWhereDocs of
Nothing -> []
Just ws -> pure $ docEnsureIndent BrIndentRegular $ docPar
(docLit $ Text.pack "where")
(docSetIndentLevel $ docLines $ return <$> ws)
] ++
-- pattern and exactly one clause in single line, body in new line.
[ docAddBaseY BrIndentRegular
$ docPar
(docSeq (patPartInline ++ [appSep $ guardPart, return binderDoc]))
( docNonBottomSpacing
[ docLines
$ [ docSeq (patPartInline ++ [appSep $ guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular
$ docNonBottomSpacing
$ docLines
$ [ docAddBaseY BrIndentRegular $ return body ] ++ wherePart
)
$ [ docAddBaseY BrIndentRegular $ return body ]
] ++ wherePartMultiLine
| [(guards, body, _)] <- [clauseDocs]
, let guardPart = case guards of
[] -> docEmpty
@ -270,17 +284,13 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
gs -> docSeq
$ [appSep $ docLit $ Text.pack "|"]
++ List.intersperse docCommaSep (return <$> gs)
, let wherePart = case mWhereDocs of
Nothing -> []
Just ws -> pure $ docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "where")
(docSetIndentLevel $ docLines $ return <$> ws)
] ++
-- conservative approach: everything starts on the left.
[ docAddBaseY BrIndentRegular
$ patPartParWrap
$ docLines $
(clauseDocs >>= \(guardDocs, bodyDoc, _) ->
[ docLines $
[ patPartParWrap
$ docLines
$ fmap (docEnsureIndent BrIndentRegular)
$ clauseDocs >>= \(guardDocs, bodyDoc, _) ->
(case guardDocs of
[] -> []
[g] -> [docSeq [appSep $ docLit $ Text.pack "|", return g]]
@ -295,13 +305,5 @@ layoutPatternBindFinal binderDoc mPatDoc clauseDocs mWhereDocs = do
[ appSep $ return binderDoc
, docAddBaseY BrIndentRegular $ return bodyDoc]
]
) ++
(case mWhereDocs of
Nothing -> []
Just whereDocs ->
[ docAddBaseY BrIndentRegular
$ docPar (docLit $ Text.pack "where")
$ docSetIndentLevel $ docLines (return <$> whereDocs)
]
)
] ++ wherePartMultiLine
]

8
src/Language/Haskell/Brittany/Layouters/Stmt.hs
View File

@ -46,7 +46,7 @@ layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of
Just [bindDoc] -> docAlt
[ docCols ColDoLet
[ appSep $ docLit $ Text.pack "let"
, docSetIndentLevel $ docAddBaseY BrIndentRegular (return bindDoc)
, docSetIndentLevel $ return bindDoc
]
, docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "let")
@ -59,17 +59,17 @@ layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of
[ docLines
$ (docCols ColDoLet
[ appSep $ docLit $ Text.pack "let"
, docSetIndentLevel $ docAddBaseY BrIndentRegular (return bindDoc1)
, docSetIndentLevel $ return bindDoc1
])
: (bindDocr <&> \bindDoc ->
docCols ColDoLet
[ docEnsureIndent (BrIndentSpecial 4) docEmpty
, docSetIndentLevel $ docAddBaseY BrIndentRegular (return bindDoc)
, docSetIndentLevel $ return bindDoc
])
, docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "let")
(docSetIndentLevel $ docAddBaseY BrIndentRegular $ docLines $ return <$> bindDocs)
(docSetIndentLevel $ docLines $ return <$> bindDocs)
]
BodyStmt expr _ _ _ -> do
expDoc <- docSharedWrapper layoutExpr expr

4
src/Language/Haskell/Brittany/Types.hs
View File

@ -83,10 +83,10 @@ data LayoutState = LayoutState
}
lstate_baseY :: LayoutState -> Int
lstate_baseY = head . _lstate_baseYs
lstate_baseY = Safe.headNote "lstate_baseY" . _lstate_baseYs
lstate_indLevel :: LayoutState -> Int
lstate_indLevel = head . _lstate_indLevels
lstate_indLevel = Safe.headNote "lstate_baseY" . _lstate_indLevels
-- evil, incomplete Show instance; only for debugging.
instance Show LayoutState where

2
srcinc/prelude.inc
View File

@ -428,6 +428,8 @@ import qualified Control.Monad.Trans.State.Strict as StateS
import qualified Data.Strict.Maybe as Strict
import qualified Safe as Safe
import Data.Functor.Identity ( Identity(..) )
import Control.Concurrent.Chan ( Chan )
import Control.Concurrent.MVar ( MVar )