{-# 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', toSS')

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

import SrcLoc
import HsExtension
import HsPat
import HsTypes
import TysWiredIn
import RdrName
import HsBinds
import HsExpr
import HsDecls
import OccName
import BasicTypes

import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances

listRecHint :: DeclHint'
listRecHint :: DeclHint'
listRecHint _ _ = (LHsDecl GhcPs -> [Idea]) -> [LHsDecl GhcPs] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl GhcPs -> [Idea]
f ([LHsDecl GhcPs] -> [Idea])
-> (LHsDecl GhcPs -> [LHsDecl GhcPs]) -> LHsDecl GhcPs -> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl GhcPs -> [LHsDecl GhcPs]
forall on. Uniplate on => on -> [on]
universe
    where
        f :: LHsDecl GhcPs -> [Idea]
f o :: LHsDecl 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 :: LHsDecl GhcPs
x = LHsDecl GhcPs
o
            (x :: ListCase
x, addCase :: LHsExpr GhcPs -> LHsDecl GhcPs
addCase) <- LHsDecl GhcPs -> Maybe (ListCase, LHsExpr GhcPs -> LHsDecl GhcPs)
findCase LHsDecl GhcPs
x
            (use :: String
use,severity :: Severity
severity,x :: LHsExpr GhcPs
x) <- ListCase -> Maybe (String, Severity, LHsExpr GhcPs)
matchListRec ListCase
x
            let y :: LHsDecl GhcPs
y = LHsExpr GhcPs -> LHsDecl GhcPs
addCase LHsExpr GhcPs
x
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String
recursiveStr String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsDecl GhcPs -> [String]
forall a. AllVars' a => a -> [String]
varss' LHsDecl GhcPs
y
            -- Maybe we can do better here maintaining source
            -- formatting?
            Idea -> Maybe Idea
forall (m :: * -> *) a. Monad m => a -> m a
return (Idea -> Maybe Idea) -> Idea -> Maybe Idea
forall a b. (a -> b) -> a -> b
$ Severity
-> String
-> LHsDecl GhcPs
-> LHsDecl GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
Severity -> String -> a -> b -> [Refactoring SrcSpan] -> Idea
idea' Severity
severity ("Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
use) LHsDecl GhcPs
o LHsDecl GhcPs
y [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Decl (LHsDecl GhcPs -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' LHsDecl GhcPs
o) [] (LHsDecl GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsDecl GhcPs
y)]

recursiveStr :: String
recursiveStr :: String
recursiveStr = "_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
/= :: BList -> BList -> Bool
$c/= :: BList -> BList -> Bool
== :: BList -> BList -> Bool
$c== :: 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
min :: BList -> BList -> BList
$cmin :: BList -> BList -> BList
max :: BList -> BList -> BList
$cmax :: BList -> BList -> BList
>= :: BList -> BList -> Bool
$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
compare :: BList -> BList -> Ordering
$ccompare :: BList -> BList -> Ordering
$cp1Ord :: Eq 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
showList :: [BList] -> String -> String
$cshowList :: [BList] -> String -> String
show :: BList -> String
$cshow :: BList -> String
showsPrec :: Int -> BList -> String -> String
$cshowsPrec :: Int -> 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 vs :: [String]
vs nil :: LHsExpr GhcPs
nil (x :: String
x, xs :: String
xs, cons :: LHsExpr GhcPs
cons))
    -- Suggest 'map'?
    | [] <- [String]
vs, LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
nil String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "[]", (LL _ (OpApp _ lhs c rhs)) <- LHsExpr GhcPs
cons, LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ":"
    , LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
forall a. Data a => a -> a -> Bool
astEq (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen' LHsExpr GhcPs
rhs) LHsExpr GhcPs
recursive, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr GhcPs -> [String]
forall a. FreeVars' a => a -> [String]
vars' LHsExpr 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
$ (,,) "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 "map", [String] -> LHsExpr GhcPs -> LHsExpr GhcPs
niceLambda' [String
x] LHsExpr GhcPs
lhs, String -> LHsExpr GhcPs
strToVar String
xs]
    -- Suggest 'foldr'?
    | [] <- [String]
