{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Primus.Enum (
universe1,
universe1R,
enumFrom1,
enumFrom1R,
enumTo1,
enumFromThen1,
enumFromTo1,
enumFromThenTo1,
predSafe,
succSafe,
integerToEnumSafe,
integerToIntSafe,
toEnumList,
toEnumList1,
universeTraversable,
toEnumTraversable,
succTraversable,
predTraversable,
fromEnumFoldable,
fromEnumFoldable1,
capacity,
) where
import Control.Arrow
import Data.Foldable
import Data.Function
import Data.Functor
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty (..))
import Data.Ord
import Data.Semigroup.Foldable
import Primus.Error
import Primus.Fold
universe1 :: forall a. (Bounded a, Enum a) => NonEmpty a
universe1 :: NonEmpty a
universe1 = a -> NonEmpty a
forall a. (Bounded a, Enum a) => a -> NonEmpty a
enumFrom1 a
forall a. Bounded a => a
minBound
universe1R :: forall a. (Bounded a, Enum a) => NonEmpty a
universe1R :: NonEmpty a
universe1R = a -> NonEmpty a
forall a. (Bounded a, Enum a) => a -> NonEmpty a
enumFrom1R a
forall a. Bounded a => a
maxBound
enumFrom1 :: (Bounded a, Enum a) => a -> NonEmpty a
enumFrom1 :: a -> NonEmpty a
enumFrom1 a
a = a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
a .. a
forall a. Bounded a => a
maxBound]
enumTo1 :: (Bounded a, Enum a) => a -> NonEmpty a
enumTo1 :: a -> NonEmpty a
enumTo1 a
a = a
forall a. Bounded a => a
minBound a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
forall a. Bounded a => a
minBound .. a
a]
enumFromThen1 :: (Bounded a, Enum a) => a -> a -> NonEmpty a
enumFromThen1 :: a -> a -> NonEmpty a
enumFromThen1 a
a a
b =
case (a -> Int) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> Int
forall a. Enum a => a -> Int
fromEnum a
a a
b of
Ordering
LT -> a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
a, a
b .. a
forall a. Bounded a => a
maxBound]
Ordering
EQ -> a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
Ordering
GT -> a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
a, a
b .. a
forall a. Bounded a => a
minBound]
enumFromThenTo1 :: Enum a => a -> a -> a -> NonEmpty a
enumFromThenTo1 :: a -> a -> a -> NonEmpty a
enumFromThenTo1 a
a a
b a
c =
if (a -> Int) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> Int
forall a. Enum a => a -> Int
fromEnum a
a a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
then a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
else a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
a, a
b .. a
c]
enumFromTo1 :: Enum a => a -> a -> NonEmpty a
enumFromTo1 :: a -> a -> NonEmpty a
enumFromTo1 a
a a
b =
case (a -> Int) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> Int
forall a. Enum a => a -> Int
fromEnum a
a a
b of
Ordering
LT -> a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
a .. a
b]
Ordering
EQ -> a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
Ordering
GT -> a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
a, a -> a
forall a. Enum a => a -> a
pred a
a .. a
b]
enumFrom1R :: forall a. (Bounded a, Enum a) => a -> NonEmpty a
enumFrom1R :: a -> NonEmpty a
enumFrom1R a
a
| Just a
prv <- a -> Maybe a
forall a. (Bounded a, Enum a) => a -> Maybe a
predSafe a
a = a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a
a, a
prv .. a
forall a. Bounded a => a
minBound]
| Bool
otherwise = a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
predSafe :: (Bounded a, Enum a) => a -> Maybe a
predSafe :: a -> Maybe a
predSafe a
a
| (Int -> Int -> Bool) -> (a -> Int) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) a -> Int
forall a. Enum a => a -> Int
fromEnum a
a a
forall a. Bounded a => a
minBound = Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a
forall a. Enum a => a -> a
pred a
a)
succSafe :: (Bounded a, Enum a) => a -> Maybe a
succSafe :: a -> Maybe a
succSafe a
a
| (Int -> Int -> Bool) -> (a -> Int) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) a -> Int
forall a. Enum a => a -> Int
fromEnum a
a a
forall a. Bounded a => a
maxBound = Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a
forall a. Enum a => a -> a
succ a
a)
toEnumTraversable ::
forall a f z.
(Traversable f, Enum a, Bounded a) =>
f z ->
Integer ->
Either String (f a)
toEnumTraversable :: f z -> Integer -> Either String (f a)
toEnumTraversable f z
tz Integer
i = do
[a]
lst <- Integer -> Either String [a]
forall a. (Enum a, Bounded a) => Integer -> Either String [a]
toEnumList @a Integer
i
a
z <- Either String a
forall a. (Bounded a, Enum a) => Either String a
zerolr
(Integer, Integer)
c <- f z -> Either String (Integer, Integer)
forall a (t :: * -> *) z.
(Bounded a, Enum a, Foldable t) =>
t z -> Either String (Integer, Integer)
capacity @a f z
tz
String -> Either String (f a) -> Either String (f a)
forall a. String -> Either String a -> Either String a
lmsg (String
"cap=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Integer, Integer) -> String
forall a. Show a => a -> String
show (Integer, Integer)
c) (Either String (f a) -> Either String (f a))
-> Either String (f a) -> Either String (f a)
forall a b. (a -> b) -> a -> b
$ f a -> [a] -> Either String (f a)
forall (t :: * -> *) a.
Traversable t =>
t a -> [a] -> Either String (t a)
padL (a
z a -> f z -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f z
tz) [a]
lst
zerolr :: forall a. (Bounded a, Enum a) => Either String a
zerolr :: Either String a
zerolr = (String -> String) -> Either String a -> Either String a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> String -> String
forall a b. a -> b -> a
const String
"zerolr: not defined at zero") (Either String a -> Either String a)
-> Either String a -> Either String a
forall a b. (a -> b) -> a -> b
$ Integer -> Either String a
forall a. (Enum a, Bounded a) => Integer -> Either String a
integerToEnumSafe @a Integer
0
capacity :: forall a t z. (Bounded a, Enum a, Foldable t) => t z -> Either String (Integer, Integer)
capacity :: t z -> Either String (Integer, Integer)
capacity (t z -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
len) = String
-> Either String (Integer, Integer)
-> Either String (Integer, Integer)
forall a. String -> Either String a -> Either String a
lmsg String
"capacity" (Either String (Integer, Integer)
-> Either String (Integer, Integer))
-> Either String (Integer, Integer)
-> Either String (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ do
let z :: (Integer, Integer)
z@(Integer
mn, Integer
mx) = (Enum a, Bounded a) => (Integer, Integer)
forall a. (Enum a, Bounded a) => (Integer, Integer)
minMax @a
Integer
lhs <- case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
mn Integer
0 of
Ordering
LT -> Integer -> Either String Integer
forall a b. b -> Either a b
Right (-(-Integer
mn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
Ordering
EQ -> Integer -> Either String Integer
forall a b. b -> Either a b
Right Integer
0
Ordering
GT -> String -> Either String Integer
forall a b. a -> Either a b
Left (String -> Either String Integer)
-> String -> Either String Integer
forall a b. (a -> b) -> a -> b
$ String
"unsupported mn > 0: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Integer, Integer) -> String
forall a. Show a => a -> String
show (Integer, Integer)
z
Integer
rhs <- case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
0 Integer
mx of
Ordering
LT -> Integer -> Either String Integer
forall a b. b -> Either a b
Right ((Integer
mx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
Ordering
EQ -> Integer -> Either String Integer
forall a b. b -> Either a b
Right Integer
0
Ordering
GT -> String -> Either String Integer
forall a b. a -> Either a b
Left (String -> Either String Integer)
-> String -> Either String Integer
forall a b. (a -> b) -> a -> b
$ String
"unsupported mx < 0: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Integer, Integer) -> String
forall a. Show a => a -> String
show (Integer, Integer)
z
(Integer, Integer) -> Either String (Integer, Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
lhs, Integer
rhs)
toEnumList :: forall a. (Enum a, Bounded a) => Integer -> Either String [a]
toEnumList :: Integer -> Either String [a]
toEnumList Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [] [a] -> Either String a -> Either String [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Bounded a, Enum a) => Either String a
forall a. (Bounded a, Enum a) => Either String a
zerolr @a
| Bool
otherwise =
let f :: Integer -> Either String (Maybe (a, Integer))
f :: Integer -> Either String (Maybe (a, Integer))
f Integer
s
| Integer
s Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Maybe (a, Integer) -> Either String (Maybe (a, Integer))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, Integer)
forall a. Maybe a
Nothing
| Bool
otherwise =
Integer -> Either String (Integer, a)
forall a.
(Enum a, Bounded a) =>
Integer -> Either String (Integer, a)
calcNextEnum Integer
s Either String (Integer, a)
-> ((Integer, a) -> Maybe (a, Integer))
-> Either String (Maybe (a, Integer))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Integer
s', a
a) ->
if Integer -> Integer
forall a. Num a => a -> a
abs Integer
s' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer -> Integer
forall a. Num a => a -> a
abs Integer
s
then (a, Integer) -> Maybe (a, Integer)
forall a. a -> Maybe a
Just (a
a, Integer
s')
else
if Integer
s' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
then Maybe (a, Integer)
forall a. Maybe a
Nothing
else String -> Maybe (a, Integer)
forall a. HasCallStack => String -> a
programmError String
"toEnumList"
in (Integer -> Either String (Maybe (a, Integer)))
-> Integer -> Either String [a]
forall (m :: * -> *) s a.
Monad m =>
(s -> m (Maybe (a, s))) -> s -> m [a]
unfoldlM Integer -> Either String (Maybe (a, Integer))
f Integer
i
calcNextEnum :: forall a. (Enum a, Bounded a) => Integer -> Either String (Integer, a)
calcNextEnum :: Integer -> Either String (Integer, a)
calcNextEnum Integer
i = String -> Either String (Integer, a) -> Either String (Integer, a)
forall a. String -> Either String a -> Either String a
lmsg String
"calcNextEnum" (Either String (Integer, a) -> Either String (Integer, a))
-> Either String (Integer, a) -> Either String (Integer, a)
forall a b. (a -> b) -> a -> b
$
case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
i Integer
0 of
Ordering
GT
| Integer
mx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 ->
let (Integer
a, Integer
b) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i (Integer
mx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
in case Integer -> Either String a
forall a. (Enum a, Bounded a) => Integer -> Either String a
integerToEnumSafe Integer
b of
Left String
e -> String -> Either String (Integer, a)
forall a b. a -> Either a b
Left (String -> Either String (Integer, a))
-> String -> Either String (Integer, a)
forall a b. (a -> b) -> a -> b
$ String
"out of range(GT): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" mod " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
mx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(undefined) e=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
Right a
c -> (Integer, a) -> Either String (Integer, a)
forall a b. b -> Either a b
Right (Integer
a, a
c)
| Bool
otherwise -> String -> Either String (Integer, a)
forall a b. a -> Either a b
Left String
"not defined for positive numbers"
Ordering
EQ -> (Integer
0,) (a -> (Integer, a))
-> Either String a -> Either String (Integer, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String a
forall a. (Bounded a, Enum a) => Either String a
zerolr
Ordering
LT
| Integer
mn Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 ->
let (Integer
a, Integer
b) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
i (Integer
mn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
in case Integer -> Either String a
forall a. (Enum a, Bounded a) => Integer -> Either String a
integerToEnumSafe Integer
b of
Left String
e -> String -> Either String (Integer, a)
forall a b. a -> Either a b
Left (String -> Either String (Integer, a))
-> String -> Either String (Integer, a)
forall a b. (a -> b) -> a -> b
$ String
"out of range(LT): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" mod " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
mn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(undefined) e=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
Right a
c -> (Integer, a) -> Either String (Integer, a)
forall a b. b -> Either a b
Right (-Integer
a, a
c)
| Bool
otherwise -> String -> Either String (Integer, a)
forall a b. a -> Either a b
Left String
"not defined for negative numbers"
where
(Integer
mn, Integer
mx) = (Enum a, Bounded a) => (Integer, Integer)
forall a. (Enum a, Bounded a) => (Integer, Integer)
minMax @a
minMax :: forall a. (Enum a, Bounded a) => (Integer, Integer)
minMax :: (Integer, Integer)
minMax = (Integer -> Integer -> (Integer, Integer))
-> (a -> Integer) -> a -> a -> (Integer, Integer)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (,) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (a -> Int) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enum a => a -> Int
forall a. Enum a => a -> Int
fromEnum @a) a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound
integerToIntSafe :: Integer -> Either String Int
integerToIntSafe :: Integer -> Either String Int
integerToIntSafe = Integer -> Either String Int
forall a. (Enum a, Bounded a) => Integer -> Either String a
integerToEnumSafe
integerToEnumSafe :: forall a. (Enum a, Bounded a) => Integer -> Either String a
integerToEnumSafe :: Integer -> Either String a
integerToEnumSafe Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
mn = 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 -> String
msg String
"underflow"
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
mx = 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 -> String
msg String
"overflow"
| Bool
otherwise = a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ Enum a => Int -> a
forall a. Enum a => Int -> a
toEnum @a (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger @Int Integer
i
where
(Integer
mn, Integer
mx) = (Enum a, Bounded a) => (Integer, Integer)
forall a. (Enum a, Bounded a) => (Integer, Integer)
minMax @a
msg :: String -> String
msg String
s = String
"integerToEnumSafe:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" where " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not in range [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
mn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
mx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
toEnumList1 :: forall a. (Enum a, Bounded a) => Integer -> Either String (NonEmpty a)
toEnumList1 :: Integer -> Either String (NonEmpty a)
toEnumList1 Integer
i =
Integer -> Either String [a]
forall a. (Enum a, Bounded a) => Integer -> Either String [a]
toEnumList Integer
i Either String [a]
-> ([a] -> NonEmpty a) -> Either String (NonEmpty a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
[] -> a
forall a. Bounded a => a
minBound a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
a
a : [a]
as -> a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as
fromEnumFoldable ::
forall a t.
(Foldable t, Enum a, Bounded a) =>
t a ->
Either String Integer
t a
xs =
case t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
xs of
[] -> Integer
0 Integer -> Either String a -> Either String Integer
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Bounded a, Enum a) => Either String a
forall a. (Bounded a, Enum a) => Either String a
zerolr @a
a
a : [a]
as -> Integer -> Either String Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either String Integer)
-> Integer -> Either String Integer
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> Integer
forall a (t :: * -> *).
(Foldable1 t, Enum a, Bounded a) =>
t a -> Integer
fromEnumFoldable1 (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as)
fromEnumFoldable1 ::
forall a t.
(Foldable1 t, Enum a, Bounded a) =>
t a ->
Integer
t a
xs =
let (Integer
mn, Integer
mx) = (Enum a, Bounded a) => (Integer, Integer)
forall a. (Enum a, Bounded a) => (Integer, Integer)
minMax @a
nn, pp :: Maybe Integer
nn :: Maybe Integer
nn = if Integer
mn Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
1) else Maybe Integer
forall a. Maybe a
Nothing
pp :: Maybe Integer
pp = if Integer
mx Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1 else Maybe Integer
forall a. Maybe a
Nothing
f ::
a ->
(Integer, (Maybe Integer, Maybe Integer)) ->
(Integer, (Maybe Integer, Maybe Integer))
f :: a
-> (Integer, (Maybe Integer, Maybe Integer))
-> (Integer, (Maybe Integer, Maybe Integer))
f a
a (Integer
b, (Maybe Integer
n, Maybe Integer
p)) =
let v :: Integer
v = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (a -> Int
forall a. Enum a => a -> Int
fromEnum a
a)
w :: Integer
w = case (Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
v Integer
0, Maybe Integer
n, Maybe Integer
p) of
(Ordering
LT, Just Integer
x, Maybe Integer
_) -> Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x
(Ordering
EQ, Maybe Integer
_, Maybe Integer
_) -> Integer
b
(Ordering
GT, Maybe Integer
_, Just Integer
y) -> Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y
(Ordering, Maybe Integer, Maybe Integer)
o -> String -> Integer
forall a. HasCallStack => String -> a
programmError (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ String
"fromEnumFoldable1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Ordering, Maybe Integer, Maybe Integer) -> String
forall a. Show a => a -> String
show (Ordering, Maybe Integer, Maybe Integer)
o
in (Integer
w, ((\Integer
x -> -(Integer
mn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x) (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
n, (\Integer
x -> (Integer
mx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x) (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
p))
in (Integer, (Maybe Integer, Maybe Integer)) -> Integer
forall a b. (a, b) -> a
fst ((Integer, (Maybe Integer, Maybe Integer)) -> Integer)
-> (Integer, (Maybe Integer, Maybe Integer)) -> Integer
forall a b. (a -> b) -> a -> b
$ (a
-> (Integer, (Maybe Integer, Maybe Integer))
-> (Integer, (Maybe Integer, Maybe Integer)))
-> (Integer, (Maybe Integer, Maybe Integer))
-> t a
-> (Integer, (Maybe Integer, Maybe Integer))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a
-> (Integer, (Maybe Integer, Maybe Integer))
-> (Integer, (Maybe Integer, Maybe Integer))
f (Integer
0, (Maybe Integer
nn, Maybe Integer
pp)) t a
xs
succTraversable ::
forall a t.
(Traversable t, Enum a, Bounded a) =>
t a ->
Either String (t a)
succTraversable :: t a -> Either String (t a)
succTraversable t a
xs =
let f :: Bool -> a -> (Bool, a)
f :: Bool -> a -> (Bool, a)
f Bool
b a
a =
case (Bool
b, a -> Maybe a
forall a. (Bounded a, Enum a) => a -> Maybe a
succSafe a
a) of
(Bool
True, Just a
a') -> (Bool
False, a
a')
(Bool
True, Maybe a
Nothing) -> (Bool
True, a
forall a. Bounded a => a
minBound)
(Bool, Maybe a)
_o -> (Bool
b, a
a)
(Bool
lft, t a
ret) = (Bool -> a -> (Bool, a)) -> Bool -> t a -> (Bool, t a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumR Bool -> a -> (Bool, a)
f Bool
True t a
xs
in if Bool
lft
then String -> Either String (t a)
forall a b. a -> Either a b
Left String
"succTraversable: over maxbound"
else t a -> Either String (t a)
forall a b. b -> Either a b
Right t a
ret
predTraversable ::
forall a t.
(Traversable t, Enum a, Bounded a) =>
t a ->
Either String (t a)
predTraversable :: t a -> Either String (t a)
predTraversable t a
xs =
let f :: Bool -> a -> (Bool, a)
f :: Bool -> a -> (Bool, a)
f Bool
b a
a =
case (Bool
b, a -> Maybe a
forall a. (Bounded a, Enum a) => a -> Maybe a
predSafe a
a) of
(Bool
True, Just a
a') -> (Bool
False, a
a')
(Bool
True, Maybe a
Nothing) -> (Bool
True, a
forall a. Bounded a => a
maxBound)
(Bool, Maybe a)
_o -> (Bool
b, a
a)
(Bool
lft, t a
ret) = (Bool -> a -> (Bool, a)) -> Bool -> t a -> (Bool, t a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumR Bool -> a -> (Bool, a)
f Bool
True t a
xs
in if Bool
lft
then String -> Either String (t a)
forall a b. a -> Either a b
Left String
"predTraversable: below minbound"
else t a -> Either String (t a)
forall a b. b -> Either a b
Right t a
ret
universeTraversable ::
forall f a.
(Traversable f, Enum a, Bounded a) =>
f a ->
Either String (NonEmpty (f a))
universeTraversable :: f a -> Either String (NonEmpty (f a))
universeTraversable f a
ta = do
(Integer
mn, Integer
mx) <- f a -> Either String (Integer, Integer)
forall a (t :: * -> *) z.
(Bounded a, Enum a, Foldable t) =>
t z -> Either String (Integer, Integer)
capacity @a f a
ta
(Integer -> Either String (f a))
-> NonEmpty Integer -> Either String (NonEmpty (f a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (f a -> Integer -> Either String (f a)
forall a (f :: * -> *) z.
(Traversable f, Enum a, Bounded a) =>
f z -> Integer -> Either String (f a)
toEnumTraversable f a
ta) (Integer
mn Integer -> [Integer] -> NonEmpty Integer
forall a. a -> [a] -> NonEmpty a
:| Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
1 [Integer
mn .. Integer
mx])