{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds  #-}

{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}

{- |
A module wrapping @Prelude@/@Data.List@ functions that can throw exceptions, such as @head@ and @!!@.
Each unsafe function has up to five variants, e.g. with @tail@:

* @'tail' :: [a] -> [a]@, raises an error on @tail []@, as provided by 'Prelude'.

* @'tailErr' :: [a] -> [a]@, alias for @tail@ that doesn't trigger an @x-partial@ warning and does raise errors.

* @'tailMay' :: [a] -> /Maybe/ [a]@, turns errors into @Nothing@.

* @'tailDef' :: /[a]/ -> [a] -> [a]@, takes a default to return on errors.

* @'tailNote' :: 'Partial' => /String/ -> [a] -> [a]@, takes an extra argument which supplements the error message.

* @'tailSafe' :: [a] -> [a]@, returns some sensible default if possible, @[]@ in the case of @tail@.

All functions marked with the @'Partial'@ constraint are not total, and will produce stack traces on error, on GHC
versions which support them (see "GHC.Stack").

This module also introduces some new functions, documented at the top of the module.
-}

module Safe(
    -- * New functions
    abort, at, lookupJust, findJust, elemIndexJust, findIndexJust,
    -- * Partial functions
    tailErr, headErr,
    -- * Safe wrappers
    tailMay, tailDef, tailNote, tailSafe,
    initMay, initDef, initNote, initSafe,
    headMay, headDef, headNote,
    lastMay, lastDef, lastNote,
    minimumMay, minimumNote,
    maximumMay, maximumNote,
    minimumByMay, minimumByNote,
    maximumByMay, maximumByNote,
    minimumBoundBy, maximumBoundBy,
    maximumBounded, maximumBound,
    minimumBounded, minimumBound,
    foldr1May, foldr1Def, foldr1Note,
    foldl1May, foldl1Def, foldl1Note,
    foldl1May', foldl1Def', foldl1Note',
    scanl1May, scanl1Def, scanl1Note,
    scanr1May, scanr1Def, scanr1Note,
    cycleMay, cycleDef, cycleNote,
    fromJustDef, fromJustNote,
    assertNote,
    atMay, atDef, atNote,
    readMay, readDef, readNote, readEitherSafe,
    lookupJustDef, lookupJustNote,
    findJustDef, findJustNote,
    elemIndexJustDef, elemIndexJustNote,
    findIndexJustDef, findIndexJustNote,
    toEnumMay, toEnumDef, toEnumNote, toEnumSafe,
    succMay, succDef, succNote, succSafe,
    predMay, predDef, predNote, predSafe,
    indexMay, indexDef, indexNote,
    -- * Discouraged
    minimumDef, maximumDef, minimumByDef, maximumByDef
    ) where

import Safe.Util
import Data.Ix
import Data.List
import Data.Maybe
import Safe.Partial

---------------------------------------------------------------------
-- UTILITIES

fromNote :: Partial => String -> String -> Maybe a -> a
fromNote :: forall a. Partial => String -> String -> Maybe a -> a
fromNote = String -> String -> String -> Maybe a -> a
forall a. Partial => String -> String -> String -> Maybe a -> a
fromNoteModule String
"Safe"

fromNoteEither :: Partial => String -> String -> Either String a -> a
fromNoteEither :: forall a. Partial => String -> String -> Either String a -> a
fromNoteEither = String -> String -> String -> Either String a -> a
forall a.
Partial =>
String -> String -> String -> Either String a -> a
fromNoteEitherModule String
"Safe"


---------------------------------------------------------------------
-- IMPLEMENTATIONS

-- | Synonym for 'error'. Used for instances where the program
--   has decided to exit because of invalid user input, or the user pressed
--   quit etc. This function allows 'error' to be reserved for programmer errors.
abort :: Partial => String -> a
abort :: forall a. Partial => String -> a
abort String
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack (String -> a
forall a. Partial => String -> a
error String
x)


at_ :: [a] -> Int -> Either String a
at_ :: forall a. [a] -> Int -> Either String a
at_ [a]
xs Int
o | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"index must not be negative, index=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
o
         | Bool
otherwise = Int -> [a] -> Either String a
forall {b}. Int -> [b] -> Either String b
f Int
o [a]
xs
    where f :: Int -> [b] -> Either String b
f Int
0 (b
x:[b]
xs) = b -> Either String b
forall a b. b -> Either a b
Right b
x
          f Int
i (b
x:[b]
xs) = Int -> [b] -> Either String b
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [b]
xs
          f Int
i [] = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"index too large, index=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", length=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)