vs, App2' op :: LHsExpr GhcPs
op lhs :: LHsExpr GhcPs
lhs rhs :: LHsExpr GhcPs
rhs <- LHsExpr GhcPs -> App2'
forall a b. View' a b => a -> b
view' LHsExpr GhcPs
cons
    , String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (LHsExpr GhcPs -> [String]
forall a. FreeVars' a => a -> [String]
vars' LHsExpr GhcPs
op [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ LHsExpr GhcPs -> [String]
forall a. FreeVars' a => a -> [String]
vars' LHsExpr GhcPs
lhs) -- the meaning of xs changes, see #793
    , LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
forall a. Data a => a -> a -> Bool
astEq (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen' LHsExpr GhcPs
rhs) LHsExpr 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
$ (,,) "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 "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
op,LHsExpr GhcPs
lhs], LHsExpr GhcPs
nil, String -> LHsExpr GhcPs
strToVar String
xs]
    -- Suggest 'foldl'?
    | [v :: String
v] <- [String]
vs, LHsExpr GhcPs -> Var_'
forall a b. View' a b => a -> b
view' LHsExpr GhcPs
nil Var_' -> Var_' -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_'
Var_' String
v, (LL _ (HsApp _ r lhs)) <- LHsExpr GhcPs
cons
    , LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
forall a. Data a => a -> a -> Bool
astEq (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen' LHsExpr GhcPs
r) LHsExpr GhcPs
recursive
    , String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr GhcPs -> [String]
