{-# LANGUAGE TemplateHaskell, PatternGuards, MagicHash #-}

-- | This module provides a quotation feature to let you write command line
--   arguments in the impure style, but have them translated into the pure style,
--   as per "System.Console.CmdArgs.Implicit". An example:
--
-- > {-# LANGUAGE TemplateHaskell, DeriveDataTypeable, MagicHash #-}
-- > import System.Console.CmdArgs.Implicit
-- > import System.Console.CmdArgs.Quote
-- >
-- > data Sample = Sample {hello :: String} deriving (Show, Data, Typeable)
-- >
-- > $(cmdArgsQuote [d|
-- >     sample = Sample{hello = def &=# help "World argument" &=# opt "world"}
-- >                    &=# summary "Sample v1"
-- >
-- >     run = cmdArgs# sample :: IO Sample
-- >     |])
-- >
-- > main = print =<< run
--
--   Inside 'cmdArgsQuote' you supply the command line parser using attributes in the
--   impure style. If you run with @-ddump-splices@ (to see the Template Haskell output),
--   you would see:
--
-- > run = cmdArgs_
-- >     (record Sample{} [hello := def += help "World argument" += opt "world"]
-- >         += summary "Sample v1")
-- >     :: IO Sample
--
--   /Stubs/
--
--   To define the original parser you may use either the standard impure annotations ('(&=)', 'modes'), or
--   the stub annotations versions defined in this module ('(&=#)', 'modes'). The stub versions do not include
--   a "Data" constraint, so can be used in situations where the Data instance is not yet available - typically
--   when defining the parser in the same module as the data type on GHC 7.2 and above. The stub versions should
--   never be used outside 'cmdArgsQuote' and will always raise an error.
--
--   /Explicit types/
--
--   There will be a limited number of situations where an impure parser will require additional types, typically
--   on the result of 'cmdArgs' if the result is used without a fixed type - for example if you 'show' it. Most users
--   will not need to add any types. In some cases you may need to remove some explicit types, where the intermediate
--   type of the annotations has changed - but again, this change should be rare.
--
--   /Completeness/
--
--   The translation is not complete, although works for all practical instances I've tried. The translation works
--   by first expanding out the expression (inlining every function defined within the quote, inlining let bindings),
--   then performs the translation. This scheme leads to two consequences: 1) Any expensive computation executed inside
--   the quotation to produce the command line flags may be duplicated (a very unlikely scenario). 2) As I do not yet
--   have expansion rules for all possible expressions, the expansion (and subsequently the translation) may fail.
--   I am interested in any bug reports where the feature does not work as intended.
module System.Console.CmdArgs.Quote(
    -- * Template Haskell quotation function
    cmdArgsQuote,
    -- * Stub versions of the impure annotations
    (&=#), modes#, cmdArgsMode#, cmdArgs#, enum#
    ) where

import Language.Haskell.TH
import Control.Arrow
import Control.Monad
import Data.Data
import Data.Maybe
import System.Console.CmdArgs.Implicit

stub :: [Char] -> a
stub [Char]
name = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
    [Char]
"System.Console.CmdArgs.Quote." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
    [Char]
": this function is provided only for use inside cmdArgsQuote, and should never be called"

-- | Version of '&=' without a 'Data' context, only to be used within 'cmdArgsQuote'.
(&=#) :: a -> Ann -> a
&=# :: a -> Ann -> a
(&=#) = [Char] -> a -> Ann -> a
forall a. [Char] -> a
stub [Char]
"(&=#)"

-- | Version of 'modes' without a 'Data' context, only to be used within 'cmdArgsQuote'.
modes# :: [a] -> a
modes# :: [a] -> a
modes# = [Char] -> [a] -> a
forall a. [Char] -> a
stub [Char]
"modes#"

-- | Version of 'cmdArgsMode' without a 'Data' context, only to be used within 'cmdArgsQuote'.
cmdArgsMode# :: a -> Mode (CmdArgs a)
cmdArgsMode# :: a -> Mode (CmdArgs a)
cmdArgsMode# = [Char] -> a -> Mode (CmdArgs a)
forall a. [Char] -> a
stub [Char]
"cmdArgsMode#"

-- | Version of 'cmdArgs' without a 'Data' context, only to be used within 'cmdArgsQuote'.
cmdArgs# :: a -> IO a
cmdArgs# :: a -> IO a
cmdArgs# = [Char] -> a -> IO a
forall a. [Char] -> a
stub [Char]
"cmdArgs#"

-- | Version of 'enum' without a 'Data' context, only to be used within 'cmdArgsQuote'.
enum# :: [a] -> a
enum# :: [a] -> a
enum# = [Char] -> [a] -> a
forall a. [Char] -> a
stub [Char]
"enum#"


-- | Quotation function to turn an impure version of "System.Console.CmdArgs.Implicit" into a pure one.
--   For details see "System.Console.CmdArgs.Quote".
cmdArgsQuote :: Q [Dec] -> Q [Dec]
cmdArgsQuote :: Q [Dec] -> Q [Dec]
cmdArgsQuote Q [Dec]
x = do
    [Dec]
x <- Q [Dec]
x
    [Dec] -> Q [Dec]
translate ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec] -> [Dec]
rename ([Dec] -> [Dec]) -> [Dec] -> [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec] -> [Dec]
simplify ([Dec] -> [Dec]) -> [Dec] -> [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec] -> [Dec]
inline [Dec]
x


-- | Apply the rewrite rules
translate :: [Dec] -> Q [Dec]
translate :: [Dec] -> Q [Dec]
translate = (Exp -> Q Exp) -> [Dec] -> Q [Dec]
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(b -> m b) -> a -> m a
descendBiM Exp -> Q Exp
f
    where
        dull :: [Name]
dull = ['Just, 'Left, 'Right, '(:)] -- Prelude constructors of non-zero arity

        f :: Exp -> Q Exp
f (RecConE Name
x [FieldExp]
xs) = Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$
            let args :: [Exp]
args = [Exp -> [Exp] -> Exp
anns (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
lbl) (Name -> Exp
ConE '(:=)) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
val)) [Exp]
as | (Name
lbl,Exp
x) <- [FieldExp]
xs, let (Exp
val, [Exp]
as) = Exp -> (Exp, [Exp])
asAnns Exp
x]
            in Name -> Exp
VarE 'record Exp -> Exp -> Exp
`AppE` Name -> [FieldExp] -> Exp
RecConE Name
x [] Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
args

        f Exp
x | (ConE Name
x, xs :: [Exp]
xs@(Exp
_:[Exp]
_)) <- Exp -> (Exp, [Exp])
asApps Exp
x, Name
x Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
dull = do
            [Name]
names <- [Int] -> (Int -> Q Name) -> Q [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1..[Exp] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp]
xs] ((Int -> Q Name) -> Q [Name]) -> (Int -> Q Name) -> Q [Name]
forall a b. (a -> b) -> a -> b
$ \Int
i -> [Char] -> Q Name
newName ([Char] -> Q Name) -> [Char] -> Q Name
forall a b. (a -> b) -> a -> b
$ [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
nameBase Name
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
            let ([Exp]
vals, [[Exp]]
ass) = [(Exp, [Exp])] -> ([Exp], [[Exp]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Exp, [Exp])] -> ([Exp], [[Exp]]))
-> [(Exp, [Exp])] -> ([Exp], [[Exp]])
forall a b. (a -> b) -> a -> b
$ (Exp -> (Exp, [Exp])) -> [Exp] -> [(Exp, [Exp])]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> (Exp, [Exp])
asAnns [Exp]
xs
                bind :: [Dec]
bind = [Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP Name
name) (Exp -> Body
NormalB Exp
val) [] | (Name
name,Exp
val) <- [Name] -> [Exp] -> [FieldExp]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
names [Exp]
vals]
                args :: [Exp]
