    {-# LANGUAGE PatternGuards, ViewPatterns #-}
    {-# LANGUAGE RecordWildCards #-}

    {-
    map f [] = []
    map f (x:xs) = f x : map f xs

    foldr f z [] = z
    foldr f z (x:xs) = f x (foldr f z xs)

    foldl f z [] = z
    foldl f z (x:xs) = foldl f (f z x) xs
    -}

    {-
    <TEST>
    f (x:xs) = negate x + f xs ; f [] = 0 -- f xs = foldr ((+) . negate) 0 xs
    f (x:xs) = x + 1 : f xs ; f [] = [] -- f xs = map (+ 1) xs
    f z (x:xs) = f (z*x) xs ; f z [] = z -- f z xs = foldl (*) z xs
    f a (x:xs) b = x + a + b : f a xs b ; f a [] b = [] -- f a xs b = map (\ x -> x + a + b) xs
    f [] a = return a ; f (x:xs) a = a + x >>= \fax -> f xs fax -- f xs a = foldM (+) a xs
    f (x:xs) a = a + x >>= \fax -> f xs fax ; f [] a = pure a -- f xs a = foldM (+) a xs
    foos [] x = x; foos (y:ys) x = foo y $ foos ys x -- foos ys x = foldr foo x ys
    f [] y = y; f (x:xs) y = f xs $ g x y -- f xs y = foldl (flip g) y xs
    f [] y = y; f (x : xs) y = let z = g x y in f xs z -- f xs y = foldl (flip g) y xs
    f [] y = y; f (x:xs) y = f xs (f xs z)
    fun [] = []; fun (x:xs) = f x xs ++ fun xs
    </TEST>
    -}

    module Hint.ListRec(listRecHint) where

    import Hint.Type (DeclHint, Severity(Suggestion, Warning), idea, toSSA)

    import Data.Generics.Uniplate.DataOnly
    import Data.List.Extra
    import Data.Maybe
    import Data.Either.Extra
    import Control.Monad
    import Refact.Types hiding (RType(Match))

    import GHC.Types.SrcLoc
    import GHC.Hs.Extension
    import GHC.Hs.Pat
    import GHC.Builtin.Types
    import GHC.Hs.Type
    import GHC.Types.Name.Reader
    import GHC.Hs.Binds
    import GHC.Hs.Expr
    import GHC.Hs.Decls
    import GHC.Types.Basic

    import GHC.Parser.Annotation
    import Language.Haskell.Syntax.Extension

    import GHC.Util
    import Language.Haskell.GhclibParserEx.GHC.Hs.Pat
    import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
    import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
    import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
    import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader

    listRecHint :: DeclHint
    listRecHint :: DeclHint
    listRecHint Scope
    _ ModuleEx
    _ = (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [Idea])
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> [Idea]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [Idea]
    f ([GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> [Idea])
    -> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
        -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> [Idea]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    forall on. Uniplate on => on -> [on]
    universe
        where
            f :: GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [Idea]
    f GenLocated SrcSpanAnnA (HsDecl GhcPs)
    o = Maybe Idea -> [Idea]
    forall a. Maybe a -> [a]
    maybeToList (Maybe Idea -> [Idea]) -> Maybe Idea -> [Idea]
    forall a b. (a -> b) -> a -> b
    $ do
                let x :: GenLocated SrcSpanAnnA (HsDecl GhcPs)
    x = GenLocated SrcSpanAnnA (HsDecl GhcPs)
    o
                (x, addCase) <- XRec GhcPs (HsDecl GhcPs)
    -> Maybe (ListCase, LHsExpr GhcPs -> XRec GhcPs (HsDecl GhcPs))
    findCase XRec GhcPs (HsDecl GhcPs)
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
    x
                (use,severity,x) <- matchListRec x
                let y = GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
    addCase GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x
                guard $ recursiveStr `notElem` varss y
                -- Maybe we can do better here maintaining source
                -- formatting?
                pure $ idea severity ("Use " ++ use) (reLoc o) (reLoc y) [Replace Decl (toSSA o) [] (unsafePrettyPrint y)]

    recursiveStr :: String
    recursiveStr :: String
    recursiveStr = String
    "_recursive_"
    recursive :: LHsExpr GhcPs
    recursive = String -> LHsExpr GhcPs
    strToVar String
    recursiveStr

    data ListCase =
      ListCase
        [String] -- recursion parameters
        (LHsExpr GhcPs)  -- nil case
        (String, String, LHsExpr GhcPs) -- cons case
    -- For cons-case delete any recursive calls with 'xs' in them. Any
    -- recursive calls are marked "_recursive_".

    data BList = BNil | BCons String String
                 deriving (BList -> BList -> Bool
    (BList -> BList -> Bool) -> (BList -> BList -> Bool) -> Eq BList
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: BList -> BList -> Bool
    == :: BList -> BList -> Bool
    $c/= :: BList -> BList -> Bool
    /= :: BList -> BList -> Bool
    Eq, Eq BList
    Eq BList =>
    (BList -> BList -> Ordering)
    -> (BList -> BList -> Bool)
    -> (BList -> BList -> Bool)
    -> (BList -> BList -> Bool)
    -> (BList -> BList -> Bool)
    -> (BList -> BList -> BList)
    -> (BList -> BList -> BList)
    -> Ord BList
    BList -> BList -> Bool
    BList -> BList -> Ordering
    BList -> BList -> BList
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: BList -> BList -> Ordering
    compare :: BList -> BList -> Ordering
    $c< :: BList -> BList -> Bool
    < :: BList -> BList -> Bool
    $c<= :: BList -> BList -> Bool
    <= :: BList -> BList -> Bool
    $c> :: BList -> BList -> Bool
    > :: BList -> BList -> Bool
    $c>= :: BList -> BList -> Bool
    >= :: BList -> BList -> Bool
    $cmax :: BList -> BList -> BList
    max :: BList -> BList -> BList
    $cmin :: BList -> BList -> BList
    min :: BList -> BList -> BList
    Ord, Int -> BList -> String -> String
    [BList] -> String -> String
    BList -> String
    (Int -> BList -> String -> String)
    -> (BList -> String) -> ([BList] -> String -> String) -> Show BList
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> BList -> String -> String
    showsPrec :: Int -> BList -> String -> String
    $cshow :: BList -> String
    show :: BList -> String
    $cshowList :: [BList] -> String -> String
    showList :: [BList] -> String -> String
    Show)

    data Branch =
      Branch
        String  -- function name
        [String]  -- parameters
        Int -- list position
        BList (LHsExpr GhcPs) -- list type/body

    ---------------------------------------------------------------------
    -- MATCH THE RECURSION

    matchListRec :: ListCase -> Maybe (String, Severity, LHsExpr GhcPs)
    matchListRec :: ListCase -> Maybe (String, Severity, LHsExpr GhcPs)
    matchListRec o :: ListCase
    o@(ListCase [String]
    vs LHsExpr GhcPs
    nil (String
    x, String
    xs, LHsExpr GhcPs
    cons))
        -- Suggest 'map'?
        | [] <- [String]
    vs, LHsExpr GhcPs -> String
    varToStr LHsExpr GhcPs
    nil String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "[]", (L SrcSpanAnnA
    _ (OpApp XOpApp GhcPs
    _ LHsExpr GhcPs
    lhs LHsExpr GhcPs
    c LHsExpr GhcPs
    rhs)) <- LHsExpr GhcPs
    cons, LHsExpr GhcPs -> String
    varToStr LHsExpr GhcPs
    c String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    ":"
        , GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
    forall a. Data a => a -> a -> Bool
    astEq (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    fromParen LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    rhs) GenLocated SrcSpanAnnA (HsExpr GhcPs)
    recursive, String
    xs String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String]
    forall a. FreeVars a => a -> [String]
    vars LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    lhs
        = (String, Severity, LHsExpr GhcPs)
    -> Maybe (String, Severity, LHsExpr GhcPs)
    forall a. a -> Maybe a
    Just ((String, Severity, LHsExpr GhcPs)
     -> Maybe (String, Severity, LHsExpr GhcPs))
    -> (String, Severity, LHsExpr GhcPs)
    -> Maybe (String, Severity, LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $ (,,) String
    "map" Severity
    Hint.Type.Warning (LHsExpr GhcPs -> (String, Severity, LHsExpr GhcPs))
    -> LHsExpr GhcPs -> (String, Severity, LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $
          [LHsExpr GhcPs] -> LHsExpr GhcPs
    appsBracket [ String -> LHsExpr GhcPs
    strToVar String
    "map", [String] -> LHsExpr GhcPs -> LHsExpr GhcPs
    niceLambda [String
    x] LHsExpr GhcPs
    lhs, String -> LHsExpr GhcPs
    strToVar String
    xs]
        -- Suggest 'foldr'?
        | [] <- [String]
    vs, App2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
    op GenLocated SrcSpanAnnA (HsExpr GhcPs)
    lhs GenLocated SrcSpanAnnA (HsExpr GhcPs)
    rhs <- GenLocated SrcSpanAnnA (HsExpr GhcPs) -> App2
    forall a b. View a b => a -> b
    view LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    cons
        , String
    xs String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String]
    forall a. FreeVars a => a -> [String]
    vars GenLocated SrcSpanAnnA (HsExpr GhcPs)
    op [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String]
    forall a. FreeVars a => a -> [String]
    vars GenLocated SrcSpanAnnA (HsExpr GhcPs)
    lhs) -- the meaning of xs changes, see #793
        , GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
    forall a. Data a => a -> a -> Bool
    astEq (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    fromParen GenLocated SrcSpanAnnA (HsExpr GhcPs)
    rhs) GenLocated SrcSpanAnnA (HsExpr GhcPs)
    recursive
        = (String, Severity, LHsExpr GhcPs)
    -> Maybe (String, Severity, LHsExpr GhcPs)
    forall a. a -> Maybe a
    Just ((String, Severity, LHsExpr GhcPs)
     -> Maybe (String, Severity, LHsExpr GhcPs))
    -> (String, Severity, LHsExpr GhcPs)
    -> Maybe (String, Severity, LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $ (,,) String
    "foldr" Severity
    Suggestion (LHsExpr GhcPs -> (String, Severity, LHsExpr GhcPs))
    -> LHsExpr GhcPs -> (String, Severity, LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $
          [LHsExpr GhcPs] -> LHsExpr GhcPs
    appsBracket [ String -> LHsExpr GhcPs
    strToVar String
    "foldr", [String] -> LHsExpr GhcPs -> LHsExpr GhcPs
    niceLambda [String
    x] (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
    forall a b. (a -> b) -> a -> b
    $ [LHsExpr GhcPs] -> LHsExpr GhcPs
    appsBracket [LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    op,LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    lhs], LHsExpr GhcPs
    nil, String -> LHsExpr GhcPs
    strToVar String
    xs]
        -- Suggest 'foldl'?
        | [String
    v] <- [String]
    vs, GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
    forall a b. View a b => a -> b
    view LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    nil Var_ -> Var_ -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Var_
    Var_ String
    v, (L SrcSpanAnnA
    _ (HsApp XApp GhcPs
    _ LHsExpr GhcPs
    r LHsExpr GhcPs
    lhs)) <- LHsExpr GhcPs
    cons
        , GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
    forall a. Data a => a -> a -> Bool
    astEq (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    fromParen LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    r) GenLocated SrcSpanAnnA (HsExpr GhcPs)
    recursive
        , String
    xs String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String]
    forall a. FreeVars a => a -> [String]
    vars LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    lhs
        = (String, Severity, LHsExpr GhcPs)
    -> Maybe (String, Severity, LHsExpr GhcPs)
    forall a. a -> Maybe a
    Just ((String, Severity, LHsExpr GhcPs)
     -> Maybe (String, Severity, LHsExpr GhcPs))
    -> (String, Severity, LHsExpr GhcPs)
    -> Maybe (String, Severity, LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $ (,,) String
    "foldl" Severity
    Suggestion (LHsExpr GhcPs -> (String, Severity, LHsExpr GhcPs))
    -> LHsExpr GhcPs -> (String, Severity, LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $
          [LHsExpr GhcPs] -> LHsExpr GhcPs
    appsBracket [ String -> LHsExpr GhcPs
    strToVar String
    "foldl", [String] -> LHsExpr GhcPs -> LHsExpr GhcPs
    niceLambda [String
    v,String
    x] LHsExpr GhcPs
    lhs, String -> LHsExpr GhcPs
    strToVar String
    v, String -> LHsExpr GhcPs
    strToVar String
    xs]
        -- Suggest 'foldM'?
        | [String
    v] <- [String]
    vs, (L SrcSpanAnnA
    _ (HsApp XApp GhcPs
    _ LHsExpr GhcPs
    ret LHsExpr GhcPs
    res)) <- LHsExpr GhcPs
    nil, LHsExpr GhcPs -> Bool
    isReturn LHsExpr GhcPs
    ret, LHsExpr GhcPs -> String
    varToStr LHsExpr GhcPs
    res String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "()" Bool -> Bool -> Bool
    || GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
    forall a b. View a b => a -> b
    view LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    res Var_ -> Var_ -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Var_
    Var_ String
    v
        , [L SrcSpanAnnA
    _ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    _ (LPat GhcPs -> PVar_
    GenLocated SrcSpanAnnA (Pat GhcPs) -> PVar_
    forall a b. View a b => a -> b
    view -> PVar_ String
    b1) GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e), L SrcSpanAnnA
    _ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    _ (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    fromParen -> (L SrcSpanAnnA
    _ (HsApp XApp GhcPs
    _ LHsExpr GhcPs
    r (LHsExpr GhcPs -> Var_
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
    forall a b. View a b => a -> b
    view -> Var_ String
    b2)))) SyntaxExpr GhcPs
    _ SyntaxExpr GhcPs
    _)] <- LHsExpr GhcPs -> [LStmt GhcPs (LHsExpr GhcPs)]
    asDo LHsExpr GhcPs
    cons
        , String
    b1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    b2, GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
    forall a. Data a => a -> a -> Bool
    astEq LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    r GenLocated SrcSpanAnnA (HsExpr GhcPs)
    recursive, String
    xs String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String]
    forall a. FreeVars a => a -> [String]
    vars GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e
        , String
    name <- String
    "foldM" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    '_' | LHsExpr GhcPs -> String
    varToStr LHsExpr GhcPs
    res String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "()"]
        = (String, Severity, LHsExpr GhcPs)
    -> Maybe (String, Severity, LHsExpr GhcPs)
    forall a. a -> Maybe a
    Just ((String, Severity, LHsExpr GhcPs)
     -> Maybe (String, Severity, LHsExpr GhcPs))
    -> (String, Severity, LHsExpr GhcPs)
    -> Maybe (String, Severity, LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $ (,,) String
    name Severity
    Suggestion (LHsExpr GhcPs -> (String, Severity, LHsExpr GhcPs))
    -> LHsExpr GhcPs -> (String, Severity, LHsExpr GhcPs)
    forall a b. (a -> b) -> a -> b
    $
          [LHsExpr GhcPs] -> LHsExpr GhcPs
    appsBracket [String -> LHsExpr GhcPs
    strToVar String
    name, [String] -> LHsExpr GhcPs -> LHsExpr GhcPs
    niceLambda [String
    v,String
    x] LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e, String -> LHsExpr GhcPs
    strToVar String
    v, String -> LHsExpr GhcPs
    strToVar String
    xs]
        -- Nope, I got nothing ¯\_(ツ)_/¯.
        | Bool
    otherwise = Maybe (String, Severity, LHsExpr GhcPs)
    Maybe (String, Severity, GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall a. Maybe a
    Nothing

    -- Very limited attempt to convert >>= to do, only useful for
    -- 'foldM' / 'foldM_'.
    asDo :: LHsExpr GhcPs -> [LStmt GhcPs (LHsExpr GhcPs)]
    asDo :: LHsExpr GhcPs -> [LStmt GhcPs (LHsExpr GhcPs)]
    asDo (LHsExpr GhcPs -> App2
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> App2
    forall a b. View a b => a -> b
    view ->
           App2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
    bind GenLocated SrcSpanAnnA (HsExpr GhcPs)
    lhs
             (L SrcSpanAnnA
    _ (HsLam XLam GhcPs
    _ HsLamVariant
    LamSingle MG {
                  mg_ext :: forall p body. MatchGroup p body -> XMG p body
    mg_ext=XMG GhcPs (LHsExpr GhcPs)
    Origin
    FromSource
                , mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
    mg_alts=L SrcSpanAnnLW
    _ [
                     L SrcSpanAnnA
    _ Match {  m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
    m_ctxt=(LamAlt HsLamVariant
    LamSingle)
                                , m_pats :: forall p body. Match p body -> XRec p [LPat p]
    m_pats=L EpaLocation
    _ [v :: GenLocated SrcSpanAnnA (Pat GhcPs)
    v@(L SrcSpanAnnA
    _ VarPat{})]
                                , m_grhss :: forall p body. Match p body -> GRHSs p body
    m_grhss=GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    _
                                            [L EpAnnCO
    _ (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    _ [] GenLocated SrcSpanAnnA (HsExpr GhcPs)
    rhs)]
                                            (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
    _)}]}))
          ) =
      [ StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
     -> GenLocated
          SrcSpanAnnA
          (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    -> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall a b. (a -> b) -> a -> b
    $ XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> LPat GhcPs
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall idL idR body.
    XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
    BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    EpUniToken "<-" "\8592"
    forall a. NoAnn a => a
    noAnn LPat GhcPs
    GenLocated SrcSpanAnnA (Pat GhcPs)
    v GenLocated SrcSpanAnnA (HsExpr GhcPs)
    lhs
      , StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
     -> GenLocated
          SrcSpanAnnA
          (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    -> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall a b. (a -> b) -> a -> b
    $ XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> SyntaxExpr GhcPs
    -> SyntaxExpr GhcPs
    -> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    NoExtField
    noExtField GenLocated SrcSpanAnnA (HsExpr GhcPs)
    rhs SyntaxExpr GhcPs
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr SyntaxExpr GhcPs
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr ]
    asDo (L SrcSpanAnnA
    _ (HsDo XDo GhcPs
    _ (DoExpr Maybe ModuleName
    _) (L SrcSpanAnnLW
    _ [GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    stmts))) = [LStmt GhcPs (LHsExpr GhcPs)]
    [GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    stmts
    asDo LHsExpr GhcPs
    x = [StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
     -> GenLocated
          SrcSpanAnnA
          (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    -> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall a b. (a -> b) -> a -> b
    $ XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> SyntaxExpr GhcPs
    -> SyntaxExpr GhcPs
    -> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    NoExtField
    noExtField LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x SyntaxExpr GhcPs
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr SyntaxExpr GhcPs
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr]

    ---------------------------------------------------------------------
    -- FIND THE CASE ANALYSIS

    findCase :: LHsDecl GhcPs -> Maybe (ListCase, LHsExpr GhcPs -> LHsDecl GhcPs)
    findCase :: XRec GhcPs (HsDecl GhcPs)
    -> Maybe (ListCase, LHsExpr GhcPs -> XRec GhcPs (HsDecl GhcPs))
    findCase XRec GhcPs (HsDecl GhcPs)
    x = do
      -- Match a function binding with two alternatives.
      (L _ (ValD _ FunBind {fun_matches=
                  MG{mg_ext=FromSource, mg_alts=
                         (L _
                                [ x1@(L _ Match{..}) -- Match fields.
                                , x2]), ..} -- Match group fields.
              , ..} -- Fun. bind fields.
          )) <- GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure XRec GhcPs (HsDecl GhcPs)
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
    x

      Branch name1 ps1 p1 c1 b1 <- findBranch x1
      Branch name2 ps2 p2 c2 b2 <- findBranch x2
      guard (name1 == name2 && ps1 == ps2 && p1 == p2)
      [(BNil, b1), (BCons x xs, b2)] <- pure $ sortOn fst [(c1, b1), (c2, b2)]
      b2 <- transformAppsM (delCons name1 p1 xs) b2
      (ps, b2) <- pure $ eliminateArgs ps1 b2

      let ps12 = let ([String]
    a, [String]
    b) = Int -> [String] -> ([String], [String])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    p1 [String]
    ps1 in (String -> GenLocated SrcSpanAnnA (Pat GhcPs))
    -> [String] -> [GenLocated SrcSpanAnnA (Pat GhcPs)]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> LPat GhcPs
    String -> GenLocated SrcSpanAnnA (Pat GhcPs)
    strToPat ([String]
    a [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ String
    xs String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    b) -- Function arguments.
          emptyLocalBinds = XEmptyLocalBinds GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
    forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
    EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
    NoExtField
    noExtField :: HsLocalBindsLR GhcPs GhcPs -- Empty where clause.
          gRHS GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e = GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
     -> GenLocated
          EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    -> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall a b. (a -> b) -> a -> b
    $ XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> [LStmt GhcPs (LHsExpr GhcPs)]
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall p body.
    XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
    GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    EpAnn GrhsAnn
    forall a. NoAnn a => a
    noAnn [] GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs.
          gRHSSs GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e = XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
    -> HsLocalBindsLR GhcPs GhcPs
    -> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall p body.
    XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
    GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    EpAnnComments
    emptyComments [GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated
         EpAnnCO (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    gRHS GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e] HsLocalBindsLR GhcPs GhcPs
    emptyLocalBinds -- Guarded rhs set.
          match GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e = Match{m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    m_ext=XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    NoExtField
    noExtField,m_pats :: XRec GhcPs [LPat GhcPs]
    m_pats=[GenLocated SrcSpanAnnA (Pat GhcPs)]
    -> GenLocated EpaLocation [GenLocated SrcSpanAnnA (Pat GhcPs)]
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA [GenLocated SrcSpanAnnA (Pat GhcPs)]
    ps12, m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    m_grhss=GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    gRHSSs GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e, HsMatchContext (LIdP (NoGhcTc GhcPs))
    m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
    m_ctxt :: HsMatchContext (LIdP (NoGhcTc GhcPs))
    ..} -- Match.
          matchGroup GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e = MG{mg_alts :: XRec GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
    mg_alts=[GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> GenLocated
         SrcSpanAnnLW
         [GenLocated
            SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
     -> GenLocated
          SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated
         SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    match GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e], mg_ext :: XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    mg_ext=GenReason -> DoPmc -> Origin
    Generated GenReason
    OtherExpansion DoPmc
    SkipPmc, ..} -- Match group.
          funBind GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e = FunBind {fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
    fun_matches=GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    matchGroup GenLocated SrcSpanAnnA (HsExpr GhcPs)
    e, XFunBind GhcPs GhcPs
    LIdP GhcPs
    fun_ext :: XFunBind GhcPs GhcPs
    fun_id :: LIdP GhcPs
    fun_id :: LIdP GhcPs
    fun_ext :: XFunBind GhcPs GhcPs
    ..} :: HsBindLR GhcPs GhcPs -- Fun bind.

      pure (ListCase ps b1 (x, xs, b2), noLocA . ValD noExtField . funBind)

    delCons :: String -> Int -> String -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
    delCons :: String -> Int -> String -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
    delCons String
    func Int
    pos String
    var (LHsExpr GhcPs -> [LHsExpr GhcPs]
    fromApps -> (LHsExpr GhcPs -> Var_
    GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
    forall a b. View a b => a -> b
    view -> Var_ String
    x) : [LHsExpr GhcPs]
    xs) | String
    func String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    x = do
        (pre, (view -> Var_ v) : post) <- ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
     [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
    -> Maybe
         ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
          [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
      [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
     -> Maybe
          ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
           [GenLocated SrcSpanAnnA (HsExpr GhcPs)]))
    -> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
        [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
    -> Maybe
         ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
          [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
    forall a b. (a -> b) -> a -> b
    $ Int
    -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    -> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
        [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    pos [LHsExpr GhcPs]
    [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    xs
        guard $ v == var
        pure $ apps $ recursive : pre ++ post
    delCons String
    _ Int
    _ String
    _ LHsExpr GhcPs
    x = GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x

    eliminateArgs :: [String] -> LHsExpr GhcPs -> ([String], LHsExpr GhcPs)
    eliminateArgs :: [String] -> LHsExpr GhcPs -> ([String], LHsExpr GhcPs)
    eliminateArgs [String]
    ps LHsExpr GhcPs
    cons = ([String] -> [String]
    forall {a}. [a] -> [a]
    remove [String]
    ps, (GenLocated SrcSpanAnnA (HsExpr GhcPs)
     -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    forall on. Uniplate on => (on -> on) -> on -> on
    transform GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    f LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    cons)
      where
        args :: [[GenLocated SrcSpanAnnA (HsExpr GhcPs)]]
    args = [[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    zs | GenLocated SrcSpanAnnA (HsExpr GhcPs)
    z : [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    zs <- (LHsExpr GhcPs -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
    -> [LHsExpr GhcPs] -> [[GenLocated SrcSpanAnnA (HsExpr GhcPs)]]
    forall a b. (a -> b) -> [a] -> [b]
    map LHsExpr GhcPs -> [LHsExpr GhcPs]
    LHsExpr GhcPs -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    fromApps ([LHsExpr GhcPs] -> [[GenLocated SrcSpanAnnA (HsExpr GhcPs)]])
    -> [LHsExpr GhcPs] -> [[GenLocated SrcSpanAnnA (HsExpr GhcPs)]]
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcPs -> [LHsExpr GhcPs]
    universeApps LHsExpr GhcPs
    cons, GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
    forall a. Data a => a -> a -> Bool
    astEq GenLocated SrcSpanAnnA (HsExpr GhcPs)
    z GenLocated SrcSpanAnnA (HsExpr GhcPs)
    recursive]
        elim :: [Bool]
    elim = [([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool)
    -> [[GenLocated SrcSpanAnnA (HsExpr GhcPs)]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    xs -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    xs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    i Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
    forall a b. View a b => a -> b
    view ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    xs [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    -> Int -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i) Var_ -> Var_ -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Var_
    Var_ String
    p) [[GenLocated SrcSpanAnnA (HsExpr GhcPs)]]
    args | (Int
    i, String
    p) <- Int -> [String] -> [(Int, String)]
    forall a b. Enum a => a -> [b] -> [(a, b)]
    zipFrom Int
    0 [String]
    ps] [Bool] -> [Bool] -> [Bool]
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Bool]
    forall a. a -> [a]
    repeat Bool
    False
        remove :: [a] -> [a]
    remove = [[a]] -> [a]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool -> a -> [a]) -> [Bool] -> [a] -> [[a]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Bool
    b a
    x -> [a
    x | Bool -> Bool
    not Bool
    b]) [Bool]
    elim

        f :: LHsExpr GhcPs -> LHsExpr GhcPs
    f (LHsExpr GhcPs -> [LHsExpr GhcPs]
    fromApps -> LHsExpr GhcPs
    x : [LHsExpr GhcPs]
    xs) | GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
    forall a. Data a => a -> a -> Bool
    astEq LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x GenLocated SrcSpanAnnA (HsExpr GhcPs)
    recursive = [LHsExpr GhcPs] -> LHsExpr GhcPs
    apps ([LHsExpr GhcPs] -> LHsExpr GhcPs)
    -> [LHsExpr GhcPs] -> LHsExpr GhcPs
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcPs
    GenLocated SrcSpanAnnA (HsExpr GhcPs)
    x GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    forall a. a -> [a] -> [a]
    : [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    forall {a}. [a] -> [a]
    remove [LHsExpr GhcPs]
    [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
    xs
        f LHsExpr GhcPs
    x = LHsExpr GhcPs
    x

    ---------------------------------------------------------------------
    -- FIND A BRANCH

    findBranch :: LMatch GhcPs (LHsExpr GhcPs) -> Maybe Branch
    findBranch :: LMatch GhcPs (LHsExpr GhcPs) -> Maybe Branch
    findBranch (L SrcSpanAnnA
    _ Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    x) = do
      Match { m_ctxt = FunRhs {mc_fun=(L _ name)}
                , m_pats = ps
                , m_grhss =
                  GRHSs {grhssGRHSs=[L l (GRHS _ [] body)]
                            , grhssLocalBinds=EmptyLocalBinds _
                            }
                } <- Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    -> Maybe (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    x
      (a, b, c) <- findPat (unLoc ps)
      pure $ Branch (occNameStr name) a b c $ simplifyExp body

    findPat :: [LPat GhcPs] -> Maybe ([String], Int, BList)
    findPat :: [LPat GhcPs] -> Maybe ([String], Int, BList)
    findPat [LPat GhcPs]
    ps = do
      ps <- (GenLocated SrcSpanAnnA (Pat GhcPs) -> Maybe (Either String BList))
    -> [GenLocated SrcSpanAnnA (Pat GhcPs)]
    -> Maybe [Either String BList]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM LPat GhcPs -> Maybe (Either String BList)
    GenLocated SrcSpanAnnA (Pat GhcPs) -> Maybe (Either String BList)
    readPat [LPat GhcPs]
    [GenLocated SrcSpanAnnA (Pat GhcPs)]
    ps
      [i] <- pure $ findIndices isRight ps
      let (left, [right]) = partitionEithers ps

      pure (left, i, right)

    readPat :: LPat GhcPs -> Maybe (Either String BList)
    readPat :: LPat GhcPs -> Maybe (Either String BList)
    readPat (LPat GhcPs -> PVar_
    GenLocated SrcSpanAnnA (Pat GhcPs) -> PVar_
    forall a b. View a b => a -> b
    view -> PVar_ String
    x) = Either String BList -> Maybe (Either String BList)
    forall a. a -> Maybe a
    Just (Either String BList -> Maybe (Either String BList))
    -> Either String BList -> Maybe (Either String BList)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String BList
    forall a b. a -> Either a b
    Left String
    x
    readPat (L SrcSpanAnnA
    _ (ParPat XParPat GhcPs
    _ (L SrcSpanAnnA
    _ (ConPat XConPat GhcPs
    _ (L SrcSpanAnnN
    _ RdrName
    n) (InfixCon (LPat GhcPs -> PVar_
    GenLocated SrcSpanAnnA (Pat GhcPs) -> PVar_
    forall a b. View a b => a -> b
    view -> PVar_ String
    x) (LPat GhcPs -> PVar_
    GenLocated SrcSpanAnnA (Pat GhcPs) -> PVar_
    forall a b. View a b => a -> b
    view -> PVar_ String
    xs))))))
     | RdrName
    n RdrName -> RdrName -> Bool
    forall a. Eq a => a -> a -> Bool
    == RdrName
    consDataCon_RDR = Either String BList -> Maybe (Either String BList)
    forall a. a -> Maybe a
    Just (Either String BList -> Maybe (Either String BList))
    -> Either String BList -> Maybe (Either String BList)
    forall a b. (a -> b) -> a -> b
    $ BList -> Either String BList
    forall a b. b -> Either a b
    Right (BList -> Either String BList) -> BList -> Either String BList
    forall a b. (a -> b) -> a -> b
    $ String -> String -> BList
    BCons String
    x String
    xs
    readPat (L SrcSpanAnnA
    _ (ConPat XConPat GhcPs
    _ (L SrcSpanAnnN
    _ RdrName
    n) (PrefixCon [] [])))
      | RdrName
    n RdrName -> RdrName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> RdrName
    nameRdrName Name
    nilDataConName = Either String BList -> Maybe (Either String BList)
    forall a. a -> Maybe a
    Just (Either String BList -> Maybe (Either String BList))
    -> Either String BList -> Maybe (Either String BList)
    forall a b. (a -> b) -> a -> b
    $ BList -> Either String BList
    forall a b. b -> Either a b
    Right BList
    BNil
    readPat LPat GhcPs
    _ = Maybe (Either String BList)
    forall a. Maybe a
    Nothing