forall a. FreeVars' a => a -> [String]
vars' LHsExpr 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
$ (,,) "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 "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'?
    | [v :: String
v] <- [String]
vs, (LL _ (HsApp _ ret 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
== "()" Bool -> Bool -> Bool
|| LHsExpr GhcPs -> Var_'
forall a b. View' a b => a -> b
view' LHsExpr GhcPs
res Var_' -> Var_' -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_'
Var_' String
v
    , [LL _ (BindStmt _ (view' -> PVar_' b1) e _ _), LL _ (BodyStmt _ (fromParen' -> (LL _ (HsApp _ r (view' -> Var_' b2)))) _ _)] <- LHsExpr GhcPs -> [LStmt GhcPs (LHsExpr GhcPs)]
asDo LHsExpr GhcPs
cons
    , String
b1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b2, LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
forall a. Data a => a -> a -> Bool
astEq LHsExpr GhcPs
r LHsExpr GhcPs
recursive, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr GhcPs -> [String]
forall a. FreeVars' a => a -> [String]
vars' LHsExpr GhcPs
e
    , String
name <- "foldM" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ['_' | LHsExpr GhcPs -> String
varToStr LHsExpr GhcPs
res String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "()"]
    = (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
e, String -> LHsExpr GhcPs
strToVar String
v, String -> LHsExpr GhcPs
strToVar String
xs]
    -- Nope, I got nothing ¯\_(ツ)_/¯.
    | Bool
otherwise = Maybe (String, Severity, LHsExpr 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'
forall a b. View' a b => a -> b
view' ->
       App2' bind :: LHsExpr GhcPs
bind lhs :: LHsExpr GhcPs
lhs
         (LL _ (HsLam _ MG {
              mg_origin=FromSource
            , mg_alts=LL _ [
                 LL _ Match {  m_ctxt=LambdaExpr
                            , m_pats=[LL _ v@VarPat{}]
                            , m_grhss=GRHSs _
                                        [LL _ (GRHS _ [] rhs)]
                                        (LL _ (EmptyLocalBinds _))}]}))
      ) =
  [ SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
-> LStmt GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
 -> LStmt GhcPs (LHsExpr GhcPs))
-> SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
-> LStmt GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LPat GhcPs
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt NoExt
XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
noExt SrcSpanLess (LPat GhcPs)
LPat GhcPs
v LHsExpr GhcPs
lhs SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr
  , SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
-> LStmt GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
 -> LStmt GhcPs (LHsExpr GhcPs))
-> SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
-> LStmt GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExt
XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
noExt LHsExpr GhcPs
rhs SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr ]
asDo (LL _ (HsDo _ DoExpr (LL _ stmts))) = [LStmt GhcPs (LHsExpr GhcPs)]
SrcSpanLess (Located [LStmt GhcPs (LHsExpr GhcPs)])
stmts
asDo x :: LHsExpr GhcPs
x = [SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
-> LStmt GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
 -> LStmt GhcPs (LHsExpr GhcPs))
-> SrcSpanLess (LStmt GhcPs (LHsExpr GhcPs))
-> LStmt GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExt
XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
noExt LHsExpr GhcPs
x SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr]


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


findCase :: LHsDecl GhcPs -> Maybe (ListCase, LHsExpr GhcPs -> LHsDecl GhcPs)
findCase :: LHsDecl GhcPs -> Maybe (ListCase, LHsExpr GhcPs -> LHsDecl GhcPs)
findCase x :: LHsDecl GhcPs
x = do
  -- Match a function binding with two alternatives.
  (LL _ (ValD _ FunBind {fun_matches=
              MG{mg_origin=FromSource, mg_alts=
                     (LL _
                            [ x1@(LL _ Match{..}) -- Match fields.
                            , x2]), ..} -- Match group fields.
          , ..} -- Fun. bind fields.
      )) <- LHsDecl GhcPs -> Maybe (LHsDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsDecl GhcPs
x

  Branch name1 :: String
name1 ps1 :: [String]
ps1 p1 :: Int
p1 c1 :: BList
c1 b1 :: LHsExpr GhcPs
b1 <- LMatch GhcPs (LHsExpr GhcPs) -> Maybe Branch
findBranch LMatch GhcPs (LHsExpr GhcPs)
x1
  Branch name2 :: String
name2 ps2 :: [String]
ps2 p2 :: Int
p2 c2 :: BList
c2 b2 :: LHsExpr GhcPs
b2 <- LMatch GhcPs (LHsExpr GhcPs) -> Maybe Branch
findBranch LMatch GhcPs (LHsExpr GhcPs)
x2
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
name1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name2 Bool -> Bool -> Bool
&& [String]
ps1 [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
ps2 Bool -> Bool -> Bool
&& Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2)
  [(BNil, b1 :: LHsExpr GhcPs
b1), (BCons x :: String
x xs :: String
xs, b2 :: LHsExpr GhcPs
b2)] <- [(BList, LHsExpr GhcPs)] -> Maybe [(BList, LHsExpr GhcPs)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(BList, LHsExpr GhcPs)] -> Maybe [(BList, LHsExpr GhcPs)])
-> [(BList, LHsExpr GhcPs)] -> Maybe [(BList, LHsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ ((BList, LHsExpr GhcPs) -> BList)
-> [(BList, LHsExpr GhcPs)] -> [(BList, LHsExpr GhcPs)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (BList, LHsExpr GhcPs) -> BList
forall a b. (a, b) -> a
fst [(BList
c1, LHsExpr GhcPs
b1), (BList
c2, LHsExpr GhcPs
b2)]
  LHsExpr GhcPs
b2 <- (LHsExpr GhcPs -> Maybe (LHsExpr GhcPs))
-> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
(LHsExpr GhcPs -> m (LHsExpr GhcPs))
-> LHsExpr GhcPs -> m (LHsExpr GhcPs)
transformAppsM' (String -> Int -> String -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
delCons String
name1 Int
p1 String
xs) LHsExpr GhcPs
b2
  (ps :: [String]
ps, b2 :: LHsExpr GhcPs
b2) <- ([String], LHsExpr GhcPs) -> Maybe ([String], LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return (([String], LHsExpr GhcPs) -> Maybe ([String], LHsExpr GhcPs))
-> ([String], LHsExpr GhcPs) -> Maybe ([String], LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ [String] -> LHsExpr GhcPs -> ([String], LHsExpr GhcPs)
eliminateArgs [String]
ps1 LHsExpr GhcPs
b2

  let ps12 :: [LPat GhcPs]
ps12 = let (a :: [String]
a, b :: [String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
p1 [String]
ps1 in (String -> LPat GhcPs) -> [String] -> [LPat GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map String -> LPat 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 :: LHsLocalBinds GhcPs
emptyLocalBinds = SrcSpanLess (LHsLocalBinds GhcPs) -> LHsLocalBinds GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsLocalBinds GhcPs) -> LHsLocalBinds GhcPs)
-> SrcSpanLess (LHsLocalBinds GhcPs) -> LHsLocalBinds GhcPs
forall a b. (a -> b) -> a -> b
$ XEmptyLocalBinds GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds NoExt
XEmptyLocalBinds GhcPs GhcPs
noExt -- Empty where clause.
      gRHS :: LHsExpr GhcPs -> LGRHS GhcPs (LHsExpr GhcPs)
gRHS e :: LHsExpr GhcPs
e = SrcSpanLess (LGRHS GhcPs (LHsExpr GhcPs))
-> LGRHS GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LGRHS GhcPs (LHsExpr GhcPs))
 -> LGRHS GhcPs (LHsExpr GhcPs))
-> SrcSpanLess (LGRHS GhcPs (LHsExpr GhcPs))
-> LGRHS GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcPs (LHsExpr GhcPs)
-> [LStmt GhcPs (LHsExpr GhcPs)]
-> LHsExpr GhcPs
-> GRHS GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS NoExt
XCGRHS GhcPs (LHsExpr GhcPs)
noExt [] LHsExpr GhcPs
e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs.
      gRHSSs :: LHsExpr GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)
gRHSSs e :: LHsExpr GhcPs
e = XCGRHSs GhcPs (LHsExpr GhcPs)
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> LHsLocalBinds GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs NoExt
XCGRHSs GhcPs (LHsExpr GhcPs)
noExt [LHsExpr GhcPs -> LGRHS GhcPs (LHsExpr GhcPs)
gRHS LHsExpr GhcPs
e] LHsLocalBinds GhcPs
emptyLocalBinds -- Guarded rhs set.
      match :: LHsExpr GhcPs -> Match GhcPs (LHsExpr GhcPs)
match e :: LHsExpr GhcPs
e = Match :: forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match{m_ext :: XCMatch GhcPs (LHsExpr GhcPs)
m_ext=NoExt
XCMatch GhcPs (LHsExpr GhcPs)
noExt,m_pats :: [LPat GhcPs]
m_pats=[LPat GhcPs]
ps12, m_grhss :: GRHSs GhcPs (LHsExpr GhcPs)
m_grhss=LHsExpr GhcPs -> GRHSs GhcPs (LHsExpr GhcPs)
gRHSSs LHsExpr GhcPs
e, ..} -- Match.
      matchGroup :: LHsExpr GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs)
matchGroup e :: LHsExpr GhcPs
e = MG :: forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG{mg_alts :: Located [LMatch GhcPs (LHsExpr GhcPs)]
mg_alts=SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc [SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs))
-> LMatch GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs))
 -> LMatch GhcPs (LHsExpr GhcPs))
-> SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs))
-> LMatch GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> Match GhcPs (LHsExpr GhcPs)
match LHsExpr GhcPs
e], mg_origin :: Origin
mg_origin=Origin
Generated, ..} -- Match group.
      funBind :: LHsExpr GhcPs -> HsBindLR GhcPs GhcPs
funBind e :: LHsExpr GhcPs
e = FunBind :: forall idL idR.
XFunBind idL idR
-> Located (IdP idL)
-> MatchGroup idR (LHsExpr idR)
-> HsWrapper
-> [Tickish Id]
-> HsBindLR idL idR
FunBind {fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches=LHsExpr GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs)
matchGroup LHsExpr GhcPs
e, ..} :: HsBindLR GhcPs GhcPs -- Fun bind.

  (ListCase, LHsExpr GhcPs -> LHsDecl GhcPs)
-> Maybe (ListCase, LHsExpr GhcPs -> LHsDecl GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
-> LHsExpr GhcPs -> (String, String, LHsExpr GhcPs) -> ListCase
ListCase [String]
ps LHsExpr GhcPs
b1 (String
x, String
xs, LHsExpr GhcPs
b2), HsDecl GhcPs -> LHsDecl GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsDecl GhcPs -> LHsDecl GhcPs)
-> (LHsExpr GhcPs -> HsDecl GhcPs)
-> LHsExpr GhcPs
-> LHsDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExt
XValD GhcPs
noExt (HsBindLR GhcPs GhcPs -> HsDecl GhcPs)
-> (LHsExpr GhcPs -> HsBindLR GhcPs GhcPs)
-> LHsExpr GhcPs
-> HsDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> HsBindLR GhcPs GhcPs
funBind)

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

