{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

{- |
Module      : Primus.Enum
Description : methods for safe enumeration and enumeration on containers
Copyright   : (c) Grant Weyburne, 2022
License     : BSD-3
-}
module Primus.Enum (
  -- * enumerations
  universe1,
  universe1R,
  enumFrom1,
  enumFrom1R,
  enumTo1,
  enumFromThen1,
  enumFromTo1,
  enumFromThenTo1,

  -- * converters
  predSafe,
  succSafe,
  integerToEnumSafe,
  integerToIntSafe,

  -- * container enums

  -- ** enumerations
  toEnumList,
  toEnumList1,
  universeTraversable,
  toEnumTraversable,
  -- calcNextEnum,
  -- minMax,
  -- zerolr

  -- ** converters
  succTraversable,
  predTraversable,
  fromEnumFoldable,
  fromEnumFoldable1,

  -- ** capacity
  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

-- | create a nonempty list of all the values for an 'Enum'
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

-- | create a nonempty list of all the values for an 'Enum' in reverse order
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

-- | create a nonempty list of values starting at "a"
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]

-- | create a nonempty list of values starting at "a"
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]

-- | create a nonempty list of values starting at "a" and skipping "b"
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
:| [] -- diverges from enumFromThen by returning one value instead of cycling
    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]

-- | 'enumFromThenTo' for nonempty lists
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
:| [] -- diverges from enumFromThenTo by returning one value instead of cycling
    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]

-- | create a nonempty list of values starting at "a" and skipping "b"
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
:| [] -- diverges from enumFromTo by returning one value instead of cycling
    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] -- diverges from enumFromTo by going backwards instead of returning nothing
    -- pred has to exist: a > b => pred a >= b unless float ...

-- | create a nonempty list of "a" in reverse order
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
:| []

-- | safe 'pred' for a bounded 'Enum'
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)

-- | safe 'succ' for a bounded 'Enum'
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)

-- | load a given container with "a"s using the relative position "i"
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

-- | calculates the minimum and maximum range of enumerations that can be stored in a container of the given size
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)

{- | convert toEnum of "a" into a list containing "a"s
   zero is the empty list: see 'toEnumList'
-}
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

-- | calculate the next enum
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

-- | return the min and max of a bounded enum
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

-- | concrete safe conversion of Integer to Int
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

-- | safe 'toEnum'
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 -- i <= maxBound  && maxBound :: Int so cant fail on fromInteger
 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
"]"

-- | convert toEnum of "a" into a nonempty list containing "a"s
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

-- | reverse of 'toEnumList' [can fail if xs is null and toEnum 0 is not defined]
fromEnumFoldable ::
  forall a t.
  (Foldable t, Enum a, Bounded a) =>
  t a ->
  Either String Integer
fromEnumFoldable :: t a -> Either String Integer
fromEnumFoldable 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)

-- | reverse of 'toEnumList1' [cant fail]
fromEnumFoldable1 ::
  forall a t.
  (Foldable1 t, Enum a, Bounded a) =>
  t a ->
  Integer
fromEnumFoldable1 :: t a -> Integer
fromEnumFoldable1 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

-- | 'succ' for a traversable container
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

-- | 'pred' for a traversable container
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

{- | generate all the possible enum combinations for the given container in ascending order

 useful for creating all the valid indices for matrices
-}
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])