args = [Exp -> [Exp] -> Exp
anns (Name -> Exp
VarE 'atom Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
name) [Exp]
as | (Name
name,[Exp]
as) <- [Name] -> [[Exp]] -> [(Name, [Exp])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
names [[Exp]]
ass]
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Dec] -> Exp -> Exp
LetE [Dec]
bind (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'record Exp -> Exp -> Exp
`AppE` (Name -> Exp
ConE Name
x Exp -> [Exp] -> Exp
`apps` (Name -> Exp) -> [Name] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Exp
VarE [Name]
names) Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
args

        f Exp
x = (Exp -> Q Exp) -> Exp -> Q Exp
forall a (m :: * -> *). (Data a, Monad m) => (a -> m a) -> a -> m a
descendM Exp -> Q Exp
f Exp
x

        apps :: Exp -> [Exp] -> Exp
apps Exp
x [] = Exp
x
        apps Exp
x (Exp
y:[Exp]
ys) = Exp -> [Exp] -> Exp
apps (Exp
x Exp -> Exp -> Exp
`AppE` Exp
y) [Exp]
ys

        asApps :: Exp -> (Exp, [Exp])
asApps (AppE Exp
x Exp
y) = let (Exp
a,[Exp]
b) = Exp -> (Exp, [Exp])
asApps Exp
x in (Exp
a,[Exp]
b[Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++[Exp
y])
        asApps Exp
x = (Exp
x,[])

        anns :: Exp -> [Exp] -> Exp
anns Exp
x [] = Exp
x
        anns Exp
x (Exp
a:[Exp]
as) = Exp -> [Exp] -> Exp
anns (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
x) (Name -> Exp
VarE '(+=)) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
a)) [Exp]
as

        asAnns :: Exp -> (Exp, [Exp])
asAnns (InfixE (Just Exp
x) (VarE Name
op) (Just Exp
y)) | Name
op Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== '(+=) = let (Exp
a,[Exp]
b) = Exp -> (Exp, [Exp])
asAnns Exp
x in (Exp
a,[Exp]
b[Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++[Exp
y])
        asAnns (AppE (AppE (VarE Name
op) Exp
x) Exp
y) | Name
op Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== '(+=) = let (Exp
a,[Exp]
b) = Exp -> (Exp, [Exp])
asAnns Exp
x in (Exp
a,[Exp]
b[Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++[Exp
y])
        asAnns Exp
x = (Exp
x, [])


-- | Move from the old names to the new names, sufficient for where that is the full translation
rename :: [Dec] -> [Dec]
rename :: [Dec] -> [Dec]
rename = (Exp -> Exp) -> [Dec] -> [Dec]
forall a b. (Data a, Data b) => (b -> b) -> a -> a
transformBi Exp -> Exp
f
    where
        rep :: [(Name, Name)]
rep = let f :: a -> a -> b -> [(a, b)]
f a
a a
b b
c = [(a
a,b
c),(a
b,b
c)] in [[(Name, Name)]] -> [(Name, Name)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [Name -> Name -> Name -> [(Name, Name)]
forall a b. a -> a -> b -> [(a, b)]
f '(&=) '(&=#) '(+=)
            ,Name -> Name -> Name -> [(Name, Name)]
forall a b. a -> a -> b -> [(a, b)]
f 'modes 'modes# 'modes_
            ,Name -> Name -> Name -> [(Name, Name)]
forall a b. a -> a -> b -> [(a, b)]
f 'enum 'enum# 'enum_
            ,Name -> Name -> Name -> [(Name, Name)]
forall a b. a -> a -> b -> [(a, b)]
f 'cmdArgsMode 'cmdArgsMode# 'cmdArgsMode_
            ,Name -> Name -> Name -> [(Name, Name)]
forall a b. a -> a -> b -> [(a, b)]
f 'cmdArgs 'cmdArgs# 'cmdArgs_]

        f :: Exp -> Exp
f (VarE Name
x) | Just Name
x <- Name -> [(Name, Name)] -> Maybe Name
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
x [(Name, Name)]
rep = Name -> Exp
VarE Name
x
        f Exp
x = Exp
x


-- | Simplify the syntax tree - things like application of a lambda
simplify :: [Dec] -> [Dec]
simplify :: [Dec] -> [Dec]
simplify = (Exp -> Exp) -> [Dec] -> [Dec]
forall a b. (Data a, Data b) => (b -> b) -> a -> a
transformBi Exp -> Exp
f
    where
        f :: Exp -> Exp
f (AppE (LamE [VarP Name
v] Exp
bod) Exp
x) = Exp -> Exp
f (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp -> Exp -> Exp
subst Name
v Exp
x Exp
bod
        f Exp
x = Exp
x

        subst :: Name -> Exp -> Exp -> Exp
subst Name
v Exp
x Exp
bod = (Exp -> Exp) -> Exp -> Exp
forall a. Data a => (a -> a) -> a -> a
transform Exp -> Exp
f Exp
bod
            where f :: Exp -> Exp
f (VarE Name
v2) | Name
v Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
v2 = Exp
x
                  f Exp
x = Exp
x


-- | Evaluate through all locally defined functions and let expressions, at most once per defn
inline :: [Dec] -> [Dec]
inline :: [Dec] -> [Dec]
inline [Dec]
xs = (Dec -> Dec) -> [Dec] -> [Dec]
forall a b. (a -> b) -> [a] -> [b]
map ([FieldExp] -> Dec -> Dec
dec ([FieldExp] -> Dec -> Dec) -> [FieldExp] -> Dec -> Dec
forall a b. (a -> b) -> a -> b
$ [Dec] -> [FieldExp] -> [FieldExp]
addEnv [Dec]
xs []) [Dec]
xs
    where
        newEnv :: [Dec] -> [FieldExp]
newEnv = (Dec -> [FieldExp]) -> [Dec] -> [FieldExp]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Dec -> [FieldExp]) -> [Dec] -> [FieldExp])
-> (Dec -> [FieldExp]) -> [Dec] -> [FieldExp]
forall a b. (a -> b) -> a -> b
$ \Dec
x -> case Dec
x of
            FunD Name
x [Clause [Pat]
ps (NormalB Exp
e) [Dec]
ds] -> [(Name
x, [Pat] -> Exp -> Exp
LamE [Pat]
ps (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Dec] -> Exp -> Exp
let_ [Dec]
ds Exp
e)]
            ValD (VarP Name
x) (NormalB Exp
e) [Dec]
ds -> [(Name
x, [Dec] -> Exp -> Exp
let_ [Dec]
ds Exp
e)]
            Dec
_ -> []

        addEnv :: [Dec] -> [FieldExp] -> [FieldExp]
addEnv [Dec]
xs [FieldExp]
env = [Name] -> [FieldExp] -> [FieldExp]
without [] ([Dec] -> [FieldExp]
newEnv [Dec]
xs) [FieldExp] -> [FieldExp] -> [FieldExp]
forall a. [a] -> [a] -> [a]
++ [FieldExp]
env
            where
                -- create an environment where everything in ns is missing, recursively drop one thing each time
                without :: [Name] -> [FieldExp] -> [FieldExp]
without [Name]
ns [FieldExp]
new = [(Name
n, [FieldExp] -> Exp -> Exp
exp ([FieldExp]
new2 [FieldExp] -> [FieldExp] -> [FieldExp]
forall a. [a] -> [a] -> [a]
++ [FieldExp]
env) Exp
e) | (Name
n,Exp
e) <- [FieldExp]
new, Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
ns, let new2 :: [FieldExp]
new2 = [Name] -> [FieldExp] -> [FieldExp]
without (Name
nName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ns) [FieldExp]
new]


        dec :: [FieldExp] -> Dec -> Dec
dec [FieldExp]
env (FunD Name
n [Clause]
cs) = Name -> [Clause] -> Dec
FunD Name
n ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ (Clause -> Clause) -> [Clause] -> [Clause]
forall a b. (a -> b) -> [a] -> [b]
map ([FieldExp] -> Clause -> Clause
clause [FieldExp]
env) [Clause]
cs
        dec [FieldExp]
env (ValD Pat
p Body
x [Dec]
ds) = Pat -> Body -> [Dec] -> Dec
ValD Pat
p ([FieldExp] -> Body -> Body
body ([Dec] -> [FieldExp] -> [FieldExp]
addEnv [Dec]
ds [FieldExp]
env) Body
x) [Dec]
ds

        clause :: [FieldExp] -> Clause -> Clause
clause [FieldExp]
env (Clause [Pat]
ps Body
x [Dec]
ds) = [Pat] -> Body -> [Dec] -> Clause
Clause [Pat]
ps ([FieldExp] -> Body -> Body
body ([Dec] -> [FieldExp] -> [FieldExp]
addEnv [Dec]
ds [FieldExp]
env) Body
x) [Dec]
ds

        body :: [FieldExp] -> Body -> Body
body [FieldExp]
env (GuardedB [(Guard, Exp)]
xs) = [(Guard, Exp)] -> Body
GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$ ((Guard, Exp) -> (Guard, Exp)) -> [(Guard, Exp)] -> [(Guard, Exp)]
forall a b. (a -> b) -> [a] -> [b]
map ((Exp -> Exp) -> (Guard, Exp) -> (Guard, Exp)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Exp -> Exp) -> (Guard, Exp) -> (Guard, Exp))
-> (Exp -> Exp) -> (Guard, Exp) -> (Guard, Exp)
forall a b. (a -> b) -> a -> b
$ [FieldExp] -> Exp -> Exp
exp [FieldExp]
env) [(Guard, Exp)]
xs
        body [FieldExp]
env (NormalB Exp
x) = Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ [FieldExp] -> Exp -> Exp
exp [FieldExp]
env Exp
x

        -- FIXME: propagating the env ignores variables shadowed by LamE/CaseE
        exp :: [FieldExp] -> Exp -> Exp
exp [FieldExp]
env (LetE [Dec]
ds Exp
x) = [Dec] -> Exp -> Exp
LetE [Dec]
ds (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [FieldExp] -> Exp -> Exp
exp ([Dec] -> [FieldExp] -> [FieldExp]
addEnv [Dec]
ds [FieldExp]
env) Exp
x
        exp [FieldExp]
env (VarE Name
x) | Just Exp
x <- Name -> [FieldExp] -> Maybe Exp
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
x [FieldExp]
env = Exp
x
        exp [FieldExp]
env Exp
x = (Exp -> Exp) -> Exp -> Exp
forall a. Data a => (a -> a) -> a -> a
descend ([FieldExp] -> Exp -> Exp
exp [FieldExp]
env) Exp
x

        let_ :: [Dec] -> Exp -> Exp
let_ [Dec]
ds Exp
e = if [Dec] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dec]
ds then Exp
e else [Dec] -> Exp -> Exp
LetE [Dec]
ds Exp
e


---------------------------------------------------------------------
-- MINI UNIPLATE - Avoid the dependency just for one small module

descendBi :: (Data a, Data b) => (b -> b) -> a -> a
descendBi :: (b -> b) -> a -> a
descendBi b -> b
f a
x | Just a -> a
f <- (b -> b) -> Maybe (a -> a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast b -> b
f = a -> a
f a
x
              | Bool
otherwise = (forall b. Data b => b -> b) -> a -> a
forall a. Data a => (forall b. Data b => b -> b) -> a -> a
gmapT ((b -> b) -> b -> b
forall a b. (Data a, Data b) => (b -> b) -> a -> a
descendBi b -> b
f) a
x

descend :: Data a => (a -> a) -> a -> a
descend :: (a -> a) -> a -> a
descend a -> a
f = (forall b. Data b => b -> b) -> a -> a
forall a. Data a => (forall b. Data b => b -> b) -> a -> a
gmapT ((a -> a) -> b -> b
forall a b. (Data a, Data b) => (b -> b) -> a -> a
descendBi a -> a
f)

transform :: Data a => (a -> a) -> a -> a
transform :: (a -> a) -> a -> a
transform a -> a
f = a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> a -> a
forall a. Data a => (a -> a) -> a -> a
descend ((a -> a) -> a -> a
forall a. Data a => (a -> a) -> a -> a
transform a -> a
f)

transformBi :: (Data a, Data b) => (b -> b) -> a -> a
transformBi :: (b -> b) -> a -> a
transformBi b -> b
f = (b -> b) -> a -> a
forall a b. (Data a, Data b) => (b -> b) -> a -> a
descendBi ((b -> b) -> b -> b
forall a. Data a => (a -> a) -> a -> a
transform b -> b
f)

descendBiM :: (Data a, Data b, Monad m) => (b -> m b) -> a -> m a
descendBiM :: (b -> m b) -> a -> m a
descendBiM b -> m b
f a
x | Just b
x <- a -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x = (b -> a) -> m b -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (b -> Maybe a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast) (m b -> m a) -> m b -> m a
forall a b. (a -> b) -> a -> b
$ b -> m b
f b
x -- guaranteed safe
               | Bool
otherwise = (forall d. Data d => d -> m d) -> a -> m a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM ((b -> m b) -> d -> m d
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(b -> m b) -> a -> m a
descendBiM b -> m b
f) a
x

descendM :: (Data a, Monad m) => (a -> m a) -> a -> m a
descendM :: (a -> m a) -> a -> m a
descendM a -> m a
f = (forall d. Data d => d -> m d) -> a -> m a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM ((a -> m a) -> d -> m d
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(b -> m b) -> a -> m a
descendBiM a -> m a
f)