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

module Target.AntiPattern where

import Data.Foldable (forM_, for_)
import System.FilePath ((</>))

import qualified Data.ByteString.Char8 as BS8
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.List as List
import qualified Data.Text as Text


stanLengthXs :: [a] -> [Int]
stanLengthXs :: forall a. [a] -> [Int]
stanLengthXs [a]
xs = [Int
0 .. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs]

stanLengthXsMinus1 :: [a] -> [Int]
stanLengthXsMinus1 :: forall a. [a] -> [Int]
stanLengthXsMinus1 [a]
xs = [Int
0 .. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

stanFoldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
stanFoldl :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
stanFoldl = (b -> a -> b) -> b -> t a -> b
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl

stanPack8 :: String -> BS8.ByteString
stanPack8 :: String -> ByteString
stanPack8 = String -> ByteString
BS8.pack

stanHashMapSize :: HM.HashMap Int Int -> Int
stanHashMapSize :: HashMap Int Int -> Int
stanHashMapSize = HashMap Int Int -> Int
forall k v. HashMap k v -> Int
HM.size

stanHashMapLength :: HM.HashMap Int Int -> Int
stanHashMapLength :: HashMap Int Int -> Int
stanHashMapLength = HashMap Int Int -> Int
forall a. HashMap Int a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

stanHashSetSize :: HS.HashSet Int -> Int
stanHashSetSize :: HashSet Int -> Int
stanHashSetSize = HashSet Int -> Int
forall a. HashSet a -> Int
HS.size

stanHashSetLength :: HS.HashSet Int -> Int
stanHashSetLength :: HashSet Int -> Int
stanHashSetLength = HashSet Int -> Int
forall a. HashSet a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

stanTupleLength :: Int
stanTupleLength :: Int
stanTupleLength = (Int, Int) -> Int
forall a. (Int, a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int
1, Int
2) :: (Int, Int))

stanMaybeNull :: Maybe Int -> Bool
stanMaybeNull :: Maybe Int -> Bool
stanMaybeNull = Maybe Int -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

stanEitherFoldr :: Either Int Int -> Int
stanEitherFoldr :: Either Int Int -> Int
stanEitherFoldr = (Int -> Int -> Int) -> Int -> Either Int Int -> Int
forall a b. (a -> b -> b) -> b -> Either Int a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0

stanTextLength :: Text.Text -> Int
stanTextLength :: Text -> Int
stanTextLength = Text -> Int
Text.length

stanNub :: [Int] -> [Int]
stanNub :: [Int] -> [Int]
stanNub = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
List.nub

stanFor_ :: IO ()
stanFor_ :: IO ()
stanFor_ = [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
1 :: Int .. Int
1000] Int -> IO ()
forall a. Show a => a -> IO ()
print

stanForM_ :: Int -> IO ()
stanForM_ :: Int -> IO ()
stanForM_ Int
n = [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
n] Int -> IO ()
forall a. Show a => a -> IO ()
print

stanUrl1 :: FilePath
stanUrl1 :: String
stanUrl1 = String
"http://google.com" String -> String -> String
</> String
"asd"

stanUrl2 :: FilePath
stanUrl2 :: String
stanUrl2 = String
fooUrl String -> String -> String
</> String
"asd"
  where
    fooUrl :: FilePath
    fooUrl :: String
fooUrl = String
"asd"

stanUrl3 :: FilePath
stanUrl3 :: String
stanUrl3 = String
"asd" String -> String -> String
</> String
fooUrl
  where
    fooUrl :: FilePath
    fooUrl :: String
fooUrl = String
"asd"

stanUrl4 :: FilePath
stanUrl4 :: String
stanUrl4 = String
fooUral String -> String -> String
</> String
"asd"
  where
    fooUral :: FilePath
    fooUral :: String
fooUral = String
"asd"

stanSlashesUnix :: FilePath
stanSlashesUnix :: String
stanSlashesUnix = String
"asd/asd" String -> String -> String
</> String
"xxx"

stanSlashesWindows :: FilePath
stanSlashesWindows :: String
stanSlashesWindows = String
"asd\\asd" String -> String -> String
</> String
"xxx"

stanSlashesUnix' :: FilePath
stanSlashesUnix' :: String
stanSlashesUnix' = String
"xxx" String -> String -> String
</> String
"asd/asd"

stanSlashesWindows' :: FilePath
stanSlashesWindows' :: String
stanSlashesWindows' = String
"xxx" String -> String -> String
</> String
"asd\\asd"

stanSlashesNo :: FilePath
stanSlashesNo :: String
stanSlashesNo = String
"xxx" String -> String -> String
</> String
"asd"