Update showcases / Add more example layouts
parent
00ad6c71b9
commit
da692a4341
|
|
@ -3,10 +3,11 @@ haskell source code formatter
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(see another demonstration in [Showcase.md](Showcase.md))
|
(see [more examples and comparisons](/doc/showcases))
|
||||||
|
|
||||||
This project's goals roughly are to:
|
This project's goals roughly are to:
|
||||||
|
|
||||||
|
- Always retain the semantics of the source being transformed;
|
||||||
- Be idempotent (this also directly ensures that only valid haskell is
|
- Be idempotent (this also directly ensures that only valid haskell is
|
||||||
produced);
|
produced);
|
||||||
- Support the full ghc-haskell syntax including syntactic extensions;
|
- Support the full ghc-haskell syntax including syntactic extensions;
|
||||||
|
|
|
||||||
288
Showcase.md
288
Showcase.md
|
|
@ -1,288 +0,0 @@
|
||||||
# brittany showcase
|
|
||||||
|
|
||||||
We will try to take the following module and try to fit it into 80 columns.
|
|
||||||
|
|
||||||
## input
|
|
||||||
|
|
||||||
~~~~ .hs
|
|
||||||
-- 10 20 30 40 50 60 70 80
|
|
||||||
module Language.Haskell.Brittany.BriLayouter
|
|
||||||
( layoutBriDoc
|
|
||||||
)
|
|
||||||
where
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
layoutBriDoc :: Data.Data.Data ast => ast -> BriDocNumbered -> PPM ()
|
|
||||||
layoutBriDoc ast briDoc = do
|
|
||||||
-- first step: transform the briDoc.
|
|
||||||
briDoc' <- MultiRWSS.withMultiStateS BDEmpty $ do
|
|
||||||
traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw $ briDocToDoc $ unwrapBriDocNumbered $ briDoc
|
|
||||||
-- bridoc transformation: remove alts
|
|
||||||
transformAlts briDoc >>= mSet
|
|
||||||
mGet >>= traceIfDumpConf "bridoc post-alt" _dconf_dump_bridoc_simpl_alt . briDocToDoc
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet <&> transformSimplifyFloating >>= mSet
|
|
||||||
mGet >>= traceIfDumpConf "bridoc post-floating" _dconf_dump_bridoc_simpl_floating . briDocToDoc
|
|
||||||
-- bridoc transformation: par removal
|
|
||||||
mGet <&> transformSimplifyPar >>= mSet
|
|
||||||
mGet >>= traceIfDumpConf "bridoc post-par" _dconf_dump_bridoc_simpl_par . briDocToDoc
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet <&> transformSimplifyColumns >>= mSet
|
|
||||||
mGet >>= traceIfDumpConf "bridoc post-columns" _dconf_dump_bridoc_simpl_columns . briDocToDoc
|
|
||||||
-- -- bridoc transformation: indent
|
|
||||||
mGet <&> transformSimplifyIndent >>= mSet
|
|
||||||
mGet >>= traceIfDumpConf "bridoc post-indent" _dconf_dump_bridoc_simpl_indent . briDocToDoc
|
|
||||||
mGet >>= traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final . briDocToDoc
|
|
||||||
-- -- convert to Simple type
|
|
||||||
-- simpl <- mGet <&> transformToSimple
|
|
||||||
-- return simpl
|
|
||||||
|
|
||||||
anns :: ExactPrint.Types.Anns <- mAsk
|
|
||||||
let filteredAnns = filterAnns ast anns
|
|
||||||
|
|
||||||
let state = LayoutState
|
|
||||||
{ _lstate_baseY = 0
|
|
||||||
, _lstate_curY = 0
|
|
||||||
, _lstate_indLevel = 0
|
|
||||||
, _lstate_indLevelLinger = 0
|
|
||||||
, _lstate_commentsPrior = extractCommentsPrior filteredAnns
|
|
||||||
, _lstate_commentsPost = extractCommentsPost filteredAnns
|
|
||||||
, _lstate_commentCol = Nothing
|
|
||||||
, _lstate_addSepSpace = Nothing
|
|
||||||
, _lstate_inhibitMTEL = False
|
|
||||||
, _lstate_isNewline = NewLineStateInit
|
|
||||||
}
|
|
||||||
|
|
||||||
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
|
||||||
|
|
||||||
let remainingComments = Map.elems (_lstate_commentsPrior state') ++ Map.elems (_lstate_commentsPost state')
|
|
||||||
remainingComments `forM_` (mTell . (:[]) . LayoutErrorUnusedComment . show . fmap fst)
|
|
||||||
|
|
||||||
return $ ()
|
|
||||||
~~~~
|
|
||||||
|
|
||||||
## `brittany` output
|
|
||||||
|
|
||||||
~~~~ .hs
|
|
||||||
-- 10 20 30 40 50 60 70 80
|
|
||||||
module Language.Haskell.Brittany.BriLayouter
|
|
||||||
( layoutBriDoc
|
|
||||||
)
|
|
||||||
where
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
layoutBriDoc :: Data.Data.Data ast => ast -> BriDocNumbered -> PPM ()
|
|
||||||
layoutBriDoc ast briDoc = do
|
|
||||||
-- first step: transform the briDoc.
|
|
||||||
briDoc' <- MultiRWSS.withMultiStateS BDEmpty $ do
|
|
||||||
traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw
|
|
||||||
$ briDocToDoc
|
|
||||||
$ unwrapBriDocNumbered
|
|
||||||
$ briDoc
|
|
||||||
-- bridoc transformation: remove alts
|
|
||||||
transformAlts briDoc >>= mSet
|
|
||||||
mGet
|
|
||||||
>>= traceIfDumpConf "bridoc post-alt" _dconf_dump_bridoc_simpl_alt
|
|
||||||
. briDocToDoc
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet <&> transformSimplifyFloating >>= mSet
|
|
||||||
mGet
|
|
||||||
>>= traceIfDumpConf "bridoc post-floating"
|
|
||||||
_dconf_dump_bridoc_simpl_floating
|
|
||||||
. briDocToDoc
|
|
||||||
-- bridoc transformation: par removal
|
|
||||||
mGet <&> transformSimplifyPar >>= mSet
|
|
||||||
mGet
|
|
||||||
>>= traceIfDumpConf "bridoc post-par" _dconf_dump_bridoc_simpl_par
|
|
||||||
. briDocToDoc
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet <&> transformSimplifyColumns >>= mSet
|
|
||||||
mGet
|
|
||||||
>>= traceIfDumpConf "bridoc post-columns" _dconf_dump_bridoc_simpl_columns
|
|
||||||
. briDocToDoc
|
|
||||||
-- -- bridoc transformation: indent
|
|
||||||
mGet <&> transformSimplifyIndent >>= mSet
|
|
||||||
mGet
|
|
||||||
>>= traceIfDumpConf "bridoc post-indent" _dconf_dump_bridoc_simpl_indent
|
|
||||||
. briDocToDoc
|
|
||||||
mGet
|
|
||||||
>>= traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final
|
|
||||||
. briDocToDoc
|
|
||||||
-- -- convert to Simple type
|
|
||||||
-- simpl <- mGet <&> transformToSimple
|
|
||||||
-- return simpl
|
|
||||||
|
|
||||||
anns :: ExactPrint.Types.Anns <- mAsk
|
|
||||||
let filteredAnns = filterAnns ast anns
|
|
||||||
|
|
||||||
let state = LayoutState
|
|
||||||
{ _lstate_baseY = 0
|
|
||||||
, _lstate_curY = 0
|
|
||||||
, _lstate_indLevel = 0
|
|
||||||
, _lstate_indLevelLinger = 0
|
|
||||||
, _lstate_commentsPrior = extractCommentsPrior filteredAnns
|
|
||||||
, _lstate_commentsPost = extractCommentsPost filteredAnns
|
|
||||||
, _lstate_commentCol = Nothing
|
|
||||||
, _lstate_addSepSpace = Nothing
|
|
||||||
, _lstate_inhibitMTEL = False
|
|
||||||
, _lstate_isNewline = NewLineStateInit
|
|
||||||
}
|
|
||||||
|
|
||||||
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
|
||||||
|
|
||||||
let remainingComments = Map.elems (_lstate_commentsPrior state')
|
|
||||||
++ Map.elems (_lstate_commentsPost state')
|
|
||||||
remainingComments
|
|
||||||
`forM_` (mTell . (:[]) . LayoutErrorUnusedComment . show . fmap fst)
|
|
||||||
|
|
||||||
return $ ()
|
|
||||||
~~~~
|
|
||||||
|
|
||||||
In contrast, let us look at Chris Done's `hindent` (version `5.2.1`) re-formatting results for the same input:
|
|
||||||
|
|
||||||
## `hindent` output
|
|
||||||
|
|
||||||
~~~~ .hs
|
|
||||||
-- 10 20 30 40 50 60 70 80
|
|
||||||
module Language.Haskell.Brittany.BriLayouter
|
|
||||||
( layoutBriDoc
|
|
||||||
) where
|
|
||||||
|
|
||||||
layoutBriDoc
|
|
||||||
:: Data.Data.Data ast
|
|
||||||
=> ast -> BriDocNumbered -> PPM ()
|
|
||||||
layoutBriDoc ast briDoc
|
|
||||||
-- first step: transform the briDoc.
|
|
||||||
= do
|
|
||||||
briDoc' <-
|
|
||||||
MultiRWSS.withMultiStateS BDEmpty $ do
|
|
||||||
traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw $
|
|
||||||
briDocToDoc $ unwrapBriDocNumbered $ briDoc
|
|
||||||
-- bridoc transformation: remove alts
|
|
||||||
transformAlts briDoc >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-alt" _dconf_dump_bridoc_simpl_alt .
|
|
||||||
briDocToDoc
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet <&> transformSimplifyFloating >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-floating" _dconf_dump_bridoc_simpl_floating .
|
|
||||||
briDocToDoc
|
|
||||||
-- bridoc transformation: par removal
|
|
||||||
mGet <&> transformSimplifyPar >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-par" _dconf_dump_bridoc_simpl_par .
|
|
||||||
briDocToDoc
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet <&> transformSimplifyColumns >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-columns" _dconf_dump_bridoc_simpl_columns .
|
|
||||||
briDocToDoc
|
|
||||||
-- -- bridoc transformation: indent
|
|
||||||
mGet <&> transformSimplifyIndent >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-indent" _dconf_dump_bridoc_simpl_indent .
|
|
||||||
briDocToDoc
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final . briDocToDoc
|
|
||||||
-- -- convert to Simple type
|
|
||||||
-- simpl <- mGet <&> transformToSimple
|
|
||||||
-- return simpl
|
|
||||||
anns :: ExactPrint.Types.Anns <- mAsk
|
|
||||||
let filteredAnns = filterAnns ast anns
|
|
||||||
let state =
|
|
||||||
LayoutState
|
|
||||||
{ _lstate_baseY = 0
|
|
||||||
, _lstate_curY = 0
|
|
||||||
, _lstate_indLevel = 0
|
|
||||||
, _lstate_indLevelLinger = 0
|
|
||||||
, _lstate_commentsPrior = extractCommentsPrior filteredAnns
|
|
||||||
, _lstate_commentsPost = extractCommentsPost filteredAnns
|
|
||||||
, _lstate_commentCol = Nothing
|
|
||||||
, _lstate_addSepSpace = Nothing
|
|
||||||
, _lstate_inhibitMTEL = False
|
|
||||||
, _lstate_isNewline = NewLineStateInit
|
|
||||||
}
|
|
||||||
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
|
||||||
let remainingComments =
|
|
||||||
Map.elems (_lstate_commentsPrior state') ++
|
|
||||||
Map.elems (_lstate_commentsPost state')
|
|
||||||
remainingComments `forM_`
|
|
||||||
(mTell . (: []) . LayoutErrorUnusedComment . show . fmap fst)
|
|
||||||
return $ ()
|
|
||||||
~~~~
|
|
||||||
|
|
||||||
and haskell-formatter (version 1.0.0)
|
|
||||||
|
|
||||||
## `haskell-formatter` output
|
|
||||||
|
|
||||||
~~~~ .hs
|
|
||||||
-- 10 20 30 40 50 60 70 80
|
|
||||||
module Language.Haskell.Brittany.BriLayouter (layoutBriDoc) where
|
|
||||||
|
|
||||||
layoutBriDoc :: Data.Data.Data ast => ast -> BriDocNumbered -> PPM ()
|
|
||||||
layoutBriDoc ast briDoc
|
|
||||||
-- first step: transform the briDoc.
|
|
||||||
= do briDoc' <- MultiRWSS.withMultiStateS BDEmpty $
|
|
||||||
do traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw $
|
|
||||||
briDocToDoc $ unwrapBriDocNumbered $ briDoc
|
|
||||||
-- bridoc transformation: remove alts
|
|
||||||
transformAlts briDoc >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-alt"
|
|
||||||
_dconf_dump_bridoc_simpl_alt
|
|
||||||
. briDocToDoc
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet <&> transformSimplifyFloating >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-floating"
|
|
||||||
_dconf_dump_bridoc_simpl_floating
|
|
||||||
. briDocToDoc
|
|
||||||
-- bridoc transformation: par removal
|
|
||||||
mGet <&> transformSimplifyPar >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-par"
|
|
||||||
_dconf_dump_bridoc_simpl_par
|
|
||||||
. briDocToDoc
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet <&> transformSimplifyColumns >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-columns"
|
|
||||||
_dconf_dump_bridoc_simpl_columns
|
|
||||||
. briDocToDoc
|
|
||||||
-- -- bridoc transformation: indent
|
|
||||||
mGet <&> transformSimplifyIndent >>= mSet
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc post-indent"
|
|
||||||
_dconf_dump_bridoc_simpl_indent
|
|
||||||
. briDocToDoc
|
|
||||||
mGet >>=
|
|
||||||
traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final
|
|
||||||
. briDocToDoc
|
|
||||||
-- -- convert to Simple type
|
|
||||||
-- simpl <- mGet <&> transformToSimple
|
|
||||||
-- return simpl
|
|
||||||
anns :: ExactPrint.Types.Anns <- mAsk
|
|
||||||
let filteredAnns = filterAnns ast anns
|
|
||||||
let state
|
|
||||||
= LayoutState{_lstate_baseY = 0, _lstate_curY = 0,
|
|
||||||
_lstate_indLevel = 0, _lstate_indLevelLinger = 0,
|
|
||||||
_lstate_commentsPrior =
|
|
||||||
extractCommentsPrior filteredAnns,
|
|
||||||
_lstate_commentsPost =
|
|
||||||
extractCommentsPost filteredAnns,
|
|
||||||
_lstate_commentCol = Nothing,
|
|
||||||
_lstate_addSepSpace = Nothing,
|
|
||||||
_lstate_inhibitMTEL = False,
|
|
||||||
_lstate_isNewline = NewLineStateInit}
|
|
||||||
|
|
||||||
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
|
||||||
let remainingComments
|
|
||||||
= Map.elems (_lstate_commentsPrior state') ++
|
|
||||||
Map.elems (_lstate_commentsPost state')
|
|
||||||
remainingComments `forM_`
|
|
||||||
(mTell . (: []) . LayoutErrorUnusedComment . show . fmap fst)
|
|
||||||
return $ ()
|
|
||||||
~~~~
|
|
||||||
|
|
@ -0,0 +1,522 @@
|
||||||
|
|
||||||
|
versions used:
|
||||||
|
|
||||||
|
- brittany-0.8.0.1
|
||||||
|
- hindent-5.2.3
|
||||||
|
- haskell-formatter-1.0.0
|
||||||
|
|
||||||
|
## simple nested ifs
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
--------------------------------------------------------------- vvv brittany vvv
|
||||||
|
mybinding = if condition1
|
||||||
|
then if condition2
|
||||||
|
then if condition3 then 0 else 1
|
||||||
|
else if condition3 then 2 else 3
|
||||||
|
else 4
|
||||||
|
---------------------------------------------------------------- vvv hindent vvv
|
||||||
|
mybinding =
|
||||||
|
if condition1
|
||||||
|
then if condition2
|
||||||
|
then if condition3
|
||||||
|
then 0
|
||||||
|
else 1
|
||||||
|
else if condition3
|
||||||
|
then 2
|
||||||
|
else 3
|
||||||
|
else 4
|
||||||
|
------------------------------------------------------ vvv haskell-formatter vvv
|
||||||
|
mybinding
|
||||||
|
= if condition1 then
|
||||||
|
if condition2 then if condition3 then 0 else 1 else
|
||||||
|
if condition3 then 2 else 3
|
||||||
|
else 4
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
## monad comprehension + alignment
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
-- 10 20 30 40 50 60 70 80
|
||||||
|
--------------------------------------------------------------- vvv brittany vvv
|
||||||
|
myBinding =
|
||||||
|
[ [ [ LeguEosb r1 (n2 - r1) fxvoNz ymuSreje v
|
||||||
|
, LeguEosb n2 (f3 - n2) oyphEmedn ymuSreje v
|
||||||
|
, LeguEosb f3 (i4 - f3) fxvoNz ymuSreje v
|
||||||
|
, LeguEosb i4 (v5 - i4) oieha ymuSreje v
|
||||||
|
, LeguEosb v5 (j6 - v5) fxvoNz ymuSreje v
|
||||||
|
]
|
||||||
|
| oyphEmedn <- sdliWmguje
|
||||||
|
, oieha <- ohzvIp
|
||||||
|
]
|
||||||
|
| v5 < j6
|
||||||
|
, sdliWmguje <- zedoaregeuKilb tua1
|
||||||
|
, ohzvIp <- zedoaregeuKilb (0 - loy2)
|
||||||
|
]
|
||||||
|
---------------------------------------------------------------- vvv hindent vvv
|
||||||
|
myBinding =
|
||||||
|
[ [ [ LeguEosb r1 (n2 - r1) fxvoNz ymuSreje v
|
||||||
|
, LeguEosb n2 (f3 - n2) oyphEmedn ymuSreje v
|
||||||
|
, LeguEosb f3 (i4 - f3) fxvoNz ymuSreje v
|
||||||
|
, LeguEosb i4 (v5 - i4) oieha ymuSreje v
|
||||||
|
, LeguEosb v5 (j6 - v5) fxvoNz ymuSreje v
|
||||||
|
]
|
||||||
|
| oyphEmedn <- sdliWmguje
|
||||||
|
, oieha <- ohzvIp
|
||||||
|
]
|
||||||
|
| v5 < j6
|
||||||
|
, sdliWmguje <- zedoaregeuKilb tua1
|
||||||
|
, ohzvIp <- zedoaregeuKilb (0 - loy2)
|
||||||
|
]
|
||||||
|
------------------------------------------------------ vvv haskell-formatter vvv
|
||||||
|
myBinding
|
||||||
|
= [[[LeguEosb r1 (n2 - r1) fxvoNz ymuSreje v,
|
||||||
|
LeguEosb n2 (f3 - n2) oyphEmedn ymuSreje v,
|
||||||
|
LeguEosb f3 (i4 - f3) fxvoNz ymuSreje v,
|
||||||
|
LeguEosb i4 (v5 - i4) oieha ymuSreje v,
|
||||||
|
LeguEosb v5 (j6 - v5) fxvoNz ymuSreje v]
|
||||||
|
|
||||||
|
| oyphEmedn <- sdliWmguje, oieha <- ohzvIp]
|
||||||
|
|
||||||
|
| v5 < j6, sdliWmguje <- zedoaregeuKilb tua1,
|
||||||
|
ohzvIp <- zedoaregeuKilb (0 - loy2)]
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
## tricky full line usage
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
-- 10 20 30 40 50 60 70 80
|
||||||
|
--------------------------------------------------------------- vvv brittany vvv
|
||||||
|
mybinding = RH.performEvent_ $ postBuild <&> \() -> liftIO $ do
|
||||||
|
runMaybeT postCliInit >>= \case
|
||||||
|
Nothing -> return ()
|
||||||
|
Just () -> do
|
||||||
|
_ <- forkIO $ postCliInitAsync `catch` \(e :: SomeException) ->
|
||||||
|
writeLogS LogLevelError (show e)
|
||||||
|
return ()
|
||||||
|
---------------------------------------------------------------- vvv hindent vvv
|
||||||
|
mybinding =
|
||||||
|
RH.performEvent_ $
|
||||||
|
postBuild <&> \() ->
|
||||||
|
liftIO $ do
|
||||||
|
runMaybeT postCliInit >>= \case
|
||||||
|
Nothing -> return ()
|
||||||
|
Just () -> do
|
||||||
|
_ <-
|
||||||
|
forkIO $
|
||||||
|
postCliInitAsync `catch` \(e :: SomeException) ->
|
||||||
|
writeLogS LogLevelError (show e)
|
||||||
|
return ()
|
||||||
|
------------------------------------------------------ vvv haskell-formatter vvv
|
||||||
|
mybinding
|
||||||
|
= RH.performEvent_ $
|
||||||
|
postBuild <&>
|
||||||
|
\ () ->
|
||||||
|
liftIO $
|
||||||
|
do runMaybeT postCliInit >>=
|
||||||
|
\case
|
||||||
|
Nothing -> return ()
|
||||||
|
Just () -> do _ <- forkIO $
|
||||||
|
postCliInitAsync `catch`
|
||||||
|
\ (e :: SomeException) ->
|
||||||
|
writeLogS LogLevelError (show e)
|
||||||
|
return ()
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
## long type signature
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
-- 10 20 30 40 50 60 70 80
|
||||||
|
--------------------------------------------------------------- vvv brittany vvv
|
||||||
|
linewise
|
||||||
|
:: forall n t
|
||||||
|
. (Ord n, R.ReflexHost t, MonadIO (R.PushM t), MonadIO (R.HostFrame t))
|
||||||
|
=> ( R.Event t Text -- command string executed by user
|
||||||
|
-> R.Dynamic t (Maybe Text, Int, Text)
|
||||||
|
-> R.Behavior t (Seq Text) -- history
|
||||||
|
-> R.Event t () -- post-shutdown
|
||||||
|
-> RH.AppHost
|
||||||
|
t
|
||||||
|
( R.Event t () -- shutdown trigger
|
||||||
|
, R.Behavior t String -- tab-completion value
|
||||||
|
, R.Dynamic t (Widget n)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
-> RH.AppHost t ()
|
||||||
|
---------------------------------------------------------------- vvv hindent vvv
|
||||||
|
-- (overflowing columns)
|
||||||
|
linewise ::
|
||||||
|
forall n t.
|
||||||
|
(Ord n, R.ReflexHost t, MonadIO (R.PushM t), MonadIO (R.HostFrame t))
|
||||||
|
=> (R.Event t Text -- command string executed by user
|
||||||
|
-> R.Dynamic t (Maybe Text, Int, Text) -> R.Behavior t (Seq Text) -- history
|
||||||
|
-> R.Event t () -- post-shutdown
|
||||||
|
-> RH.AppHost t ( R.Event t () -- shutdown trigger
|
||||||
|
, R.Behavior t String -- tab-completion value
|
||||||
|
, R.Dynamic t (Widget n)))
|
||||||
|
-> RH.AppHost t ()
|
||||||
|
------------------------------------------------------ vvv haskell-formatter vvv
|
||||||
|
linewise ::
|
||||||
|
forall n t .
|
||||||
|
(Ord n, R.ReflexHost t, MonadIO (R.PushM t),
|
||||||
|
MonadIO (R.HostFrame t)) =>
|
||||||
|
(R.Event t Text ->
|
||||||
|
-- command string executed by user
|
||||||
|
R.Dynamic t (Maybe Text, Int, Text) ->
|
||||||
|
R.Behavior t (Seq Text) ->
|
||||||
|
-- history
|
||||||
|
R.Event t () ->
|
||||||
|
-- post-shutdown
|
||||||
|
RH.AppHost t
|
||||||
|
-- shutdown trigger
|
||||||
|
(R.Event t (), R.Behavior t String,
|
||||||
|
-- tab-completion value
|
||||||
|
R.Dynamic t (Widget n)))
|
||||||
|
|
||||||
|
-> RH.AppHost t ()
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
## slighly longer mix of different constructs
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
-- 10 20 30 40 50 60 70 80
|
||||||
|
--------------------------------------------------------------- vvv brittany vvv
|
||||||
|
completion :: String -> CommandDesc a -> String -> String
|
||||||
|
completion cmdline desc pcRest =
|
||||||
|
List.drop (List.length lastWord) $ case choices of
|
||||||
|
[] -> ""
|
||||||
|
(c1:cr) ->
|
||||||
|
headDef ""
|
||||||
|
$ filter (\s -> List.all (s`isPrefixOf`) cr)
|
||||||
|
$ reverse
|
||||||
|
$ List.inits c1
|
||||||
|
where
|
||||||
|
nameDesc = case _cmd_mParent desc of
|
||||||
|
Nothing -> desc
|
||||||
|
Just (_, parent) | null pcRest -> parent
|
||||||
|
Just{} -> desc
|
||||||
|
lastWord = reverse $ takeWhile (not . isSpace) $ reverse $ cmdline
|
||||||
|
choices = join
|
||||||
|
[ [ r
|
||||||
|
| Just r <- Foldable.toList (_cmd_children nameDesc)
|
||||||
|
<&> \(s, _) -> [ s | lastWord `isPrefixOf` s ]
|
||||||
|
]
|
||||||
|
, [ s
|
||||||
|
| s <- transPartDesc =<< _cmd_parts nameDesc
|
||||||
|
, lastWord `isPrefixOf` s
|
||||||
|
]
|
||||||
|
]
|
||||||
|
transPartDesc :: PartDesc -> [String]
|
||||||
|
transPartDesc = \case
|
||||||
|
PartLiteral s -> [s]
|
||||||
|
PartVariable _ -> []
|
||||||
|
PartOptional x -> transPartDesc x
|
||||||
|
PartAlts alts -> alts >>= transPartDesc
|
||||||
|
PartSeq [] -> []
|
||||||
|
PartSeq (x:_) -> transPartDesc x
|
||||||
|
PartDefault _ x -> transPartDesc x
|
||||||
|
PartSuggestion ss x -> ss ++ transPartDesc x
|
||||||
|
PartRedirect _ x -> transPartDesc x
|
||||||
|
PartReorder xs -> xs >>= transPartDesc
|
||||||
|
PartMany x -> transPartDesc x
|
||||||
|
PartWithHelp _h x -> transPartDesc x
|
||||||
|
---------------------------------------------------------------- vvv hindent vvv
|
||||||
|
completion :: String -> CommandDesc a -> String -> String
|
||||||
|
completion cmdline desc pcRest =
|
||||||
|
List.drop (List.length lastWord) $
|
||||||
|
case choices of
|
||||||
|
[] -> ""
|
||||||
|
(c1:cr) ->
|
||||||
|
headDef "" $
|
||||||
|
filter (\s -> List.all (s `isPrefixOf`) cr) $ reverse $ List.inits c1
|
||||||
|
where
|
||||||
|
nameDesc =
|
||||||
|
case _cmd_mParent desc of
|
||||||
|
Nothing -> desc
|
||||||
|
Just (_, parent)
|
||||||
|
| null pcRest -> parent
|
||||||
|
Just {} -> desc
|
||||||
|
lastWord = reverse $ takeWhile (not . isSpace) $ reverse $ cmdline
|
||||||
|
choices =
|
||||||
|
join
|
||||||
|
[ [ r
|
||||||
|
| Just r <-
|
||||||
|
Foldable.toList (_cmd_children nameDesc) <&> \(s, _) ->
|
||||||
|
[s | lastWord `isPrefixOf` s]
|
||||||
|
]
|
||||||
|
, [ s
|
||||||
|
| s <- transPartDesc =<< _cmd_parts nameDesc
|
||||||
|
, lastWord `isPrefixOf` s
|
||||||
|
]
|
||||||
|
]
|
||||||
|
transPartDesc :: PartDesc -> [String]
|
||||||
|
transPartDesc =
|
||||||
|
\case
|
||||||
|
PartLiteral s -> [s]
|
||||||
|
PartVariable _ -> []
|
||||||
|
PartOptional x -> transPartDesc x
|
||||||
|
PartAlts alts -> alts >>= transPartDesc
|
||||||
|
PartSeq [] -> []
|
||||||
|
PartSeq (x:_) -> transPartDesc x
|
||||||
|
PartDefault _ x -> transPartDesc x
|
||||||
|
PartSuggestion ss x -> ss ++ transPartDesc x
|
||||||
|
PartRedirect _ x -> transPartDesc x
|
||||||
|
PartReorder xs -> xs >>= transPartDesc
|
||||||
|
PartMany x -> transPartDesc x
|
||||||
|
PartWithHelp _h x -> transPartDesc x
|
||||||
|
------------------------------------------------------ vvv haskell-formatter vvv
|
||||||
|
completion :: String -> CommandDesc a -> String -> String
|
||||||
|
completion cmdline desc pcRest
|
||||||
|
= List.drop (List.length lastWord) $
|
||||||
|
case choices of
|
||||||
|
[] -> ""
|
||||||
|
(c1 : cr) -> headDef "" $
|
||||||
|
filter (\ s -> List.all (s `isPrefixOf`) cr) $
|
||||||
|
reverse $ List.inits c1
|
||||||
|
|
||||||
|
where nameDesc
|
||||||
|
= case _cmd_mParent desc of
|
||||||
|
Nothing -> desc
|
||||||
|
Just (_, parent) | null pcRest -> parent
|
||||||
|
Just{} -> desc
|
||||||
|
lastWord = reverse $ takeWhile (not . isSpace) $ reverse $ cmdline
|
||||||
|
choices
|
||||||
|
= join
|
||||||
|
[[r |
|
||||||
|
Just r <- Foldable.toList (_cmd_children nameDesc) <&>
|
||||||
|
\ (s, _) -> [s | lastWord `isPrefixOf` s]],
|
||||||
|
|
||||||
|
[s | s <- transPartDesc =<< _cmd_parts nameDesc,
|
||||||
|
lastWord `isPrefixOf` s]]
|
||||||
|
|
||||||
|
transPartDesc :: PartDesc -> [String]
|
||||||
|
transPartDesc
|
||||||
|
= \case
|
||||||
|
PartLiteral s -> [s]
|
||||||
|
PartVariable _ -> []
|
||||||
|
PartOptional x -> transPartDesc x
|
||||||
|
PartAlts alts -> alts >>= transPartDesc
|
||||||
|
PartSeq [] -> []
|
||||||
|
PartSeq (x : _) -> transPartDesc x
|
||||||
|
PartDefault _ x -> transPartDesc x
|
||||||
|
PartSuggestion ss x -> ss ++ transPartDesc x
|
||||||
|
PartRedirect _ x -> transPartDesc x
|
||||||
|
PartReorder xs -> xs >>= transPartDesc
|
||||||
|
PartMany x -> transPartDesc x
|
||||||
|
PartWithHelp _h x -> transPartDesc x
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
## another long example; full module
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
-- 10 20 30 40 50 60 70 80
|
||||||
|
--------------------------------------------------------------- vvv brittany vvv
|
||||||
|
module Language.Haskell.Brittany.BriLayouter
|
||||||
|
( layoutBriDoc
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
layoutBriDoc :: Data.Data.Data ast => ast -> BriDocNumbered -> PPM ()
|
||||||
|
layoutBriDoc ast briDoc = do
|
||||||
|
-- first step: transform the briDoc.
|
||||||
|
briDoc' <- MultiRWSS.withMultiStateS BDEmpty $ do
|
||||||
|
traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw
|
||||||
|
$ briDocToDoc
|
||||||
|
$ unwrapBriDocNumbered
|
||||||
|
$ briDoc
|
||||||
|
-- bridoc transformation: remove alts
|
||||||
|
transformAlts briDoc >>= mSet
|
||||||
|
mGet
|
||||||
|
>>= traceIfDumpConf "bridoc post-alt" _dconf_dump_bridoc_simpl_alt
|
||||||
|
. briDocToDoc
|
||||||
|
-- bridoc transformation: float stuff in
|
||||||
|
mGet <&> transformSimplifyFloating >>= mSet
|
||||||
|
mGet
|
||||||
|
>>= traceIfDumpConf "bridoc post-floating"
|
||||||
|
_dconf_dump_bridoc_simpl_floating
|
||||||
|
. briDocToDoc
|
||||||
|
-- bridoc transformation: par removal
|
||||||
|
mGet <&> transformSimplifyPar >>= mSet
|
||||||
|
mGet
|
||||||
|
>>= traceIfDumpConf "bridoc post-par" _dconf_dump_bridoc_simpl_par
|
||||||
|
. briDocToDoc
|
||||||
|
-- bridoc transformation: float stuff in
|
||||||
|
mGet <&> transformSimplifyColumns >>= mSet
|
||||||
|
mGet
|
||||||
|
>>= traceIfDumpConf "bridoc post-columns" _dconf_dump_bridoc_simpl_columns
|
||||||
|
. briDocToDoc
|
||||||
|
-- -- bridoc transformation: indent
|
||||||
|
mGet <&> transformSimplifyIndent >>= mSet
|
||||||
|
mGet
|
||||||
|
>>= traceIfDumpConf "bridoc post-indent" _dconf_dump_bridoc_simpl_indent
|
||||||
|
. briDocToDoc
|
||||||
|
mGet
|
||||||
|
>>= traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final
|
||||||
|
. briDocToDoc
|
||||||
|
-- -- convert to Simple type
|
||||||
|
-- simpl <- mGet <&> transformToSimple
|
||||||
|
-- return simpl
|
||||||
|
|
||||||
|
anns :: ExactPrint.Types.Anns <- mAsk
|
||||||
|
let filteredAnns = filterAnns ast anns
|
||||||
|
|
||||||
|
let state = LayoutState
|
||||||
|
{ _lstate_baseY = 0
|
||||||
|
, _lstate_curY = 0
|
||||||
|
, _lstate_indLevel = 0
|
||||||
|
, _lstate_indLevelLinger = 0
|
||||||
|
, _lstate_commentsPrior = extractCommentsPrior filteredAnns
|
||||||
|
, _lstate_commentsPost = extractCommentsPost filteredAnns
|
||||||
|
, _lstate_commentCol = Nothing
|
||||||
|
, _lstate_addSepSpace = Nothing
|
||||||
|
, _lstate_inhibitMTEL = False
|
||||||
|
, _lstate_isNewline = NewLineStateInit
|
||||||
|
}
|
||||||
|
|
||||||
|
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
||||||
|
|
||||||
|
let remainingComments = Map.elems (_lstate_commentsPrior state')
|
||||||
|
++ Map.elems (_lstate_commentsPost state')
|
||||||
|
remainingComments
|
||||||
|
`forM_` (mTell . (:[]) . LayoutErrorUnusedComment . show . fmap fst)
|
||||||
|
|
||||||
|
return $ ()
|
||||||
|
---------------------------------------------------------------- vvv hindent vvv
|
||||||
|
-- (overflowing columns)
|
||||||
|
module Language.Haskell.Brittany.BriLayouter
|
||||||
|
( layoutBriDoc
|
||||||
|
) where
|
||||||
|
|
||||||
|
layoutBriDoc :: Data.Data.Data ast => ast -> BriDocNumbered -> PPM ()
|
||||||
|
layoutBriDoc ast briDoc
|
||||||
|
-- first step: transform the briDoc.
|
||||||
|
= do
|
||||||
|
briDoc' <-
|
||||||
|
MultiRWSS.withMultiStateS BDEmpty $ do
|
||||||
|
traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw $
|
||||||
|
briDocToDoc $ unwrapBriDocNumbered $ briDoc
|
||||||
|
-- bridoc transformation: remove alts
|
||||||
|
transformAlts briDoc >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-alt" _dconf_dump_bridoc_simpl_alt .
|
||||||
|
briDocToDoc
|
||||||
|
-- bridoc transformation: float stuff in
|
||||||
|
mGet <&> transformSimplifyFloating >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-floating" _dconf_dump_bridoc_simpl_floating .
|
||||||
|
briDocToDoc
|
||||||
|
-- bridoc transformation: par removal
|
||||||
|
mGet <&> transformSimplifyPar >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-par" _dconf_dump_bridoc_simpl_par .
|
||||||
|
briDocToDoc
|
||||||
|
-- bridoc transformation: float stuff in
|
||||||
|
mGet <&> transformSimplifyColumns >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-columns" _dconf_dump_bridoc_simpl_columns .
|
||||||
|
briDocToDoc
|
||||||
|
-- -- bridoc transformation: indent
|
||||||
|
mGet <&> transformSimplifyIndent >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-indent" _dconf_dump_bridoc_simpl_indent .
|
||||||
|
briDocToDoc
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final . briDocToDoc
|
||||||
|
-- -- convert to Simple type
|
||||||
|
-- simpl <- mGet <&> transformToSimple
|
||||||
|
-- return simpl
|
||||||
|
anns :: ExactPrint.Types.Anns <- mAsk
|
||||||
|
let filteredAnns = filterAnns ast anns
|
||||||
|
let state =
|
||||||
|
LayoutState
|
||||||
|
{ _lstate_baseY = 0
|
||||||
|
, _lstate_curY = 0
|
||||||
|
, _lstate_indLevel = 0
|
||||||
|
, _lstate_indLevelLinger = 0
|
||||||
|
, _lstate_commentsPrior = extractCommentsPrior filteredAnns
|
||||||
|
, _lstate_commentsPost = extractCommentsPost filteredAnns
|
||||||
|
, _lstate_commentCol = Nothing
|
||||||
|
, _lstate_addSepSpace = Nothing
|
||||||
|
, _lstate_inhibitMTEL = False
|
||||||
|
, _lstate_isNewline = NewLineStateInit
|
||||||
|
}
|
||||||
|
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
||||||
|
let remainingComments =
|
||||||
|
Map.elems (_lstate_commentsPrior state') ++
|
||||||
|
Map.elems (_lstate_commentsPost state')
|
||||||
|
remainingComments `forM_`
|
||||||
|
(mTell . (: []) . LayoutErrorUnusedComment . show . fmap fst)
|
||||||
|
return $ ()
|
||||||
|
------------------------------------------------------ vvv haskell-formatter vvv
|
||||||
|
module Language.Haskell.Brittany.BriLayouter (layoutBriDoc) where
|
||||||
|
|
||||||
|
layoutBriDoc :: Data.Data.Data ast => ast -> BriDocNumbered -> PPM ()
|
||||||
|
layoutBriDoc ast briDoc
|
||||||
|
-- first step: transform the briDoc.
|
||||||
|
= do briDoc' <- MultiRWSS.withMultiStateS BDEmpty $
|
||||||
|
do traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw $
|
||||||
|
briDocToDoc $ unwrapBriDocNumbered $ briDoc
|
||||||
|
-- bridoc transformation: remove alts
|
||||||
|
transformAlts briDoc >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-alt"
|
||||||
|
_dconf_dump_bridoc_simpl_alt
|
||||||
|
. briDocToDoc
|
||||||
|
-- bridoc transformation: float stuff in
|
||||||
|
mGet <&> transformSimplifyFloating >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-floating"
|
||||||
|
_dconf_dump_bridoc_simpl_floating
|
||||||
|
. briDocToDoc
|
||||||
|
-- bridoc transformation: par removal
|
||||||
|
mGet <&> transformSimplifyPar >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-par"
|
||||||
|
_dconf_dump_bridoc_simpl_par
|
||||||
|
. briDocToDoc
|
||||||
|
-- bridoc transformation: float stuff in
|
||||||
|
mGet <&> transformSimplifyColumns >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-columns"
|
||||||
|
_dconf_dump_bridoc_simpl_columns
|
||||||
|
. briDocToDoc
|
||||||
|
-- -- bridoc transformation: indent
|
||||||
|
mGet <&> transformSimplifyIndent >>= mSet
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc post-indent"
|
||||||
|
_dconf_dump_bridoc_simpl_indent
|
||||||
|
. briDocToDoc
|
||||||
|
mGet >>=
|
||||||
|
traceIfDumpConf "bridoc final" _dconf_dump_bridoc_final
|
||||||
|
. briDocToDoc
|
||||||
|
-- -- convert to Simple type
|
||||||
|
-- simpl <- mGet <&> transformToSimple
|
||||||
|
-- return simpl
|
||||||
|
anns :: ExactPrint.Types.Anns <- mAsk
|
||||||
|
let filteredAnns = filterAnns ast anns
|
||||||
|
let state
|
||||||
|
= LayoutState{_lstate_baseY = 0, _lstate_curY = 0,
|
||||||
|
_lstate_indLevel = 0, _lstate_indLevelLinger = 0,
|
||||||
|
_lstate_commentsPrior =
|
||||||
|
extractCommentsPrior filteredAnns,
|
||||||
|
_lstate_commentsPost =
|
||||||
|
extractCommentsPost filteredAnns,
|
||||||
|
_lstate_commentCol = Nothing,
|
||||||
|
_lstate_addSepSpace = Nothing,
|
||||||
|
_lstate_inhibitMTEL = False,
|
||||||
|
_lstate_isNewline = NewLineStateInit}
|
||||||
|
|
||||||
|
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
||||||
|
let remainingComments
|
||||||
|
= Map.elems (_lstate_commentsPrior state') ++
|
||||||
|
Map.elems (_lstate_commentsPost state')
|
||||||
|
remainingComments `forM_`
|
||||||
|
(mTell . (: []) . LayoutErrorUnusedComment . show . fmap fst)
|
||||||
|
return $ ()
|
||||||
|
~~~~
|
||||||
|
|
@ -0,0 +1,98 @@
|
||||||
|
# Horizontal alignment example layouts
|
||||||
|
|
||||||
|
Last updated for brittany version `0.8.0.1`.
|
||||||
|
|
||||||
|
Brittany would layout the following bindings as displayed here. If you change
|
||||||
|
only the layout of these bindings in some way (e.g. if you initially entered
|
||||||
|
these without any alignment) and pass it through brittany, you would (again)
|
||||||
|
get the below versions.
|
||||||
|
|
||||||
|
|
||||||
|
#### basic nested alignment example
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
func (MyLongFoo abc def) = 1
|
||||||
|
func (Bar a d ) = 2
|
||||||
|
func _ = 3
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
#### alignment of function args and monadcomp bindings
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
myBinding =
|
||||||
|
[ [ [ LeguEosb r1 (n2 - r1) fxvoNz ymuSreje v
|
||||||
|
, LeguEosb n2 (f3 - n2) oyphEmedn ymuSreje v
|
||||||
|
, LeguEosb f3 (i4 - f3) fxvoNz ymuSreje v
|
||||||
|
, LeguEosb i4 (v5 - i4) oieha ymuSreje v
|
||||||
|
, LeguEosb v5 (j6 - v5) fxvoNz ymuSreje v
|
||||||
|
]
|
||||||
|
| oyphEmedn <- sdliWmguje
|
||||||
|
, oieha <- ohzvIp
|
||||||
|
]
|
||||||
|
| v5 < j6
|
||||||
|
, sdliWmguje <- zedoaregeuKilb tua1
|
||||||
|
, ohzvIp <- zedoaregeuKilb (0 - loy2)
|
||||||
|
]
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
#### pattern matching
|
||||||
|
|
||||||
|
If same number of pattern args, there is sub-alignment.
|
||||||
|
Types are not inspected in any way for this.
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
transPartDesc = \case
|
||||||
|
PartLiteral s -> [s]
|
||||||
|
PartVariable _ -> []
|
||||||
|
PartOptional x -> transPartDesc x
|
||||||
|
PartAlts alts -> alts >>= transPartDesc
|
||||||
|
PartSeq [] -> []
|
||||||
|
PartSeq (x:_) -> transPartDesc x
|
||||||
|
PartDefault _ x -> transPartDesc x
|
||||||
|
PartSuggestion ss x -> ss ++ transPartDesc x
|
||||||
|
PartRedirect _ x -> transPartDesc x
|
||||||
|
PartReorder xs -> xs >>= transPartDesc
|
||||||
|
PartMany x -> transPartDesc x
|
||||||
|
PartWithHelp _h x -> transPartDesc x
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
#### record syntax, field alignment
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
action = do
|
||||||
|
startA <- transRelPos start
|
||||||
|
s1 <- get
|
||||||
|
modify $ \s2 -> s2 { _ts_sequencePos = Nothing
|
||||||
|
, _ts_curNote = _ts_curNote s1
|
||||||
|
, _ts_curTrans = _ts_curTrans s1
|
||||||
|
, _ts_curBar = _ts_curBar s1
|
||||||
|
, _ts_curBase = _ts_curBase s1
|
||||||
|
}
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
#### items that are not single-line break up alignment
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
action = do
|
||||||
|
_ <- string "set"
|
||||||
|
bindId <- onlySpaces *> ((,) <$> getPosition <*> parserIdent)
|
||||||
|
marg <- onlySpaces *> optionMaybe (char '(' *> parserParamDef <* char ')')
|
||||||
|
localId <-
|
||||||
|
onlySpaces *> (optionMaybe $ string "in" *> onlySpaces *> parserIdent)
|
||||||
|
_ <- onlySpaces *> string "="
|
||||||
|
expr <- spaces *> parserExpr
|
||||||
|
pure $ CompNotParseItemBind bindId marg expr localId
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
consequently these `<-` are not aligned at all:
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
action = do
|
||||||
|
normVal :: Float <- expectParamE
|
||||||
|
=<< expectDynamic (Text.pack "foldInNormalize")
|
||||||
|
ResponseNode folderC folderN <- uncurry callBExpectS
|
||||||
|
=<< getKalinAndParams (Text.pack "foldInFolder")
|
||||||
|
ResponseNode foldeeC foldeeN <- uncurry callBExpectS
|
||||||
|
=<< getKalinAndParams (Text.pack "foldInFoldee")
|
||||||
|
pure $ calc normVal folderC folderN foldeeC foldeeN
|
||||||
|
~~~~
|
||||||
|
|
@ -0,0 +1,63 @@
|
||||||
|
# Syntactical element interaction example layouts
|
||||||
|
|
||||||
|
Last updated for brittany version `0.8.0.1`.
|
||||||
|
|
||||||
|
Brittany would layout the following bindings as displayed here. If you change
|
||||||
|
only the layout of these bindings in some way (e.g. if some lines overflowed
|
||||||
|
80 columns) and pass it through brittany, you would again get the below
|
||||||
|
versions.
|
||||||
|
|
||||||
|
|
||||||
|
#### Nested ifs
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
mybinding = if condition1
|
||||||
|
then if condition2
|
||||||
|
then if condition3 then 0 else 1
|
||||||
|
else if condition3 then 2 else 3
|
||||||
|
else 4
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
#### if -> case -> do
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
mybinding = if GHC.xopt GHC.Cpp dynFlags
|
||||||
|
then case cppMode of
|
||||||
|
CPPModeAbort -> do
|
||||||
|
return $ Left "Encountered -XCPP. Aborting."
|
||||||
|
CPPModeWarn -> do
|
||||||
|
putStrErrLn
|
||||||
|
$ "Warning: Encountered -XCPP."
|
||||||
|
++ " Be warned that -XCPP is not supported and that"
|
||||||
|
++ " brittany cannot check that its output is syntactically"
|
||||||
|
++ " valid in its presence."
|
||||||
|
return $ Right True
|
||||||
|
CPPModeNowarn -> return $ Right True
|
||||||
|
else return $ Right False
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
#### single line ending with start of do-block
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
mybinding = RH.performEvent_ $ postBuild <&> \() -> liftIO $ do
|
||||||
|
runMaybeT postCliInit >>= \case
|
||||||
|
Nothing -> return ()
|
||||||
|
Just () -> do
|
||||||
|
_ <- forkIO $ postCliInitAsync `catch` \(e :: SomeException) ->
|
||||||
|
writeLogS LogLevelError (show e)
|
||||||
|
return ()
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
#### record-syntax + do-block
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
myBinding = Booh
|
||||||
|
{ booh_id = name
|
||||||
|
, booh_parser = name
|
||||||
|
, booh_query = someLongFunction name ["thingy"] $ do
|
||||||
|
cps <- zu (Text.pack "thingy")
|
||||||
|
SampleRate sri <- askConfig' conf_defaultSampleRate
|
||||||
|
buildLinearState myBinding [cps]
|
||||||
|
}
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
|
@ -0,0 +1,65 @@
|
||||||
|
# Example type signature layouts
|
||||||
|
|
||||||
|
Last updated for brittany version `0.8.0.1`.
|
||||||
|
|
||||||
|
Brittany would layout the following signatures as displayed here. If you change
|
||||||
|
only the layout of these signatures in some way (e.g. if you initially entered
|
||||||
|
them as one-liners) and pass it through brittany, you would (again) get the
|
||||||
|
below versions.
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
docExt
|
||||||
|
:: (ExactPrint.Annotate.Annotate ast)
|
||||||
|
=> Located ast
|
||||||
|
-> ExactPrint.Types.Anns
|
||||||
|
-> Bool
|
||||||
|
-> ToBriDocM BriDocNumbered
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
processDefault
|
||||||
|
:: ( ExactPrint.Annotate.Annotate ast
|
||||||
|
, MonadMultiWriter Text.Builder.Builder m
|
||||||
|
, MonadMultiReader ExactPrint.Types.Anns m
|
||||||
|
)
|
||||||
|
=> Located ast
|
||||||
|
-> m ()
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
linewise
|
||||||
|
:: forall n t
|
||||||
|
. (Ord n, R.ReflexHost t, MonadIO (R.PushM t), MonadIO (R.HostFrame t))
|
||||||
|
=> ( R.Event t Text -- command string executed by user
|
||||||
|
-> R.Dynamic t (Maybe Text, Int, Text)
|
||||||
|
-> R.Behavior t (Seq Text) -- history
|
||||||
|
-> R.Event t () -- post-shutdown
|
||||||
|
-> RH.AppHost
|
||||||
|
t
|
||||||
|
( R.Event t () -- shutdown trigger
|
||||||
|
, R.Behavior t String -- tab-completion value
|
||||||
|
, R.Dynamic t (Widget n)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
-> RH.AppHost t ()
|
||||||
|
~~~~
|
||||||
|
|
||||||
|
linewise ::
|
||||||
|
forall n t.
|
||||||
|
(Ord n, R.ReflexHost t, MonadIO (R.PushM t), MonadIO (R.HostFrame t))
|
||||||
|
=> (R.Event t Text -- command string executed by user
|
||||||
|
-> R.Dynamic t (Maybe Text, Int, Text) -> R.Behavior t (Seq Text) -- history
|
||||||
|
-> R.Event t () -- post-shutdown
|
||||||
|
-> RH.AppHost t ( R.Event t () -- shutdown trigger
|
||||||
|
, R.Behavior t String -- tab-completion value
|
||||||
|
, R.Dynamic t (Widget n)))
|
||||||
|
-> RH.AppHost t ()
|
||||||
|
|
||||||
|
|
||||||
|
processDefault ::
|
||||||
|
( ExactPrint.Annotate.Annotate ast
|
||||||
|
, MonadMultiWriter Text.Builder.Builder m
|
||||||
|
, MonadMultiReader ExactPrint.Types.Anns m
|
||||||
|
)
|
||||||
|
=> Located ast
|
||||||
|
-> m ()
|
||||||
|
|
@ -0,0 +1,168 @@
|
||||||
|
|
||||||
|
### Input
|
||||||
|
|
||||||
|
contains some very long lines and strange formatting of the
|
||||||
|
list/monad-comprehension:
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
parseCalUnits :: forall m . (MonadMultiReader ParserWrapperGuard m, MonadMultiState ParserFileCache m, MonadIO m) => [GenericParser] -> [FilePath] -> m (Either Text [CalUnit])
|
||||||
|
parseCalUnits parsers inputs = fmap (fmap join . sequence) $ inputs `forM` \path -> do
|
||||||
|
readCachedFile path (\raw -> parseChunks $ createChunks $ (Text.pack path, raw))
|
||||||
|
where
|
||||||
|
|
||||||
|
createChunks :: (Text, Text) -> [(Text, [(Int, InputLine)])]
|
||||||
|
createChunks (file, input) = fmap ((,) file) $ groupBy (\a b -> grouper (snd a) (snd b)) $ dropWhile (lineIsSpace . snd) $ zip [1 ..] $ lineMapper <$> Text.lines input
|
||||||
|
where
|
||||||
|
headerParser :: Parser (Text, Bool, Text)
|
||||||
|
headerParser =
|
||||||
|
[ (Text.pack name, isMain, Text.pack typ)
|
||||||
|
| _ <- string "node", _ <- many1 $ oneOf " \t",
|
||||||
|
isMain <- fmap isJust $ optionMaybe (string "*" *> many1 (oneOf " \t")),
|
||||||
|
name <- many1 $ noneOf " \t\r\n:",
|
||||||
|
_ <- many $ oneOf " \t",
|
||||||
|
_ <- char ':',
|
||||||
|
_ <- many $ oneOf " \t",
|
||||||
|
typ <- many1 $ satisfy $ not . isSpace,
|
||||||
|
_ <- many $ oneOf " \t",
|
||||||
|
_ <- eof ]
|
||||||
|
lineMapper :: Text -> InputLine
|
||||||
|
lineMapper line = case runParser headerParser () "" line of
|
||||||
|
Left _e -> NormalLine line
|
||||||
|
Right (n, m, t) -> HeaderLine n m t
|
||||||
|
lineIsSpace :: InputLine -> Bool
|
||||||
|
lineIsSpace (NormalLine x) = Text.null $ Text.strip x
|
||||||
|
lineIsSpace _ = False
|
||||||
|
grouper :: InputLine -> InputLine -> Bool
|
||||||
|
grouper _ HeaderLine{} = False
|
||||||
|
grouper _ _ = True
|
||||||
|
|
||||||
|
parseChunks :: [(Text, [(Int, InputLine)])] -> m (Either Text [CalUnit])
|
||||||
|
parseChunks nodes = runEitherT $ sequence (uncurry parseNode <$> nodes)
|
||||||
|
where
|
||||||
|
findParser :: Text -> Maybe GenericParser
|
||||||
|
findParser pid = find (\(GenericParser p) -> parser_ident p == pid) parsers
|
||||||
|
parseNode :: Text -> [(Int, InputLine)] -> EitherT Text m CalUnit
|
||||||
|
parseNode file ((n, HeaderLine name isMain typ):rlines) = do
|
||||||
|
(GenericParser p) <- case findParser typ of
|
||||||
|
Nothing -> left $ Text.pack "could not find parser for node \"" <> name <> Text.pack "\" of type \"" <> typ <> Text.pack "\" at " <> file <> Text.pack (": " ++ show n ++ ".")
|
||||||
|
Just x -> return x
|
||||||
|
let firstLine = fromMaybe 0 $ fst <$> listToMaybe rlines
|
||||||
|
ParserDataStore dstore version <- _pfc_store <$> mGet
|
||||||
|
let postfix = Text.pack "\n(When parsing node \"" <> name <> Text.pack "\")"
|
||||||
|
parsed <- bimapEitherT (<>postfix) id $ hoistEither $ parser_parse p file firstLine $ Text.unlines $ [ fst $ Text.breakOn (Text.pack "--") line | (_, NormalLine line) <- rlines ]
|
||||||
|
let oldDat = case M.lookup name dstore of
|
||||||
|
Nothing -> parser_zero p $> version
|
||||||
|
Just s -> case decodeOrFail s of
|
||||||
|
Right (rest, _, decoded) | BSL.null rest -> decoded
|
||||||
|
_ -> parser_zero p $> version
|
||||||
|
let (newDat, delta) = parser_diff p version oldDat (parsed $> version)
|
||||||
|
pfc <- mGet
|
||||||
|
mSet $ pfc { _pfc_store = ParserDataStore (M.insert name (encode newDat) dstore) version }
|
||||||
|
let calUnit = parser_build p version name (newDat, delta)
|
||||||
|
return $ CalUnit isMain calUnit
|
||||||
|
parseNode file ((n, _):_) = left $ Text.pack "expected node definition at " <> file <> Text.pack (": " ++ show n ++ ".")
|
||||||
|
parseNode file _ = left $ Text.pack "expected node definition at " <> file <> Text.pack "."
|
||||||
|
~~~~.hs
|
||||||
|
|
||||||
|
### Brittany 0.8.0.1 output on default settings
|
||||||
|
|
||||||
|
~~~~.hs
|
||||||
|
parseCalUnits
|
||||||
|
:: forall m
|
||||||
|
. ( MonadMultiReader ParserWrapperGuard m
|
||||||
|
, MonadMultiState ParserFileCache m
|
||||||
|
, MonadIO m
|
||||||
|
)
|
||||||
|
=> [GenericParser]
|
||||||
|
-> [FilePath]
|
||||||
|
-> m (Either Text [CalUnit])
|
||||||
|
parseCalUnits parsers inputs =
|
||||||
|
fmap (fmap join . sequence) $ inputs `forM` \path -> do
|
||||||
|
readCachedFile
|
||||||
|
path
|
||||||
|
(\raw -> parseChunks $ createChunks $ (Text.pack path, raw))
|
||||||
|
where
|
||||||
|
|
||||||
|
createChunks :: (Text, Text) -> [(Text, [(Int, InputLine)])]
|
||||||
|
createChunks (file, input) =
|
||||||
|
fmap ((,) file)
|
||||||
|
$ groupBy (\a b -> grouper (snd a) (snd b))
|
||||||
|
$ dropWhile (lineIsSpace . snd)
|
||||||
|
$ zip [1 ..]
|
||||||
|
$ lineMapper
|
||||||
|
<$> Text.lines input
|
||||||
|
where
|
||||||
|
headerParser :: Parser (Text, Bool, Text)
|
||||||
|
headerParser =
|
||||||
|
[ (Text.pack name, isMain, Text.pack typ)
|
||||||
|
| _ <- string "node"
|
||||||
|
, _ <- many1 $ oneOf " \t"
|
||||||
|
, isMain <- fmap isJust $ optionMaybe (string "*" *> many1 (oneOf " \t"))
|
||||||
|
, name <- many1 $ noneOf " \t\r\n:"
|
||||||
|
, _ <- many $ oneOf " \t"
|
||||||
|
, _ <- char ':'
|
||||||
|
, _ <- many $ oneOf " \t"
|
||||||
|
, typ <- many1 $ satisfy $ not . isSpace
|
||||||
|
, _ <- many $ oneOf " \t"
|
||||||
|
, _ <- eof
|
||||||
|
]
|
||||||
|
lineMapper :: Text -> InputLine
|
||||||
|
lineMapper line = case runParser headerParser () "" line of
|
||||||
|
Left _e -> NormalLine line
|
||||||
|
Right (n, m, t) -> HeaderLine n m t
|
||||||
|
lineIsSpace :: InputLine -> Bool
|
||||||
|
lineIsSpace (NormalLine x) = Text.null $ Text.strip x
|
||||||
|
lineIsSpace _ = False
|
||||||
|
grouper :: InputLine -> InputLine -> Bool
|
||||||
|
grouper _ HeaderLine{} = False
|
||||||
|
grouper _ _ = True
|
||||||
|
|
||||||
|
parseChunks :: [(Text, [(Int, InputLine)])] -> m (Either Text [CalUnit])
|
||||||
|
parseChunks nodes = runEitherT $ sequence (uncurry parseNode <$> nodes)
|
||||||
|
where
|
||||||
|
findParser :: Text -> Maybe GenericParser
|
||||||
|
findParser pid = find (\(GenericParser p) -> parser_ident p == pid) parsers
|
||||||
|
parseNode :: Text -> [(Int, InputLine)] -> EitherT Text m CalUnit
|
||||||
|
parseNode file ((n, HeaderLine name isMain typ):rlines) = do
|
||||||
|
(GenericParser p) <- case findParser typ of
|
||||||
|
Nothing ->
|
||||||
|
left
|
||||||
|
$ Text.pack "could not find parser for node \""
|
||||||
|
<> name
|
||||||
|
<> Text.pack "\" of type \""
|
||||||
|
<> typ
|
||||||
|
<> Text.pack "\" at "
|
||||||
|
<> file
|
||||||
|
<> Text.pack (": " ++ show n ++ ".")
|
||||||
|
Just x -> return x
|
||||||
|
let firstLine = fromMaybe 0 $ fst <$> listToMaybe rlines
|
||||||
|
ParserDataStore dstore version <- _pfc_store <$> mGet
|
||||||
|
let postfix =
|
||||||
|
Text.pack "\n(When parsing node \"" <> name <> Text.pack "\")"
|
||||||
|
parsed <-
|
||||||
|
bimapEitherT (<>postfix) id
|
||||||
|
$ hoistEither
|
||||||
|
$ parser_parse p file firstLine
|
||||||
|
$ Text.unlines
|
||||||
|
$ [ fst $ Text.breakOn (Text.pack "--") line
|
||||||
|
| (_, NormalLine line) <- rlines
|
||||||
|
]
|
||||||
|
let oldDat = case M.lookup name dstore of
|
||||||
|
Nothing -> parser_zero p $> version
|
||||||
|
Just s -> case decodeOrFail s of
|
||||||
|
Right (rest, _, decoded) | BSL.null rest -> decoded
|
||||||
|
_ -> parser_zero p $> version
|
||||||
|
let (newDat, delta) = parser_diff p version oldDat (parsed $> version)
|
||||||
|
pfc <- mGet
|
||||||
|
mSet $ pfc
|
||||||
|
{ _pfc_store = ParserDataStore (M.insert name (encode newDat) dstore)
|
||||||
|
version
|
||||||
|
}
|
||||||
|
let calUnit = parser_build p version name (newDat, delta)
|
||||||
|
return $ CalUnit isMain calUnit
|
||||||
|
parseNode file ((n, _):_) =
|
||||||
|
left $ Text.pack "expected node definition at " <> file <> Text.pack
|
||||||
|
(": " ++ show n ++ ".")
|
||||||
|
parseNode file _ =
|
||||||
|
left $ Text.pack "expected node definition at " <> file <> Text.pack "."
|
||||||
|
~~~~
|
||||||
Loading…
Reference in New Issue