module Language.Haskell.Exts.Bracket
( Brackets(..)
, paren
, transformBracket
, rebracket1
, appsBracket
) where
import Control.Monad.Trans.State
import Data.Data
import Data.Default
import Data.Generics.Uniplate.Data
import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.Util.Internal
class Brackets a where
remParen :: a -> Maybe a
addParen :: a -> a
isAtom :: a -> Bool
needBracket :: Int -> a -> a -> Bool
instance (Data l, Default l) => Brackets (Exp l) where
remParen (Paren _ x) = Just x
remParen _ = Nothing
addParen = Paren def
isAtom x = case x of
Paren{} -> True
Tuple{} -> True
List{} -> True
LeftSection{} -> True
RightSection{} -> True
TupleSection{} -> True
RecConstr{} -> True
ListComp{} -> True
EnumFrom{} -> True
EnumFromTo{} -> True
EnumFromThen{} -> True
EnumFromThenTo{} -> True
_ -> isLexeme x
needBracket i parent child
| isAtom child = False
| InfixApp{} <- parent, App{} <- child = False
| isSection parent, App{} <- child = False
| Let{} <- parent, App{} <- child = False
| ListComp{} <- parent = False
| List{} <- parent = False
| Tuple{} <- parent = False
| If{} <- parent, isAnyApp child = False
| App{} <- parent, i == 0, App{} <- child = False
| ExpTypeSig{} <- parent, i == 0, isApp child = False
| Paren{} <- parent = False
| isDotApp parent, isDotApp child, i == 1 = False
| RecConstr{} <- parent = False
| RecUpdate{} <- parent, i /= 0 = False
| Case{} <- parent, i /= 0 || isAnyApp child = False
| Lambda{} <- parent, i == length (universeBi parent :: [Pat l]) 1 = False
| Do{} <- parent = False
| otherwise = True
instance Default l => Brackets (Type l) where
remParen (TyParen _ x) = Just x
remParen _ = Nothing
addParen = TyParen def
isAtom x = case x of
TyParen{} -> True
TyTuple{} -> True
TyList{} -> True
TyVar{} -> True
TyCon{} -> True
_ -> False
needBracket _ parent child
| isAtom child = False
| TyFun{} <- parent, TyApp{} <- child = False
| TyTuple{} <- parent = False
| TyList{} <- parent = False
| TyInfix{} <- parent, TyApp{} <- child = False
| TyParen{} <- parent = False
| otherwise = True
instance Default l => Brackets (Pat l) where
remParen (PParen _ x) = Just x
remParen _ = Nothing
addParen = PParen def
isAtom x = case x of
PParen{} -> True
PTuple{} -> True
PList{} -> True
PRec{} -> True
PVar{} -> True
PApp _ _ [] -> True
PWildCard{} -> True
_ -> False
needBracket _ parent child
| isAtom child = False
| PTuple{} <- parent = False
| PList{} <- parent = False
| PInfixApp{} <- parent, PApp{} <- child = False
| PParen{} <- parent = False
| otherwise = True
paren :: (Data l, Default l) => Exp l -> Exp l
paren x = if isAtom x then x else addParen x
descendBracket :: (Data l, Default l) => (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket op x = descendIndex g x
where
g i y = if a then f i b else b
where (a,b) = op y
f i (Paren _ y) | not $ needBracket i x y = y
f i y | needBracket i x y = addParen y
f _ y = y
transformBracket :: (Data l, Default l) => (Exp l -> Maybe (Exp l)) -> Exp l -> Exp l
transformBracket op = snd . g
where
g = f . descendBracket g
f x = maybe (False,x) ((,) True) (op x)
rebracket1 :: (Data l, Default l) => Exp l -> Exp l
rebracket1 = descendBracket (\x -> (True,x))
appsBracket :: (Data l, Default l) => [Exp l] -> Exp l
appsBracket = foldl1 (\x -> rebracket1 . App def x)
descendIndex :: Data a => (Int -> a -> a) -> a -> a
descendIndex f x = flip evalState 0 $ flip descendM x $ \y -> do
i <- get
modify (+1)
return $ f i y