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

module Target.Partial where

import Data.Foldable (maximumBy, minimumBy)
import Data.List (foldl1', genericIndex)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromJust)
import GHC.Exts (fromList)
import Numeric.Natural (Natural)
import Data.Scientific (Scientific)

import qualified Data.List.NonEmpty as NE


stanHead :: [a] -> a
stanHead :: forall a. [a] -> a
stanHead = [a] -> a
forall a. HasCallStack => [a] -> a
head

stanTail :: [a] -> [a]
stanTail :: forall a. [a] -> [a]
stanTail = [a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail

stanInit :: [a] -> [a]
stanInit :: forall a. [a] -> [a]
stanInit = [a] -> [a]
forall a. HasCallStack => [a] -> [a]
init

stanLast :: [a] -> a
stanLast :: forall a. [a] -> a
stanLast = [a] -> a
forall a. HasCallStack => [a] -> a
last

stanAt :: [a] -> a
stanAt :: forall a. [a] -> a
stanAt [a]
xs = [a]
xs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
42

stanCycle :: [a] -> [a]
stanCycle :: forall a. [a] -> [a]
stanCycle = [a] -> [a]
forall a. HasCallStack => [a] -> [a]
cycle

stanGenericIndex :: [a] -> Int -> a
stanGenericIndex :: forall a. [a] -> Int -> a
stanGenericIndex = [a] -> Int -> a
forall i a. Integral i => [a] -> i -> a
genericIndex

stanFromJust :: Maybe Int -> Int
stanFromJust :: Maybe Int -> Int
stanFromJust = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust

stanRead :: String -> Int
stanRead :: String -> Int
stanRead = String -> Int
forall a. Read a => String -> a
read

stanSucc :: Int -> Int
stanSucc :: Int -> Int
stanSucc = Int -> Int
forall a. Enum a => a -> a
succ

stanPred :: Natural -> Natural
stanPred :: Natural -> Natural
stanPred = Natural -> Natural
forall a. Enum a => a -> a
pred

stanToEnum :: Int -> Bool
stanToEnum :: Int -> Bool
stanToEnum = Int -> Bool
forall a. Enum a => Int -> a
toEnum

stanMaximum :: [Int] -> Int
stanMaximum :: [Int] -> Int
stanMaximum = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum

stanMinimum :: Ord a => [a] -> a
stanMinimum :: forall a. Ord a => [a] -> a
stanMinimum = [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum

stanMaximumBy :: [Int] -> Int
stanMaximumBy :: [Int] -> Int
stanMaximumBy = (Int -> Int -> Ordering) -> [Int] -> Int
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

stanMinimumBy :: (a -> a -> Ordering) -> [a] -> a
stanMinimumBy :: forall a. (a -> a -> Ordering) -> [a] -> a
stanMinimumBy = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy

stanFoldl1 :: (a -> a -> a) -> [a] -> a
stanFoldl1 :: forall a. (a -> a -> a) -> [a] -> a
stanFoldl1 = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1

stanFoldl1' :: (a -> a -> a) -> [a] -> a
stanFoldl1' :: forall a. (a -> a -> a) -> [a] -> a
stanFoldl1' = (a -> a -> a) -> [a] -> a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1'

stanFoldr1 :: (a -> a -> a) -> [a] -> a
stanFoldr1 :: forall a. (a -> a -> a) -> [a] -> a
stanFoldr1 = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1

stanFromList :: [x] -> NonEmpty x
stanFromList :: forall x. [x] -> NonEmpty x
stanFromList = [x] -> NonEmpty x
[Item (NonEmpty x)] -> NonEmpty x
forall l. IsList l => [Item l] -> l
fromList

stanFromInteger :: Integer -> Natural
stanFromInteger :: Integer -> Natural
stanFromInteger = Integer -> Natural
forall a. Num a => Integer -> a
fromInteger

stanFromRational :: Rational -> Scientific
stanFromRational :: Rational -> Scientific
stanFromRational = Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational

stanRealToFrac :: Real a => a -> Scientific
stanRealToFrac :: forall a. Real a => a -> Scientific
stanRealToFrac = a -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac

stanRecip :: Scientific -> Scientific
stanRecip :: Scientific -> Scientific
stanRecip = Scientific -> Scientific
forall a. Fractional a => a -> a
recip

stanDivide :: Scientific -> Scientific -> Scientific
stanDivide :: Scientific -> Scientific -> Scientific
stanDivide Scientific
a Scientific
b = Scientific
a Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
/ Scientific
b

-- Other tests

stanSuccNatural :: Natural -> Natural
stanSuccNatural :: Natural -> Natural
stanSuccNatural = Natural -> Natural
forall a. Enum a => a -> a
succ  -- no warning here

stanPredInteger :: Integer -> Integer
stanPredInteger :: Integer -> Integer
stanPredInteger = Integer -> Integer
forall a. Enum a => a -> a
pred  -- no warning here

stanPredPoly :: Enum a => a -> a
stanPredPoly :: forall a. Enum a => a -> a
stanPredPoly = a -> a
forall a. Enum a => a -> a
pred

stanFromListNE :: [x] -> NonEmpty x
stanFromListNE :: forall x. [x] -> NonEmpty x
stanFromListNE = [x] -> NonEmpty x
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList