Add support for Implicit Params #247

Merged
pepeiborra merged 2 commits from master into master 2019-07-24 00:09:35 +02:00
3 changed files with 49 additions and 5 deletions

View File

@ -140,3 +140,19 @@ foo = #bar
#test applied and composed label #test applied and composed label
{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLabels #-}
foo = #bar . #baz $ fmap #foo xs foo = #bar . #baz $ fmap #foo xs
###############################################################################
## ImplicitParams
#test IP usage
{-# LANGUAGE ImplicitParams #-}
foo = ?bar
#test IP binding
{-# LANGUAGE ImplicitParams #-}
foo = let ?bar = Foo in value
#test IP type signature
{-# LANGUAGE ImplicitParams #-}
foo :: (?bar::Bool) => ()
foo = ()

View File

@ -32,6 +32,7 @@ import GHC ( runGhc
, AnnKeywordId(..) , AnnKeywordId(..)
) )
import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc ) import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc )
import qualified FastString
import HsSyn import HsSyn
#if MIN_VERSION_ghc(8,6,0) #if MIN_VERSION_ghc(8,6,0)
import HsExtension (NoExt (..)) import HsExtension (NoExt (..))
@ -231,6 +232,23 @@ layoutBind lbind@(L _ bind) = case bind of
hasComments hasComments
_ -> Right <$> unknownNodeError "" lbind _ -> Right <$> unknownNodeError "" lbind
layoutIPBind :: ToBriDoc IPBind
layoutIPBind lipbind@(L _ bind) = case bind of
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
XIPBind{} -> unknownNodeError "XIPBind" lipbind
IPBind _ (Right _) _ -> error "brittany internal error: IPBind Right"
IPBind _ (Left (L _ (HsIPName name))) expr -> do
#else
IPBind (Right _) _ -> error "brittany internal error: IPBind Right"
IPBind (Left (L _ (HsIPName name))) expr -> do
#endif
ipName <- docLit $ Text.pack $ '?' : FastString.unpackFS name
binderDoc <- docLit $ Text.pack "="
exprDoc <- layoutExpr expr
hasComments <- hasAnyCommentsBelow lipbind
layoutPatternBindFinal Nothing binderDoc (Just ipName) [([], exprDoc, expr)] Nothing hasComments
data BagBindOrSig = BagBind (LHsBindLR GhcPs GhcPs) data BagBindOrSig = BagBind (LHsBindLR GhcPs GhcPs)
| BagSig (LSig GhcPs) | BagSig (LSig GhcPs)
@ -268,8 +286,14 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}" Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}"
(L noSrcSpan x) (L noSrcSpan x)
#endif #endif
x@(HsIPBinds{}) -> #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
Just . (: []) <$> unknownNodeError "HsIPBinds" (L noSrcSpan x) x@(HsIPBinds _ XHsIPBinds{}) ->
Just . (: []) <$> unknownNodeError "XHsIPBinds" (L noSrcSpan x)
HsIPBinds _ (IPBinds _ bb) ->
#else
HsIPBinds (IPBinds bb _) ->
#endif
Just <$> mapM layoutIPBind bb
EmptyLocalBinds{} -> return $ Nothing EmptyLocalBinds{} -> return $ Nothing
-- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is -- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is

View File

@ -64,9 +64,13 @@ layoutExpr lexpr@(L _ expr) = do
#endif #endif
let label = FastString.unpackFS name let label = FastString.unpackFS name
in docLit . Text.pack $ '#' : label in docLit . Text.pack $ '#' : label
HsIPVar{} -> do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
-- TODO HsIPVar _ext (HsIPName name) ->
briDocByExactInlineOnly "HsOverLabel{}" lexpr #else
HsIPVar (HsIPName name) ->
#endif
let label = FastString.unpackFS name
in docLit . Text.pack $ '?' : label
#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
HsOverLit _ olit -> do HsOverLit _ olit -> do
#else #else