{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >=704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Universe.Helpers (
universeDef,
interleave,
diagonal,
diagonals,
(+++),
cartesianProduct,
(+*+),
(<+*+>),
choices,
retagWith,
retag,
Tagged (..),
Natural,
unfairCartesianProduct,
unfairChoices
) where
import Data.List
import Data.Tagged (Tagged (..), retag)
import Numeric.Natural (Natural)
universeDef :: (Bounded a, Enum a) => [a]
universeDef :: forall a. (Bounded a, Enum a) => [a]
universeDef = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
interleave :: [[a]] -> [a]
interleave :: forall a. [[a]] -> [a]
interleave = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose
diagonal :: [[a]] -> [a]
diagonal :: forall a. [[a]] -> [a]
diagonal = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
diagonals
diagonals :: [[a]] -> [[a]]
diagonals :: forall a. [[a]] -> [[a]]
diagonals = forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [[a]] -> [[a]] -> [[a]]
go [] where
go :: [[a]] -> [[a]] -> [[a]]
go [[a]]
b [[a]]
es_ = [a
h | a
h:[a]
_ <- [[a]]
b] forall a. a -> [a] -> [a]
: case [[a]]
es_ of
[] -> forall a. [[a]] -> [[a]]
transpose [[a]]
ts
[a]
e:[[a]]
es -> [[a]] -> [[a]] -> [[a]]
go ([a]
eforall a. a -> [a] -> [a]
:[[a]]
ts) [[a]]
es
where ts :: [[a]]
ts = [[a]
t | a
_:[a]
t <- [[a]]
b]
(+++) :: [a] -> [a] -> [a]
[a]
xs +++ :: forall a. [a] -> [a] -> [a]
+++ [a]
ys = forall a. [[a]] -> [a]
interleave [[a]
xs,[a]
ys]
cartesianProduct :: (a -> b -> c) -> [a] -> [b] -> [c]
cartesianProduct :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
cartesianProduct a -> b -> c
_ [] [b]
_ = []
cartesianProduct a -> b -> c
f [a]
xs [b]
ys = forall a. [[a]] -> [a]
diagonal [[a -> b -> c
f a
x b
y | a
x <- [a]
xs] | b
y <- [b]
ys]
(+*+) :: [a] -> [b] -> [(a,b)]
+*+ :: forall a b. [a] -> [b] -> [(a, b)]
(+*+) = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
cartesianProduct (,)
(<+*+>) :: [a -> b] -> [a] -> [b]
<+*+> :: forall a b. [a -> b] -> [a] -> [b]
(<+*+>) = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
cartesianProduct forall a b. (a -> b) -> a -> b
($)
choices :: [[a]] -> [[a]]
choices :: forall a. [[a]] -> [[a]]
choices = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
cartesianProduct (:)) [[]]
retagWith :: (a -> b) -> Tagged a x -> Tagged b x
retagWith :: forall a b x. (a -> b) -> Tagged a x -> Tagged b x
retagWith a -> b
_ (Tagged x
n) = forall {k} (s :: k) b. b -> Tagged s b
Tagged x
n
unfairCartesianProduct :: (a -> b -> c) -> [a] -> [b] -> [c]
unfairCartesianProduct :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
unfairCartesianProduct a -> b -> c
_ [a]
_ [] = []
unfairCartesianProduct a -> b -> c
f [a]
xs [b]
ys = [a] -> [b] -> [c]
go [a]
xs [b]
ys where
go :: [a] -> [b] -> [c]
go (a
x:[a]
xs) [b]
ys = forall a b. (a -> b) -> [a] -> [b]
map (a -> b -> c
f a
x) [b]
ys forall a. [a] -> [a] -> [a]
+++ [a] -> [b] -> [c]
go [a]
xs [b]
ys
go [] [b]
ys = []
unfairChoices :: [[a]] -> [[a]]
unfairChoices :: forall a. [[a]] -> [[a]]
unfairChoices = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
unfairCartesianProduct (,)) [[]]