---------------------------------------------------------------------
-- WRAPPERS

-- | Identical to 'tail', namely that fails on an empty list.
--   Useful to avoid the @x-partial@ warning introduced in GHC 9.8.
--
-- > tailErr [] = error "Prelude.tail: empty list"
-- > tailErr [1,2,3] = [2,3]
tailErr :: Partial => [a] -> [a]
tailErr :: forall a. Partial => [a] -> [a]
tailErr = [a] -> [a]
forall a. Partial => [a] -> [a]
tail

-- | Identical to 'head', namely that fails on an empty list.
--   Useful to avoid the @x-partial@ warning introduced in GHC 9.8.
--
-- > headErr [] = error "Prelude.head: empty list"
-- > headErr [1,2,3] = 1
headErr :: Partial => [a] -> a
headErr :: forall a. Partial => [a] -> a
headErr = [a] -> a
forall a. Partial => [a] -> a
head

-- |
-- > tailMay [] = Nothing
-- > tailMay [1,3,4] = Just [3,4]
tailMay :: [a] -> Maybe [a]
tailMay :: forall a. [a] -> Maybe [a]
tailMay [] = Maybe [a]
forall a. Maybe a
Nothing
tailMay (a
_:[a]
xs) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs

-- |
-- > tailDef [12] [] = [12]
-- > tailDef [12] [1,3,4] = [3,4]
tailDef :: [a] -> [a] -> [a]
tailDef :: forall a. [a] -> [a] -> [a]
tailDef [a]
def = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
def (Maybe [a] -> [a]) -> ([a] -> Maybe [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe [a]
forall a. [a] -> Maybe [a]
tailMay

-- |
-- > tailNote "help me" [] = error "Safe.tailNote [], help me"
-- > tailNote "help me" [1,3,4] = [3,4]
tailNote :: Partial => String -> [a] -> [a]
tailNote :: forall a. Partial => String -> [a] -> [a]
tailNote String
note [a]
x = (Partial => [a]) -> [a]
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => [a]) -> [a]) -> (Partial => [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [a] -> [a]
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"tailNote []" (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. [a] -> Maybe [a]
tailMay [a]
x

-- |
-- > tailSafe [] = []
-- > tailSafe [1,3,4] = [3,4]
tailSafe :: [a] -> [a]
tailSafe :: forall a. [a] -> [a]
tailSafe = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
tailDef []


initMay :: [a] -> Maybe [a]
initMay :: forall a. [a] -> Maybe [a]
initMay = ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Maybe [a]
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a] -> [a]
forall a. Partial => [a] -> [a]
init

initDef :: [a] -> [a] -> [a]
initDef :: forall a. [a] -> [a] -> [a]
initDef [a]
def = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
def (Maybe [a] -> [a]) -> ([a] -> Maybe [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe [a]
forall a. [a] -> Maybe [a]
initMay

initNote :: Partial => String -> [a] -> [a]
initNote :: forall a. Partial => String -> [a] -> [a]
initNote String
note [a]
x = (Partial => [a]) -> [a]
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => [a]) -> [a]) -> (Partial => [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [a] -> [a]
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"initNote []" (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. [a] -> Maybe [a]
initMay [a]
x

initSafe :: [a] -> [a]
initSafe :: forall a. [a] -> [a]
initSafe = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
initDef []



headMay, lastMay :: [a] -> Maybe a
headMay :: forall a. [a] -> Maybe a
headMay = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe
lastMay :: forall a. [a] -> Maybe a
lastMay = ([a] -> Bool) -> ([a] -> a) -> [a] -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a] -> a
forall a. Partial => [a] -> a
last

headDef, lastDef :: a -> [a] -> a
headDef :: forall a. a -> [a] -> a
headDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> ([a] -> Maybe a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe a
forall a. [a] -> Maybe a
headMay
lastDef :: forall a. a -> [a] -> a
lastDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> ([a] -> Maybe a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe a
forall a. [a] -> Maybe a
lastMay

headNote, lastNote :: Partial => String -> [a] -> a
headNote :: forall a. Partial => String -> [a] -> a
headNote String
note [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"headNote []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a
forall a. [a] -> Maybe a
headMay [a]
x
lastNote :: forall a. Partial => String -> [a] -> a
lastNote String
note [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"lastNote []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a
forall a. [a] -> Maybe a
lastMay [a]
x

minimumMay, maximumMay :: Ord a => [a] -> Maybe a
minimumMay :: forall a. Ord a => [a] -> Maybe a
minimumMay = ([a] -> Bool) -> ([a] -> a) -> [a] -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
maximumMay :: forall a. Ord a => [a] -> Maybe a
maximumMay = ([a] -> Bool) -> ([a] -> a) -> [a] -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum

minimumNote, maximumNote :: (Partial, Ord a) => String -> [a] -> a
minimumNote :: forall a. (Partial, Ord a) => String -> [a] -> a
minimumNote String
note [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"minumumNote []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a
forall a. Ord a => [a] -> Maybe a
minimumMay [a]
x
maximumNote :: forall a. (Partial, Ord a) => String -> [a] -> a
maximumNote String
note [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"maximumNote []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a
forall a. Ord a => [a] -> Maybe a
maximumMay [a]
x

minimumByMay, maximumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a
minimumByMay :: forall a. (a -> a -> Ordering) -> [a] -> Maybe a
minimumByMay = ([a] -> Bool) -> ([a] -> a) -> [a] -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([a] -> a) -> [a] -> Maybe a)
-> ((a -> a -> Ordering) -> [a] -> a)
-> (a -> a -> Ordering)
-> [a]
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy
maximumByMay :: forall a. (a -> a -> Ordering) -> [a] -> Maybe a
maximumByMay = ([a] -> Bool) -> ([a] -> a) -> [a] -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([a] -> a) -> [a] -> Maybe a)
-> ((a -> a -> Ordering) -> [a] -> a)
-> (a -> a -> Ordering)
-> [a]
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy

minimumByNote, maximumByNote :: Partial => String -> (a -> a -> Ordering) -> [a] -> a
minimumByNote :: forall a. Partial => String -> (a -> a -> Ordering) -> [a] -> a
minimumByNote String
note a -> a -> Ordering
f [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"minumumByNote []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> [a] -> Maybe a
forall a. (a -> a -> Ordering) -> [a] -> Maybe a
minimumByMay a -> a -> Ordering
f [a]
x
maximumByNote :: forall a. Partial => String -> (a -> a -> Ordering) -> [a] -> a
maximumByNote String
note a -> a -> Ordering
f [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"maximumByNote []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> [a] -> Maybe a
forall a. (a -> a -> Ordering) -> [a] -> Maybe a
maximumByMay a -> a -> Ordering
f [a]
x

-- | The largest element of a list with respect to the
-- given comparison function. The result is bounded by the value given as the first argument.
maximumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a
maximumBoundBy :: forall a. a -> (a -> a -> Ordering) -> [a] -> a
maximumBoundBy a
x a -> a -> Ordering
f [a]
xs = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy a -> a -> Ordering
f ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

-- | The smallest element of a list with respect to the
-- given comparison function. The result is bounded by the value given as the first argument.
minimumBoundBy :: a -> (a -> a -> Ordering) -> [a] -> a
minimumBoundBy :: forall a. a -> (a -> a -> Ordering) -> [a] -> a
minimumBoundBy a
x a -> a -> Ordering
f [a]
xs = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy a -> a -> Ordering
f ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

-- | The largest element of a list.
-- The result is bounded by the value given as the first argument.
maximumBound :: Ord a => a -> [a] -> a
maximumBound :: forall a. Ord a => a -> [a] -> a
maximumBound a
x [a]
xs = [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

-- | The smallest element of a list.
-- The result is bounded by the value given as the first argument.
minimumBound :: Ord a => a -> [a] -> a
minimumBound :: forall a. Ord a => a -> [a] -> a
minimumBound a
x [a]
xs = [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

-- | The largest element of a list.
-- The result is bounded by 'minBound'.
maximumBounded :: (Ord a, Bounded a) => [a] -> a
maximumBounded :: forall a. (Ord a, Bounded a) => [a] -> a
maximumBounded = a -> [a] -> a
forall a. Ord a => a -> [a] -> a
maximumBound a
forall a. Bounded a => a
minBound

-- | The largest element of a list.
-- The result is bounded by 'maxBound'.
minimumBounded :: (Ord a, Bounded a) => [a] -> a
minimumBounded :: forall a. (Ord a, Bounded a) => [a] -> a
minimumBounded = a -> [a] -> a
forall a. Ord a => a -> [a] -> a
minimumBound a
forall a. Bounded a => a
maxBound

foldr1May, foldl1May, foldl1May' :: (a -> a -> a) -> [a] -> Maybe a
foldr1May :: forall a. (a -> a -> a) -> [a] -> Maybe a
foldr1May = ([a] -> Bool) -> ([a] -> a) -> [a] -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([a] -> a) -> [a] -> Maybe a)
-> ((a -> a -> a) -> [a] -> a) -> (a -> a -> a) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1
foldl1May :: forall a. (a -> a -> a) -> [a] -> Maybe a
foldl1May = ([a] -> Bool) -> ([a] -> a) -> [a] -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([a] -> a) -> [a] -> Maybe a)
-> ((a -> a -> a) -> [a] -> a) -> (a -> a -> a) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1
foldl1May' :: forall a. (a -> a -> a) -> [a] -> Maybe a
foldl1May' = ([a] -> Bool) -> ([a] -> a) -> [a] -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([a] -> a) -> [a] -> Maybe a)
-> ((a -> a -> a) -> [a] -> a) -> (a -> a -> a) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [a] -> a
forall a. Partial => (a -> a -> a) -> [a] -> a
foldl1'

foldr1Note, foldl1Note, foldl1Note' :: Partial => String -> (a -> a -> a) -> [a] -> a
foldr1Note :: forall a. Partial => String -> (a -> a -> a) -> [a] -> a
foldr1Note String
note a -> a -> a
f [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"foldr1Note []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> Maybe a
forall a. (a -> a -> a) -> [a] -> Maybe a
foldr1May a -> a -> a
f [a]
x
foldl1Note :: forall a. Partial => String -> (a -> a -> a) -> [a] -> a
foldl1Note String
note a -> a -> a
f [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"foldl1Note []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> Maybe a
forall a. (a -> a -> a) -> [a] -> Maybe a
foldl1May a -> a -> a
f [a]
x
foldl1Note' :: forall a. Partial => String -> (a -> a -> a) -> [a] -> a
foldl1Note' String
note a -> a -> a
f [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"foldl1Note []" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> Maybe a
forall a. (a -> a -> a) -> [a] -> Maybe a
foldl1May' a -> a -> a
f [a]
x

scanr1May, scanl1May :: (a -> a -> a) -> [a] -> Maybe [a]
scanr1May :: forall a. (a -> a -> a) -> [a] -> Maybe [a]
scanr1May = ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Maybe [a]
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([a] -> [a]) -> [a] -> Maybe [a])
-> ((a -> a -> a) -> [a] -> [a])
-> (a -> a -> a)
-> [a]
-> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a]
scanr1
scanl1May :: forall a. (a -> a -> a) -> [a] -> Maybe [a]
scanl1May = ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Maybe [a]
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([a] -> [a]) -> [a] -> Maybe [a])
-> ((a -> a -> a) -> [a] -> [a])
-> (a -> a -> a)
-> [a]
-> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1

scanr1Def, scanl1Def :: [a] -> (a -> a -> a) -> [a] -> [a]
scanr1Def :: forall a. [a] -> (a -> a -> a) -> [a] -> [a]
scanr1Def [a]
def = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
def (Maybe [a] -> [a])
-> ((a -> a -> a) -> [a] -> Maybe [a])
-> (a -> a -> a)
-> [a]
-> [a]
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> a -> a) -> [a] -> Maybe [a]
forall a. (a -> a -> a) -> [a] -> Maybe [a]
scanr1May
scanl1Def :: forall a. [a] -> (a -> a -> a) -> [a] -> [a]
scanl1Def [a]
def = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
def (Maybe [a] -> [a])
-> ((a -> a -> a) -> [a] -> Maybe [a])
-> (a -> a -> a)
-> [a]
-> [a]
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> a -> a) -> [a] -> Maybe [a]
forall a. (a -> a -> a) -> [a] -> Maybe [a]
scanl1May

scanr1Note, scanl1Note :: Partial => String -> (a -> a -> a) -> [a] -> [a]
scanr1Note :: forall a. Partial => String -> (a -> a -> a) -> [a] -> [a]
scanr1Note String
note a -> a -> a
f [a]
x = (Partial => [a]) -> [a]
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => [a]) -> [a]) -> (Partial => [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [a] -> [a]
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"scanr1Note []" (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> Maybe [a]
forall a. (a -> a -> a) -> [a] -> Maybe [a]
scanr1May a -> a -> a
f [a]
x
scanl1Note :: forall a. Partial => String -> (a -> a -> a) -> [a] -> [a]
scanl1Note String
note a -> a -> a
f [a]
x = (Partial => [a]) -> [a]
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => [a]) -> [a]) -> (Partial => [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [a] -> [a]
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"scanl1Note []" (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> Maybe [a]
forall a. (a -> a -> a) -> [a] -> Maybe [a]
scanl1May a -> a -> a
f [a]
x

cycleMay :: [a] -> Maybe [a]
cycleMay :: forall a. [a] -> Maybe [a]
cycleMay = ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Maybe [a]
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a] -> [a]
forall a. Partial => [a] -> [a]
cycle

cycleDef :: [a] -> [a] -> [a]
cycleDef :: forall a. [a] -> [a] -> [a]
cycleDef [a]
def = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
def (Maybe [a] -> [a]) -> ([a] -> Maybe [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe [a]
forall a. [a] -> Maybe [a]
cycleMay

cycleNote :: Partial => String -> [a] -> [a]
cycleNote :: forall a. Partial => String -> [a] -> [a]
cycleNote String
note [a]
x = (Partial => [a]) -> [a]
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => [a]) -> [a]) -> (Partial => [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [a] -> [a]
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"cycleNote []" (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. [a] -> Maybe [a]
cycleMay [a]
x

-- | An alternative name for 'fromMaybe', to fit the naming scheme of this package.
--   Generally using 'fromMaybe' directly would be considered better style.
fromJustDef :: a -> Maybe a -> a
fromJustDef :: forall a. a -> Maybe a -> a
fromJustDef  = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe

fromJustNote :: Partial => String -> Maybe a -> a
fromJustNote :: forall a. Partial => String -> Maybe a -> a
fromJustNote String
note Maybe a
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"fromJustNote Nothing" Maybe a
x

assertNote :: Partial => String -> Bool -> a -> a
assertNote :: forall a. Partial => String -> Bool -> a -> a
assertNote String
note Bool
True a
val = a
val
assertNote String
note Bool
False a
val = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"assertNote False" Maybe a
forall a. Maybe a
Nothing


-- | Synonym for '!!', but includes more information in the error message.
at :: Partial => [a] -> Int -> a
at :: forall a. Partial => [a] -> Int -> a
at = String -> String -> Either String a -> a
forall a. Partial => String -> String -> Either String a -> a
fromNoteEither String
"" String
"at" (Either String a -> a)
-> ([a] -> Int -> Either String a) -> [a] -> Int -> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ [a] -> Int -> Either String a
forall a. [a] -> Int -> Either String a
at_

atMay :: [a] -> Int -> Maybe a
atMay :: forall a. [a] -> Int -> Maybe a
atMay = Either String a -> Maybe a
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String a -> Maybe a)
-> ([a] -> Int -> Either String a) -> [a] -> Int -> Maybe a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ [a] -> Int -> Either String a
forall a. [a] -> Int -> Either String a
at_

atDef :: a -> [a] -> Int -> a
atDef :: forall a. a -> [a] -> Int -> a
atDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> ([a] -> Int -> Maybe a) -> [a] -> Int -> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
atMay

atNote :: Partial => String -> [a] -> Int -> a
atNote :: forall a. Partial => String -> [a] -> Int -> a
atNote String
note [a]
f Int
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Either String a -> a
forall a. Partial => String -> String -> Either String a -> a
fromNoteEither String
note String
"atNote" (Either String a -> a) -> Either String a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> Int -> Either String a
forall a. [a] -> Int -> Either String a
at_ [a]
f Int
x

-- | This function provides a more precise error message than 'readEither' from 'base'.
readEitherSafe :: Read a => String -> Either String a
readEitherSafe :: forall a. Read a => String -> Either String a
readEitherSafe String
s = case [a
x | (a
x,String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s, (String
"",String
"") <- ReadS String
lex String
t] of
        [a
x] -> a -> Either String a
forall a b. b -> Either a b
Right a
x
        []  -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"no parse on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix
        [a]
_   -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"ambiguous parse on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix
    where
        maxLength :: Int
maxLength = Int
15
        prefix :: String
prefix = Char
'\"' Char -> String -> String
forall a. a -> [a] -> [a]
: String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLength then String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"" else String
"...\""
            where (String
a,String
b) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
maxLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) String
s

readMay :: Read a => String -> Maybe a
readMay :: forall a. Read a => String -> Maybe a
readMay = Either String a -> Maybe a
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String a -> Maybe a)
-> (String -> Either String a) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a. Read a => String -> Either String a
readEitherSafe

readDef :: Read a => a -> String -> a
readDef :: forall a. Read a => a -> String -> a
readDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> (String -> Maybe a) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMay

-- | 'readNote' uses 'readEitherSafe' for the error message.
readNote :: (Partial, Read a) => String -> String -> a
readNote :: forall a. (Partial, Read a) => String -> String -> a
readNote String
note String
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Either String a -> a
forall a. Partial => String -> String -> Either String a -> a
fromNoteEither String
note String
"readNote" (Either String a -> a) -> Either String a -> a
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a. Read a => String -> Either String a
readEitherSafe String
x

-- |
-- > lookupJust key = fromJust . lookup key
lookupJust :: (Eq a, Partial) => a -> [(a,b)] -> b
lookupJust :: forall a b. (Eq a, Partial) => a -> [(a, b)] -> b
lookupJust a
x [(a, b)]
xs = (Partial => b) -> b
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => b) -> b) -> (Partial => b) -> b
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe b -> b
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
"" String
"lookupJust, no matching value" (Maybe b -> b) -> Maybe b -> b
forall a b. (a -> b) -> a -> b
$ a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x [(a, b)]
xs

lookupJustDef :: Eq a => b -> a -> [(a,b)] -> b
lookupJustDef :: forall a b. Eq a => b -> a -> [(a, b)] -> b
lookupJustDef b
def = b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
def (Maybe b -> b) -> (a -> [(a, b)] -> Maybe b) -> a -> [(a, b)] -> b
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup

lookupJustNote :: (Partial, Eq a) => String -> a -> [(a,b)] -> b
lookupJustNote :: forall a b. (Partial, Eq a) => String -> a -> [(a, b)] -> b
lookupJustNote String
note a
x [(a, b)]
xs = (Partial => b) -> b
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => b) -> b) -> (Partial => b) -> b
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe b -> b
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"lookupJustNote, no matching value" (Maybe b -> b) -> Maybe b -> b
forall a b. (a -> b) -> a -> b
$ a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x [(a, b)]
xs

-- |
-- > findJust op = fromJust . find op
findJust :: (a -> Bool) -> [a] -> a
findJust :: forall a. (a -> Bool) -> [a] -> a
findJust = String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
"" String
"findJust, no matching value" (Maybe a -> a)
-> ((a -> Bool) -> [a] -> Maybe a) -> (a -> Bool) -> [a] -> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find

findJustDef :: a -> (a -> Bool) -> [a] -> a
findJustDef :: forall a. a -> (a -> Bool) -> [a] -> a
findJustDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a)
-> ((a -> Bool) -> [a] -> Maybe a) -> (a -> Bool) -> [a] -> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find

findJustNote :: Partial => String -> (a -> Bool) -> [a] -> a
findJustNote :: forall a. Partial => String -> (a -> Bool) -> [a] -> a
findJustNote String
note a -> Bool
f [a]
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"findJustNote, no matching value" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find a -> Bool
f [a]
x

-- |
-- > elemIndexJust op = fromJust . elemIndex op
elemIndexJust :: (Partial, Eq a) => a -> [a] -> Int
elemIndexJust :: forall a. (Partial, Eq a) => a -> [a] -> Int
elemIndexJust a
x [a]
xs = (Partial => Int) -> Int
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => Int) -> Int) -> (Partial => Int) -> Int
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe Int -> Int
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
"" String
"elemIndexJust, no matching value" (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
x [a]
xs

elemIndexJustDef :: Eq a => Int -> a -> [a] -> Int
elemIndexJustDef :: forall a. Eq a => Int -> a -> [a] -> Int
elemIndexJustDef Int
def = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
def (Maybe Int -> Int) -> (a -> [a] -> Maybe Int) -> a -> [a] -> Int
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex

elemIndexJustNote :: (Partial, Eq a) => String -> a -> [a] -> Int
elemIndexJustNote :: forall a. (Partial, Eq a) => String -> a -> [a] -> Int
elemIndexJustNote String
note a
x [a]
xs = (Partial => Int) -> Int
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => Int) -> Int) -> (Partial => Int) -> Int
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe Int -> Int
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"elemIndexJustNote, no matching value" (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
x [a]
xs

-- |
-- > findIndexJust op = fromJust . findIndex op
findIndexJust :: (a -> Bool) -> [a] -> Int
findIndexJust :: forall a. (a -> Bool) -> [a] -> Int
findIndexJust a -> Bool
f [a]
x = (Partial => Int) -> Int
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => Int) -> Int) -> (Partial => Int) -> Int
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe Int -> Int
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
"" String
"findIndexJust, no matching value" (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex a -> Bool
f [a]
x

findIndexJustDef :: Int -> (a -> Bool) -> [a] -> Int
findIndexJustDef :: forall a. Int -> (a -> Bool) -> [a] -> Int
findIndexJustDef Int
def = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
def (Maybe Int -> Int)
-> ((a -> Bool) -> [a] -> Maybe Int) -> (a -> Bool) -> [a] -> Int
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex

findIndexJustNote :: Partial => String -> (a -> Bool) -> [a] -> Int
findIndexJustNote :: forall a. Partial => String -> (a -> Bool) -> [a] -> Int
findIndexJustNote String
note a -> Bool
f [a]
x = (Partial => Int) -> Int
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => Int) -> Int) -> (Partial => Int) -> Int
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe Int -> Int
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"findIndexJustNote, no matching value" (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex a -> Bool
f [a]
x

-- From http://stackoverflow.com/questions/2743858/safe-and-polymorphic-toenum
-- answer by C. A. McCann
toEnumMay :: (Enum a, Bounded a) => Int -> Maybe a
toEnumMay :: forall a. (Enum a, Bounded a) => Int -> Maybe a
toEnumMay Int
i =
  let r :: a
r = Int -> a
forall a. Enum a => Int -> a
toEnum Int
i
      max :: a
max = a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
r
      min :: a
min = a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
r
  in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall a. Enum a => a -> Int
fromEnum a
min Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
forall a. Enum a => a -> Int
fromEnum a
max
  then a -> Maybe a
forall a. a -> Maybe a
Just a
r
  else Maybe a
forall a. Maybe a
Nothing

toEnumDef :: (Enum a, Bounded a) => a -> Int -> a
toEnumDef :: forall a. (Enum a, Bounded a) => a -> Int -> a
toEnumDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> (Int -> Maybe a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe a
forall a. (Enum a, Bounded a) => Int -> Maybe a
toEnumMay

toEnumNote :: (Partial, Enum a, Bounded a) => String -> Int -> a
toEnumNote :: forall a. (Partial, Enum a, Bounded a) => String -> Int -> a
toEnumNote String
note Int
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"toEnumNote, out of range" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Maybe a
forall a. (Enum a, Bounded a) => Int -> Maybe a
toEnumMay Int
x

toEnumSafe :: (Enum a, Bounded a) => Int -> a
toEnumSafe :: forall a. (Enum a, Bounded a) => Int -> a
toEnumSafe = a -> Int -> a
forall a. (Enum a, Bounded a) => a -> Int -> a
toEnumDef a
forall a. Bounded a => a
minBound

succMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a
succMay :: forall a. (Enum a, Eq a, Bounded a) => a -> Maybe a
succMay = (a -> Bool) -> (a -> a) -> a -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound) a -> a
forall a. Enum a => a -> a
succ

succDef :: (Enum a, Eq a, Bounded a) => a -> a -> a
succDef :: forall a. (Enum a, Eq a, Bounded a) => a -> a -> a
succDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. (Enum a, Eq a, Bounded a) => a -> Maybe a
succMay

succNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a
succNote :: forall a. (Partial, Enum a, Eq a, Bounded a) => String -> a -> a
succNote String
note a
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"succNote, out of range" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. (Enum a, Eq a, Bounded a) => a -> Maybe a
succMay a
x

succSafe :: (Enum a, Eq a, Bounded a) => a -> a
succSafe :: forall a. (Enum a, Eq a, Bounded a) => a -> a
succSafe = a -> a -> a
forall a. (Enum a, Eq a, Bounded a) => a -> a -> a
succDef a
forall a. Bounded a => a
maxBound

predMay :: (Enum a, Eq a, Bounded a) => a -> Maybe a
predMay :: forall a. (Enum a, Eq a, Bounded a) => a -> Maybe a
predMay = (a -> Bool) -> (a -> a) -> a -> Maybe a
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMay (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
minBound) a -> a
forall a. Enum a => a -> a
pred

predDef :: (Enum a, Eq a, Bounded a) => a -> a -> a
predDef :: forall a. (Enum a, Eq a, Bounded a) => a -> a -> a
predDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. (Enum a, Eq a, Bounded a) => a -> Maybe a
predMay

predNote :: (Partial, Enum a, Eq a, Bounded a) => String -> a -> a
predNote :: forall a. (Partial, Enum a, Eq a, Bounded a) => String -> a -> a
predNote String
note a
x = (Partial => a) -> a
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => a) -> a) -> (Partial => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe a -> a
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"predNote, out of range" (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. (Enum a, Eq a, Bounded a) => a -> Maybe a
predMay a
x

predSafe :: (Enum a, Eq a, Bounded a) => a -> a
predSafe :: forall a. (Enum a, Eq a, Bounded a) => a -> a
predSafe = a -> a -> a
forall a. (Enum a, Eq a, Bounded a) => a -> a -> a
predDef a
forall a. Bounded a => a
minBound

indexMay :: Ix a => (a, a) -> a -> Maybe Int
indexMay :: forall a. Ix a => (a, a) -> a -> Maybe Int
indexMay (a, a)
b a
i = if (a, a) -> a -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (a, a)
b a
i then Int -> Maybe Int
forall a. a -> Maybe a
Just ((a, a) -> a -> Int
forall a. Ix a => (a, a) -> a -> Int
index (a, a)
b a
i) else Maybe Int
forall a. Maybe a
Nothing

indexDef :: Ix a => Int -> (a, a) -> a -> Int
indexDef :: forall a. Ix a => Int -> (a, a) -> a -> Int
indexDef Int
def (a, a)
b = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
def (Maybe Int -> Int) -> (a -> Maybe Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a -> Maybe Int
forall a. Ix a => (a, a) -> a -> Maybe Int
indexMay (a, a)
b

indexNote :: (Partial, Ix a) => String -> (a, a) -> a -> Int
indexNote :: forall a. (Partial, Ix a) => String -> (a, a) -> a -> Int
indexNote String
note (a, a)
x a
y = (Partial => Int) -> Int
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => Int) -> Int) -> (Partial => Int) -> Int
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe Int -> Int
forall a. Partial => String -> String -> Maybe a -> a
fromNote String
note String
"indexNote, out of range" (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (a, a) -> a -> Maybe Int
forall a. Ix a => (a, a) -> a -> Maybe Int
indexMay (a, a)
x a
y


---------------------------------------------------------------------
-- DISCOURAGED

-- | New users are recommended to use 'minimumBound' or 'maximumBound' instead.
minimumDef, maximumDef :: Ord a => a -> [a] -> a
minimumDef :: forall a. Ord a => a -> [a] -> a
minimumDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> ([a] -> Maybe a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe a
forall a. Ord a => [a] -> Maybe a
minimumMay
maximumDef :: forall a. Ord a => a -> [a] -> a
maximumDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> ([a] -> Maybe a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe a
forall a. Ord a => [a] -> Maybe a
maximumMay

-- | New users are recommended to use 'minimumBoundBy' or 'maximumBoundBy' instead.
minimumByDef, maximumByDef :: a -> (a -> a -> Ordering) -> [a] -> a
minimumByDef :: forall a. a -> (a -> a -> Ordering) -> [a] -> a
minimumByDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a)
-> ((a -> a -> Ordering) -> [a] -> Maybe a)
-> (a -> a -> Ordering)
-> [a]
-> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> a -> Ordering) -> [a] -> Maybe a
forall a. (a -> a -> Ordering) -> [a] -> Maybe a
minimumByMay
maximumByDef :: forall a. a -> (a -> a -> Ordering) -> [a] -> a
maximumByDef a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a)
-> ((a -> a -> Ordering) -> [a] -> Maybe a)
-> (a -> a -> Ordering)
-> [a]
-> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> a -> Ordering) -> [a] -> Maybe a
forall a. (a -> a -> Ordering) -> [a] -> Maybe a
maximumByMay


