{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns -fno-warn-incomplete-patterns #-}

-- | The contents of this module originate from module
--  [HSE.Bracket](https://github.com/ndmitchell/hlint/blob/master/src/HSE/Bracket.hs)
--  in Neil Mitchell's HLint

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 -- remove one paren, or Nothing if there is no paren
    addParen :: a -> a -- write out a paren

    -- | Is this item lexically requiring no bracketing ever
    --   i.e. is totally atomic
    isAtom :: a -> Bool

    -- | Is the child safe free from brackets in the parent position.
    --   Err on the side of caution, True = don't know
    needBracket :: Int -> a -> a -> Bool


instance (Data l, Default l) => Brackets (Exp l) where
    remParen :: Exp l -> Maybe (Exp l)
remParen (Paren _ x :: Exp l
x) = Exp l -> Maybe (Exp l)
forall a. a -> Maybe a
Just Exp l
x
    remParen _           = Maybe (Exp l)
forall a. Maybe a
Nothing
    addParen :: Exp l -> Exp l
addParen = l -> Exp l -> Exp l
forall l. l -> Exp l -> Exp l
Paren l
forall a. Default a => a
def

    isAtom :: Exp l -> Bool
isAtom x :: Exp l
x = case Exp l
x of
        Var{}                -> Bool
True
        Con{}                -> Bool
True
        Paren{}              -> Bool
True
        Tuple{}              -> Bool
True
        List{}               -> Bool
True
        LeftSection{}        -> Bool
True
        RightSection{}       -> Bool
True
        TupleSection{}       -> Bool
True
        RecConstr{}          -> Bool
True
        ListComp{}           -> Bool
True
        EnumFrom{}           -> Bool
True
        EnumFromTo{}         -> Bool
True
        EnumFromThen{}       -> Bool
True
        EnumFromThenTo{}     -> Bool
True
        OverloadedLabel{}    -> Bool
True
        ParArray{}           -> Bool
True
        ParComp{}            -> Bool
True
        XTag{}               -> Bool
True
        IPVar{}              -> Bool
True
        UnboxedSum{}         -> Bool
True
        RecUpdate{}          -> Bool
True
        ParArrayFromTo{}     -> Bool
True
        ParArrayFromThenTo{} -> Bool
True
        ParArrayComp{}       -> Bool
True
        VarQuote{}           -> Bool
True
        TypQuote{}           -> Bool
True
        BracketExp{}         -> Bool
True
        SpliceExp{}          -> Bool
True
        QuasiQuote{}         -> Bool
True
        TypeApp{}            -> Bool
True
        XETag{}              -> Bool
True
        XExpTag{}            -> Bool
True
        Lit _ x :: Literal l
x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Literal l -> Bool
forall l. Literal l -> Bool
isNegative Literal l
x -> Bool
True
        _                    -> Bool
False
        where
            isNegative :: Literal l -> Bool
isNegative (Int _ x :: Integer
x _) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
            isNegative (Frac _ x :: Rational
x _) = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0
            isNegative (PrimInt _ x :: Integer
x _) = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
            isNegative (PrimFloat _ x :: Rational
x _) = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0
            isNegative (PrimDouble _ x :: Rational
x _) = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0
            isNegative _ = Bool
False

    -- note: i is the index in children, not in the AST
    needBracket :: Int -> Exp l -> Exp l -> Bool
needBracket i :: Int
i parent :: Exp l
parent child :: Exp l
child
        | Exp l -> Bool
forall a. Brackets a => a -> Bool
isAtom Exp l
child = Bool
False
        | InfixApp{} <- Exp l
parent, App{} <- Exp l
child = Bool
False
        | Exp l -> Bool
forall l. Exp l -> Bool
isSection Exp l
parent, App{} <- Exp l
child = Bool
False
        | Let{} <- Exp l
parent, App{} <- Exp l
child = Bool
False
        | ListComp{} <- Exp l
parent = Bool
False
        | List{} <- Exp l
parent = Bool
False
        | Tuple{} <- Exp l
parent = Bool
False
        | TupleSection{} <- Exp l
parent = Bool
False
        | If{} <- Exp l
parent, Exp l -> Bool
forall l. Exp l -> Bool
isAnyApp Exp l
child = Bool
False
        | App{} <- Exp l
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0, App{} <- Exp l
child = Bool
False
        | ExpTypeSig{} <- Exp l
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0, Exp l -> Bool
forall l. Exp l -> Bool
isApp Exp l
child = Bool
False
        | Paren{} <- Exp l
parent = Bool
False
        | RecConstr{} <- Exp l
parent = Bool
False
        | RecUpdate{} <- Exp l
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = Bool
False
        | Case{} <- Exp l
parent, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
|| Exp l -> Bool
forall l. Exp l -> Bool
isAnyApp Exp l
child = Bool
False
        | Lambda{} <- Exp l
parent = Bool
False -- might be either the RHS of a PViewPat, or the lambda body (neither needs brackets)
        | Do{} <- Exp l
parent = Bool
False
        | Bool
otherwise = Bool
True


instance Default l => Brackets (Type l) where
    remParen :: Type l -> Maybe (Type l)
remParen (TyParen _ x :: Type l
x) = Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just Type l
x
    remParen _             = Maybe (Type l)
forall a. Maybe a
Nothing
    addParen :: Type l -> Type l
addParen = l -> Type l -> Type l
forall l. l -> Type l -> Type l
TyParen l
forall a. Default a => a
def

    isAtom :: Type l -> Bool
isAtom x :: Type l
x = case Type l
x of
        TyParen{}      -> Bool
True
        TyTuple{}      -> Bool
True
        TyList{}       -> Bool
True
        TyVar{}        -> Bool
True
        TyCon{}        -> Bool
True
        TyPromoted{}   -> Bool
True
        TyUnboxedSum{} -> Bool
True
        TyParArray{}   -> Bool
True
        TyKind{}       -> Bool
True
        TySplice{}     -> Bool
True
        TyWildCard{}   -> Bool
True
        TyQuasiQuote{} -> Bool
True
        _              -> Bool
False

    needBracket :: Int -> Type l -> Type l -> Bool
needBracket _ parent :: Type l
parent child :: Type l
child
        | Type l -> Bool
forall a. Brackets a => a -> Bool
isAtom Type l
child = Bool
False
-- a -> (b -> c) is not a required bracket, but useful for documentation about arity etc.
--        | TyFun{} <- parent, i == 1, TyFun{} <- child = False
        | TyFun{} <- Type l
parent, TyApp{} <- Type l
child = Bool
False
        | TyTuple{} <- Type l
parent = Bool
False
        | TyList{} <- Type l
parent = Bool
False
        | TyInfix{} <- Type l
parent, TyApp{} <- Type l
child = Bool
False
        | TyParen{} <- Type l
parent = Bool
False
        | Bool
otherwise = Bool
True


instance Default l => Brackets (Pat l) where
    remParen :: Pat l -> Maybe (Pat l)
remParen (PParen _ x :: Pat l
x) = Pat l -> Maybe (Pat l)
forall a. a -> Maybe a
Just Pat l
x
    remParen _            = Maybe (Pat l)
forall a. Maybe a
Nothing
    addParen :: Pat l -> Pat l
addParen = l -> Pat l -> Pat l
forall l. l -> Pat l -> Pat l
PParen l
forall a. Default a => a
def

    isAtom :: Pat l -> Bool
isAtom x :: Pat l
x = case Pat l
x of
        PParen{}      -> Bool
True
        PTuple{}      -> Bool
True
        PList{}       -> Bool
True
        PRec{}        -> Bool
True
        PVar{}        -> Bool
True
        PApp _ _ []   -> Bool
True
        PWildCard{}   -> Bool
True
        PUnboxedSum{} -> Bool
True
        PAsPat{}      -> Bool
True
        PIrrPat{}     -> Bool
True
        PXETag{}      -> Bool
True
        PXPatTag{}    -> Bool
True
        PSplice{}     -> Bool
True
        PQuasiQuote{} -> Bool
True
        PLit _ Signless{} _ -> Bool
True
        _             -> Bool
False

    needBracket :: Int -> Pat l -> Pat l -> Bool
needBracket _ parent :: Pat l
parent child :: Pat l
child
        | Pat l -> Bool
forall a. Brackets a => a -> Bool
isAtom Pat l
child = Bool
False
        | PTuple{} <- Pat l
parent = Bool
False
        | PList{} <- Pat l
parent = Bool
False
        | PInfixApp{} <- Pat l
parent, PApp{} <- Pat l
child = Bool
False
        | PParen{} <- Pat l
parent = Bool
False
        | Bool
otherwise = Bool
True


-- | Add a Paren around something if it is not atomic
paren :: (Data l, Default l) => Exp l -> Exp l
paren :: Exp l -> Exp l
paren x :: Exp l
x = if Exp l -> Bool
forall a. Brackets a => a -> Bool
isAtom Exp l
x then Exp l
x else Exp l -> Exp l
forall a. Brackets a => a -> a
addParen Exp l
x


-- | Descend, and if something changes then add/remove brackets appropriately
descendBracket :: (Data l, Default l) => (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket :: (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket op :: Exp l -> (Bool, Exp l)
op x :: Exp l
x = (Int -> Exp l -> Exp l) -> Exp l -> Exp l
forall a. Data a => (Int -> a -> a) -> a -> a
descendIndex Int -> Exp l -> Exp l
g Exp l
x
    where
        g :: Int -> Exp l -> Exp l
g i :: Int
i y :: Exp l
y = if Bool
a then Int -> Exp l -> Exp l
f Int
i Exp l
b else Exp l
b
            where (a :: Bool
a,b :: Exp l
b) = Exp l -> (Bool, Exp l)
op Exp l
y

        f :: Int -> Exp l -> Exp l
f i :: Int
i (Paren _ y :: Exp l
y) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Exp l -> Exp l -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i Exp l
x Exp l
y = Exp l
y
        f i :: Int
i y :: Exp l
y           | Int -> Exp l -> Exp l -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i Exp l
x Exp l
y = Exp l -> Exp l
forall a. Brackets a => a -> a
addParen Exp l
y
        f _ y :: Exp l
y           = Exp l
y


transformBracket :: (Data l, Default l) => (Exp l -> Maybe (Exp l)) -> Exp l -> Exp l
transformBracket :: (Exp l -> Maybe (Exp l)) -> Exp l -> Exp l
transformBracket op :: Exp l -> Maybe (Exp l)
op = (Bool, Exp l) -> Exp l
forall a b. (a, b) -> b
snd ((Bool, Exp l) -> Exp l)
-> (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp l -> (Bool, Exp l)
g
    where
        g :: Exp l -> (Bool, Exp l)
g = Exp l -> (Bool, Exp l)
f (Exp l -> (Bool, Exp l))
-> (Exp l -> Exp l) -> Exp l -> (Bool, Exp l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
forall l.
(Data l, Default l) =>
(Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket Exp l -> (Bool, Exp l)
g
        f :: Exp l -> (Bool, Exp l)
f x :: Exp l
x = (Bool, Exp l)
-> (Exp l -> (Bool, Exp l)) -> Maybe (Exp l) -> (Bool, Exp l)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False,Exp l
x) ((,) Bool
True) (Exp l -> Maybe (Exp l)
op Exp l
x)


-- | Add/remove brackets as suggested needBracket at 1-level of depth
rebracket1 :: (Data l, Default l) => Exp l -> Exp l
rebracket1 :: Exp l -> Exp l
rebracket1 = (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
forall l.
(Data l, Default l) =>
(Exp l -> (Bool, Exp l)) -> Exp l -> Exp l
descendBracket (\x :: Exp l
x -> (Bool
True,Exp l
x))


-- a list of application, with any necessary brackets
appsBracket :: (Data l, Default l) => [Exp l] -> Exp l
appsBracket :: [Exp l] -> Exp l
appsBracket = (Exp l -> Exp l -> Exp l) -> [Exp l] -> Exp l
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\x :: Exp l
x -> Exp l -> Exp l
forall l. (Data l, Default l) => Exp l -> Exp l
rebracket1 (Exp l -> Exp l) -> (Exp l -> Exp l) -> Exp l -> Exp l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> Exp l -> Exp l -> Exp l
forall l. l -> Exp l -> Exp l -> Exp l
App l
forall a. Default a => a
def Exp l
x)

descendIndex :: Data a => (Int -> a -> a) -> a -> a
descendIndex :: (Int -> a -> a) -> a -> a
descendIndex f :: Int -> a -> a
f x :: a
x = (State Int a -> Int -> a) -> Int -> State Int a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int a -> Int -> a
forall s a. State s a -> s -> a
evalState 0 (State Int a -> a) -> State Int a -> a
forall a b. (a -> b) -> a -> b
$ ((a -> State Int a) -> a -> State Int a)
-> a -> (a -> State Int a) -> State Int a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> State Int a) -> a -> State Int a
forall on (m :: * -> *).
(Uniplate on, Monad m) =>
(on -> m on) -> on -> m on
descendM a
x ((a -> State Int a) -> State Int a)
-> (a -> State Int a) -> State Int a
forall a b. (a -> b) -> a -> b
$ \y :: a
y -> do
    Int
i <- StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
    (Int -> Int) -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
    a -> State Int a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State Int a) -> a -> State Int a
forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f Int
i a
y