{-# OPTIONS_GHC -Wno-missing-export-lists #-}

module Target.AntiPattern.Stan0214 where


isEq :: Int -> Int -> Bool
isEq :: Int -> Int -> Bool
isEq Int
x Int
y
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y = Bool
False
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y = Bool
False
    | Bool
otherwise = Bool
True

isEq2 :: String -> String -> Bool
isEq2 :: String -> String -> Bool
isEq2 String
s1 String
s2
    | String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s2 = Bool
True
    | String
s1 String -> String -> Bool
forall a. Ord a => a -> a -> Bool
< String
s2 = Bool
False
    | Bool
otherwise = Bool
True

weirdEq :: Int -> Int -> Bool
weirdEq :: Int -> Int -> Bool
weirdEq Int
a Int
b
   | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b = Bool
True
   | Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = Bool
True  -- almost equal
   | Bool
otherwise = Bool
False

geqOrEq :: Int -> Int -> Bool
geqOrEq :: Int -> Int -> Bool
geqOrEq Int
a Int
b
   | Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b = Bool
True
   | Bool
otherwise = Bool
False

inRange :: Int -> Bool
inRange :: Int -> Bool
inRange Int
i
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100  = Bool
False
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
80   = Bool
True
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
60   = Bool
False
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
40   = Bool
True
   | Bool
otherwise = Bool
False

data Tree a = Leaf | Node a (Tree a) (Tree a)

insert :: Ord a => a -> Tree a -> Tree a
insert :: forall a. Ord a => a -> Tree a -> Tree a
insert a
x Tree a
Leaf = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
x Tree a
forall a. Tree a
Leaf Tree a
forall a. Tree a
Leaf
insert a
x node :: Tree a
node@(Node a
y Tree a
l Tree a
r)
    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
y (a -> Tree a -> Tree a
forall a. Ord a => a -> Tree a -> Tree a
insert a
x Tree a
l) Tree a
r
    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
y Tree a
l (a -> Tree a -> Tree a
forall a. Ord a => a -> Tree a -> Tree a
insert a
x Tree a
r)
    | Bool
otherwise = Tree a
node