---------------------------------------------------------------------
-- DEPRECATED

{-# DEPRECATED foldr1Def "Use @foldr1May@ instead." #-}
{-# DEPRECATED foldl1Def "Use @foldl1May@ instead." #-}
{-# DEPRECATED foldl1Def' "Use @foldl1May'@ instead." #-}
foldr1Def, foldl1Def, foldl1Def' :: a -> (a -> a -> a) -> [a] -> a
foldr1Def :: forall a. a -> (a -> a -> a) -> [a] -> a
foldr1Def a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a)
-> ((a -> a -> a) -> [a] -> Maybe a) -> (a -> a -> a) -> [a] -> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> a -> a) -> [a] -> Maybe a
forall a. (a -> a -> a) -> [a] -> Maybe a
foldr1May
foldl1Def :: forall a. a -> (a -> a -> a) -> [a] -> a
foldl1Def a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a)
-> ((a -> a -> a) -> [a] -> Maybe a) -> (a -> a -> a) -> [a] -> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> a -> a) -> [a] -> Maybe a
forall a. (a -> a -> a) -> [a] -> Maybe a
foldl1May
foldl1Def' :: forall a. a -> (a -> a -> a) -> [a] -> a
foldl1Def' a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a)
-> ((a -> a -> a) -> [a] -> Maybe a) -> (a -> a -> a) -> [a] -> a
forall b c a1 a2.
Partial =>
(b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c
.^ (a -> a -> a) -> [a] -> Maybe a
forall a. (a -> a -> a) -> [a] -> Maybe a
foldl1May'