eliminateArgs :: [String] -> LHsExpr GhcPs -> ([String], LHsExpr GhcPs)
eliminateArgs :: [String] -> LHsExpr GhcPs -> ([String], LHsExpr GhcPs)
eliminateArgs ps :: [String]
ps cons :: LHsExpr GhcPs
cons = ([String] -> [String]
forall a. [a] -> [a]
remove [String]
ps, (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall on. Uniplate on => (on -> on) -> on -> on
transform LHsExpr GhcPs -> LHsExpr GhcPs
f LHsExpr GhcPs
cons)
  where
    args :: [[LHsExpr GhcPs]]
args = [[LHsExpr GhcPs]
zs | z :: LHsExpr GhcPs
z : zs :: [LHsExpr GhcPs]
zs <- (LHsExpr GhcPs -> [LHsExpr GhcPs])
-> [LHsExpr GhcPs] -> [[LHsExpr GhcPs]]
forall a b. (a -> b) -> [a] -> [b]
map LHsExpr GhcPs -> [LHsExpr GhcPs]
fromApps' ([LHsExpr GhcPs] -> [[LHsExpr GhcPs]])
-> [LHsExpr GhcPs] -> [[LHsExpr GhcPs]]
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> [LHsExpr GhcPs]
universeApps' LHsExpr GhcPs
cons, LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
forall a. Data a => a -> a -> Bool
astEq LHsExpr GhcPs
z LHsExpr GhcPs
recursive]
    elim :: [Bool]
elim = [([LHsExpr GhcPs] -> Bool) -> [[LHsExpr GhcPs]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\xs :: [LHsExpr GhcPs]
xs -> [LHsExpr GhcPs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr GhcPs]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i Bool -> Bool -> Bool
&& LHsExpr GhcPs -> Var_'
forall a b. View' a b => a -> b
view' ([LHsExpr GhcPs]
xs [LHsExpr GhcPs] -> Int -> LHsExpr GhcPs
forall a. [a] -> Int -> a
!! Int
i) Var_' -> Var_' -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_'
Var_' String
p) [[LHsExpr GhcPs]]
args | (i :: Int
i, p :: String
p) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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 (\b :: Bool
b x :: a
x -> [a
x | Bool -> Bool
not Bool
b]) [Bool]
elim

    f :: LHsExpr GhcPs -> LHsExpr GhcPs
f (LHsExpr GhcPs -> [LHsExpr GhcPs]
fromApps' -> x :: LHsExpr GhcPs
x : xs :: [LHsExpr GhcPs]
xs) | LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
forall a. Data a => a -> a -> Bool
astEq LHsExpr GhcPs
x LHsExpr GhcPs
recursive = [LHsExpr GhcPs] -> LHsExpr GhcPs
apps' ([LHsExpr GhcPs] -> LHsExpr GhcPs)
-> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
x LHsExpr GhcPs -> [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. a -> [a] -> [a]
: [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. [a] -> [a]
remove [LHsExpr GhcPs]
xs
    f x :: 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 _ x :: Match GhcPs (LHsExpr GhcPs)
x) = do
  Match { m_ctxt :: forall p body.
Match p body -> HsMatchContext (NameOrRdrName (IdP p))
m_ctxt = FunRhs {mc_fun :: forall id. HsMatchContext id -> Located id
mc_fun=(L _ name :: NameOrRdrName (IdP GhcPs)
name)}
            , m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcPs]
ps
            , m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss =
              GRHSs {grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs=[L l :: SrcSpan
l (GRHS _ [] body :: LHsExpr GhcPs
body)]
                        , grhssLocalBinds :: forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds=L _ (EmptyLocalBinds _)
                        }
            } <- Match GhcPs (LHsExpr GhcPs) -> Maybe (Match GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return Match GhcPs (LHsExpr GhcPs)
x
  (a :: [String]
a, b :: Int
b, c :: BList
c) <- [LPat GhcPs] -> Maybe ([String], Int, BList)
findPat [LPat GhcPs]
ps
  Branch -> Maybe Branch
forall (m :: * -> *) a. Monad m => a -> m a
return (Branch -> Maybe Branch) -> Branch -> Maybe Branch
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Int -> BList -> LHsExpr GhcPs -> Branch
Branch (OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$RdrName -> OccName
rdrNameOcc RdrName
NameOrRdrName (IdP GhcPs)
name) [String]
a Int
b BList
c (LHsExpr GhcPs -> Branch) -> LHsExpr GhcPs -> Branch
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
simplifyExp' LHsExpr GhcPs
body

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

  ([String], Int, BList) -> Maybe ([String], Int, BList)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
left, Int
i, BList
right)

readPat :: Pat GhcPs -> Maybe (Either String BList)
readPat :: LPat GhcPs -> Maybe (Either String BList)
readPat (LPat GhcPs -> PVar_'
forall a b. View' a b => a -> b
view' -> PVar_' x :: 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 (LL _ (ParPat _ (LL _ (ConPatIn (L _ n) (InfixCon (view' -> PVar_' x) (view' -> PVar_' xs))))))
 | RdrName
IdP GhcPs
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 (LL _ (ConPatIn (L _ n) (PrefixCon [])))
  | RdrName
IdP GhcPs
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 _ = Maybe (Either String BList)
forall a. Maybe a
Nothing