{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
module Foundation.Collection.Zippable
( BoxedZippable(..)
, Zippable(..)
) where
import qualified Basement.UArray as UV
import qualified Basement.BoxedArray as BA
import qualified Basement.String as S
import Foundation.Collection.Element
import Foundation.Collection.Sequential
import Basement.Compat.Base
import Basement.Types.AsciiString(AsciiString(..))
import qualified Prelude
import GHC.ST
class Sequential col => Zippable col where
zipWith :: (Sequential a, Sequential b)
=> (Element a -> Element b -> Element col)
-> a -> b -> col
zipWith Element a -> Element b -> Element col
f a
a b
b = (Element [Element a] -> Element [Element b] -> Element col)
-> ([Element a], [Element b]) -> col
forall c a b.
(Sequential c, Sequential a, Sequential b) =>
(Element a -> Element b -> Element c) -> (a, b) -> c
go Element a -> Element b -> Element col
Element [Element a] -> Element [Element b] -> Element col
f (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
a, b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
b)
where go :: (Element a -> Element b -> Element c) -> (a, b) -> c
go Element a -> Element b -> Element c
f' = c
-> (((Element a, Element b), (a, b)) -> c)
-> Maybe ((Element a, Element b), (a, b))
-> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c
forall a. Monoid a => a
mempty (\((Element a, Element b)
x, (a, b)
xs) -> (Element a -> Element b -> Element c)
-> (Element a, Element b) -> Element c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry2 Element a -> Element b -> Element c
f' (Element a, Element b)
x Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` (Element a -> Element b -> Element c) -> (a, b) -> c
go Element a -> Element b -> Element c
f' (a, b)
xs) (Maybe ((Element a, Element b), (a, b)) -> c)
-> ((a, b) -> Maybe ((Element a, Element b), (a, b)))
-> (a, b)
-> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, b) -> Maybe ((Element a, Element b), (a, b))
forall a b.
(Sequential a, Sequential b) =>
(a, b) -> Maybe ((Element a, Element b), (a, b))
uncons2
zipWith3 :: (Sequential a, Sequential b, Sequential c)
=> (Element a -> Element b -> Element c -> Element col)
-> a -> b -> c -> col
zipWith3 Element a -> Element b -> Element c -> Element col
f a
a b
b c
c = (Element [Element a]
-> Element [Element b] -> Element [Element c] -> Element col)
-> ([Element a], [Element b], [Element c]) -> col
forall c a b c.
(Sequential c, Sequential a, Sequential b, Sequential c) =>
(Element a -> Element b -> Element c -> Element c)
-> (a, b, c) -> c
go Element a -> Element b -> Element c -> Element col
Element [Element a]
-> Element [Element b] -> Element [Element c] -> Element col
f (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
a, b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
b, c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c)
where go :: (Element a -> Element b -> Element c -> Element c)
-> (a, b, c) -> c
go Element a -> Element b -> Element c -> Element c
f' = c
-> (((Element a, Element b, Element c), (a, b, c)) -> c)
-> Maybe ((Element a, Element b, Element c), (a, b, c))
-> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c
forall a. Monoid a => a
mempty (\((Element a, Element b, Element c)
x, (a, b, c)
xs) -> (Element a -> Element b -> Element c -> Element c)
-> (Element a, Element b, Element c) -> Element c
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Element a -> Element b -> Element c -> Element c
f' (Element a, Element b, Element c)
x Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` (Element a -> Element b -> Element c -> Element c)
-> (a, b, c) -> c
go Element a -> Element b -> Element c -> Element c
f' (a, b, c)
xs) (Maybe ((Element a, Element b, Element c), (a, b, c)) -> c)
-> ((a, b, c)
-> Maybe ((Element a, Element b, Element c), (a, b, c)))
-> (a, b, c)
-> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, b, c) -> Maybe ((Element a, Element b, Element c), (a, b, c))
forall a b c.
(Sequential a, Sequential b, Sequential c) =>
(a, b, c) -> Maybe ((Element a, Element b, Element c), (a, b, c))
uncons3
zipWith4 :: (Sequential a, Sequential b, Sequential c, Sequential d)
=> (Element a -> Element b -> Element c -> Element d -> Element col)
-> a -> b -> c -> d -> col
zipWith4 Element a -> Element b -> Element c -> Element d -> Element col
fn a
a b
b c
c d
d = (Element [Element a]
-> Element [Element b]
-> Element [Element c]
-> Element [Element d]
-> Element col)
-> ([Element a], [Element b], [Element c], [Element d]) -> col
forall c a b c d.
(Sequential c, Sequential a, Sequential b, Sequential c,
Sequential d) =>
(Element a -> Element b -> Element c -> Element d -> Element c)
-> (a, b, c, d) -> c
go Element a -> Element b -> Element c -> Element d -> Element col
Element [Element a]
-> Element [Element b]
-> Element [Element c]
-> Element [Element d]
-> Element col
fn (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
a, b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
b, c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c, d -> [Item d]
forall l. IsList l => l -> [Item l]
toList d
d)
where go :: (Element a -> Element b -> Element c -> Element d -> Element c)
-> (a, b, c, d) -> c
go Element a -> Element b -> Element c -> Element d -> Element c
f' = c
-> (((Element a, Element b, Element c, Element d), (a, b, c, d))
-> c)
-> Maybe
((Element a, Element b, Element c, Element d), (a, b, c, d))
-> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c
forall a. Monoid a => a
mempty (\((Element a, Element b, Element c, Element d)
x, (a, b, c, d)
xs) -> (Element a -> Element b -> Element c -> Element d -> Element c)
-> (Element a, Element b, Element c, Element d) -> Element c
forall a b c d g. (a -> b -> c -> d -> g) -> (a, b, c, d) -> g
uncurry4 Element a -> Element b -> Element c -> Element d -> Element c
f' (Element a, Element b, Element c, Element d)
x Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` (Element a -> Element b -> Element c -> Element d -> Element c)
-> (a, b, c, d) -> c
go Element a -> Element b -> Element c -> Element d -> Element c
f' (a, b, c, d)
xs) (Maybe ((Element a, Element b, Element c, Element d), (a, b, c, d))
-> c)
-> ((a, b, c, d)
-> Maybe
((Element a, Element b, Element c, Element d), (a, b, c, d)))
-> (a, b, c, d)
-> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, b, c, d)
-> Maybe
((Element a, Element b, Element c, Element d), (a, b, c, d))
forall a b c d.
(Sequential a, Sequential b, Sequential c, Sequential d) =>
(a, b, c, d)
-> Maybe
((Element a, Element b, Element c, Element d), (a, b, c, d))
uncons4
zipWith5 :: (Sequential a, Sequential b, Sequential c, Sequential d, Sequential e)
=> (Element a -> Element b -> Element c -> Element d -> Element e -> Element col)
-> a -> b -> c -> d -> e -> col
zipWith5 Element a
-> Element b -> Element c -> Element d -> Element e -> Element col
fn a
a b
b c
c d
d e
e = (Element [Element a]
-> Element [Element b]
-> Element [Element c]
-> Element [Element d]
-> Element [Element e]
-> Element col)
-> ([Element a], [Element b], [Element c], [Element d],
[Element e])
-> col
forall c a b c d e.
(Sequential c, Sequential a, Sequential b, Sequential c,
Sequential d, Sequential e) =>
(Element a
-> Element b -> Element c -> Element d -> Element e -> Element c)
-> (a, b, c, d, e) -> c
go Element a
-> Element b -> Element c -> Element d -> Element e -> Element col
Element [Element a]
-> Element [Element b]
-> Element [Element c]
-> Element [Element d]
-> Element [Element e]
-> Element col
fn (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
a, b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
b, c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c, d -> [Item d]
forall l. IsList l => l -> [Item l]
toList d
d, e -> [Item e]
forall l. IsList l => l -> [Item l]
toList e
e)
where go :: (Element a
-> Element b -> Element c -> Element d -> Element e -> Element c)
-> (a, b, c, d, e) -> c
go Element a
-> Element b -> Element c -> Element d -> Element e -> Element c
f' = c
-> (((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e))
-> c)
-> Maybe
((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e))
-> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c
forall a. Monoid a => a
mempty (\((Element a, Element b, Element c, Element d, Element e)
x, (a, b, c, d, e)
xs) -> (Element a
-> Element b -> Element c -> Element d -> Element e -> Element c)
-> (Element a, Element b, Element c, Element d, Element e)
-> Element c
forall a b c d e f.
(a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5 Element a
-> Element b -> Element c -> Element d -> Element e -> Element c
f' (Element a, Element b, Element c, Element d, Element e)
x Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` (Element a
-> Element b -> Element c -> Element d -> Element e -> Element c)
-> (a, b, c, d, e) -> c
go Element a
-> Element b -> Element c -> Element d -> Element e -> Element c
f' (a, b, c, d, e)
xs) (Maybe
((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e))
-> c)
-> ((a, b, c, d, e)
-> Maybe
((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e)))
-> (a, b, c, d, e)
-> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, b, c, d, e)
-> Maybe
((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e))
forall a b c d e.
(Sequential a, Sequential b, Sequential c, Sequential d,
Sequential e) =>
(a, b, c, d, e)
-> Maybe
((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e))
uncons5
zipWith6 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e
, Sequential f)
=> (Element a -> Element b -> Element c -> Element d -> Element e -> Element f -> Element col)
-> a -> b -> c -> d -> e -> f -> col
zipWith6 Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element col
fn a
a b
b c
c d
d e
e f
f = (Element [Element a]
-> Element [Element b]
-> Element [Element c]
-> Element [Element d]
-> Element [Element e]
-> Element [Element f]
-> Element col)
-> ([Element a], [Element b], [Element c], [Element d],
[Element e], [Element f])
-> col
forall c a b c d e f.
(Sequential c, Sequential a, Sequential b, Sequential c,
Sequential d, Sequential e, Sequential f) =>
(Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element c)
-> (a, b, c, d, e, f) -> c
go Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element col
Element [Element a]
-> Element [Element b]
-> Element [Element c]
-> Element [Element d]
-> Element [Element e]
-> Element [Element f]
-> Element col
fn (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
a, b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
b, c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c, d -> [Item d]
forall l. IsList l => l -> [Item l]
toList d
d, e -> [Item e]
forall l. IsList l => l -> [Item l]
toList e
e, f -> [Item f]
forall l. IsList l => l -> [Item l]
toList f
f)
where go :: (Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element c)
-> (a, b, c, d, e, f) -> c
go Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element c
f' = c
-> (((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f))
-> c)
-> Maybe
((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f))
-> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c
forall a. Monoid a => a
mempty (\((Element a, Element b, Element c, Element d, Element e, Element f)
x, (a, b, c, d, e, f)
xs) -> (Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element c)
-> (Element a, Element b, Element c, Element d, Element e,
Element f)
-> Element c
forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
uncurry6 Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element c
f' (Element a, Element b, Element c, Element d, Element e, Element f)
x Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` (Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element c)
-> (a, b, c, d, e, f) -> c
go Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element c
f' (a, b, c, d, e, f)
xs) (Maybe
((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f))
-> c)
-> ((a, b, c, d, e, f)
-> Maybe
((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f)))
-> (a, b, c, d, e, f)
-> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, b, c, d, e, f)
-> Maybe
((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f))
forall a b c d e f.
(Sequential a, Sequential b, Sequential c, Sequential d,
Sequential e, Sequential f) =>
(a, b, c, d, e, f)
-> Maybe
((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f))
uncons6
zipWith7 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e
, Sequential f, Sequential g )
=> (Element a -> Element b -> Element c -> Element d -> Element e -> Element f -> Element g -> Element col)
-> a -> b -> c -> d -> e -> f -> g -> col
zipWith7 Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element col
fn a
a b
b c
c d
d e
e f
f g
g = (Element [Element a]
-> Element [Element b]
-> Element [Element c]
-> Element [Element d]
-> Element [Element e]
-> Element [Element f]
-> Element [Element g]
-> Element col)
-> ([Element a], [Element b], [Element c], [Element d],
[Element e], [Element f], [Element g])
-> col
forall c a b c d e f g.
(Sequential c, Sequential a, Sequential b, Sequential c,
Sequential d, Sequential e, Sequential f, Sequential g) =>
(Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element c)
-> (a, b, c, d, e, f, g) -> c
go Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element col
Element [Element a]
-> Element [Element b]
-> Element [Element c]
-> Element [Element d]
-> Element [Element e]
-> Element [Element f]
-> Element [Element g]
-> Element col
fn (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
a, b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
b, c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c, d -> [Item d]
forall l. IsList l => l -> [Item l]
toList d
d, e -> [Item e]
forall l. IsList l => l -> [Item l]
toList e
e, f -> [Item f]
forall l. IsList l => l -> [Item l]
toList f
f, g -> [Item g]
forall l. IsList l => l -> [Item l]
toList g
g)
where go :: (Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element c)
-> (a, b, c, d, e, f, g) -> c
go Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element c
f' = c
-> (((Element a, Element b, Element c, Element d, Element e,
Element f, Element g),
(a, b, c, d, e, f, g))
-> c)
-> Maybe
((Element a, Element b, Element c, Element d, Element e, Element f,
Element g),
(a, b, c, d, e, f, g))
-> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c
forall a. Monoid a => a
mempty (\((Element a, Element b, Element c, Element d, Element e, Element f,
Element g)
x, (a, b, c, d, e, f, g)
xs) -> (Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element c)
-> (Element a, Element b, Element c, Element d, Element e,
Element f, Element g)
-> Element c
forall a b c d e f g h.
(a -> b -> c -> d -> e -> f -> g -> h)
-> (a, b, c, d, e, f, g) -> h
uncurry7 Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element c
f' (Element a, Element b, Element c, Element d, Element e, Element f,
Element g)
x Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` (Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element c)
-> (a, b, c, d, e, f, g) -> c
go Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element c
f' (a, b, c, d, e, f, g)
xs) (Maybe
((Element a, Element b, Element c, Element d, Element e, Element f,
Element g),
(a, b, c, d, e, f, g))
-> c)
-> ((a, b, c, d, e, f, g)
-> Maybe
((Element a, Element b, Element c, Element d, Element e, Element f,
Element g),
(a, b, c, d, e, f, g)))
-> (a, b, c, d, e, f, g)
-> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, b, c, d, e, f, g)
-> Maybe
((Element a, Element b, Element c, Element d, Element e, Element f,
Element g),
(a, b, c, d, e, f, g))
forall a b c d e f g.
(Sequential a, Sequential b, Sequential c, Sequential d,
Sequential e, Sequential f, Sequential g) =>
(a, b, c, d, e, f, g)
-> Maybe
((Element a, Element b, Element c, Element d, Element e, Element f,
Element g),
(a, b, c, d, e, f, g))
uncons7
instance Zippable [c]
instance UV.PrimType ty => Zippable (UV.UArray ty) where
zipWith :: (Element a -> Element b -> Element (UArray ty))
-> a -> b -> UArray ty
zipWith Element a -> Element b -> Element (UArray ty)
f a
as b
bs = (forall s. ST s (UArray ty)) -> UArray ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UArray ty)) -> UArray ty)
-> (forall s. ST s (UArray ty)) -> UArray ty
forall a b. (a -> b) -> a -> b
$ Int
-> Builder (UArray ty) (MUArray ty) ty (ST s) () ()
-> ST s (UArray ty)
forall ty (m :: * -> *).
(PrimType ty, PrimMonad m) =>
Int -> Builder (UArray ty) (MUArray ty) ty m () () -> m (UArray ty)
UV.builderBuild_ Int
64 (Builder (UArray ty) (MUArray ty) ty (ST s) () ()
-> ST s (UArray ty))
-> Builder (UArray ty) (MUArray ty) ty (ST s) () ()
-> ST s (UArray ty)
forall a b. (a -> b) -> a -> b
$ (Element a -> Element b -> ty)
-> [Element a]
-> [Element b]
-> Builder (UArray ty) (MUArray ty) ty (ST s) () ()
forall (state :: * -> *) ty t t err.
(PrimType ty, PrimMonad state) =>
(t -> t -> ty)
-> [t] -> [t] -> Builder (UArray ty) (MUArray ty) ty state err ()
go Element a -> Element b -> ty
Element a -> Element b -> Element (UArray ty)
f (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
as) (b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
bs)
where
go :: (t -> t -> ty)
-> [t] -> [t] -> Builder (UArray ty) (MUArray ty) ty state err ()
go t -> t -> ty
_ [] [t]
_ = () -> Builder (UArray ty) (MUArray ty) ty state err ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go t -> t -> ty
_ [t]
_ [] = () -> Builder (UArray ty) (MUArray ty) ty state err ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go t -> t -> ty
f' (t
a':[t]
as') (t
b':[t]
bs') = ty -> Builder (UArray ty) (MUArray ty) ty state err ()
forall ty (state :: * -> *) err.
(PrimType ty, PrimMonad state) =>
ty -> Builder (UArray ty) (MUArray ty) ty state err ()
UV.builderAppend (t -> t -> ty
f' t
a' t
b') Builder (UArray ty) (MUArray ty) ty state err ()
-> Builder (UArray ty) (MUArray ty) ty state err ()
-> Builder (UArray ty) (MUArray ty) ty state err ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (t -> t -> ty)
-> [t] -> [t] -> Builder (UArray ty) (MUArray ty) ty state err ()
go t -> t -> ty
f' [t]
as' [t]
bs'
instance Zippable (BA.Array ty) where
zipWith :: (Element a -> Element b -> Element (Array ty))
-> a -> b -> Array ty
zipWith Element a -> Element b -> Element (Array ty)
f a
as b
bs = (forall s. ST s (Array ty)) -> Array ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array ty)) -> Array ty)
-> (forall s. ST s (Array ty)) -> Array ty
forall a b. (a -> b) -> a -> b
$ Int
-> Builder (Array ty) (MArray ty) ty (ST s) () ()
-> ST s (Array ty)
forall (m :: * -> *) ty.
PrimMonad m =>
Int -> Builder (Array ty) (MArray ty) ty m () () -> m (Array ty)
BA.builderBuild_ Int
64 (Builder (Array ty) (MArray ty) ty (ST s) () () -> ST s (Array ty))
-> Builder (Array ty) (MArray ty) ty (ST s) () ()
-> ST s (Array ty)
forall a b. (a -> b) -> a -> b
$ (Element a -> Element b -> ty)
-> [Element a]
-> [Element b]
-> Builder (Array ty) (MArray ty) ty (ST s) () ()
forall (state :: * -> *) t t ty err.
PrimMonad state =>
(t -> t -> ty)
-> [t] -> [t] -> Builder (Array ty) (MArray ty) ty state err ()
go Element a -> Element b -> ty
Element a -> Element b -> Element (Array ty)
f (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
as) (b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
bs)
where
go :: (t -> t -> ty)
-> [t] -> [t] -> Builder (Array ty) (MArray ty) ty state err ()
go t -> t -> ty
_ [] [t]
_ = () -> Builder (Array ty) (MArray ty) ty state err ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go t -> t -> ty
_ [t]
_ [] = () -> Builder (Array ty) (MArray ty) ty state err ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go t -> t -> ty
f' (t
a':[t]
as') (t
b':[t]
bs') = ty -> Builder (Array ty) (MArray ty) ty state err ()
forall (state :: * -> *) ty err.
PrimMonad state =>
ty -> Builder (Array ty) (MArray ty) ty state err ()
BA.builderAppend (t -> t -> ty
f' t
a' t
b') Builder (Array ty) (MArray ty) ty state err ()
-> Builder (Array ty) (MArray ty) ty state err ()
-> Builder (Array ty) (MArray ty) ty state err ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (t -> t -> ty)
-> [t] -> [t] -> Builder (Array ty) (MArray ty) ty state err ()
go t -> t -> ty
f' [t]
as' [t]
bs'
instance Zippable S.String where
zipWith :: (Element a -> Element b -> Element String) -> a -> b -> String
zipWith Element a -> Element b -> Element String
f a
as b
bs = (forall s. ST s String) -> String
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s String) -> String)
-> (forall s. ST s String) -> String
forall a b. (a -> b) -> a -> b
$ Int
-> Builder String MutableString Word8 (ST s) () () -> ST s String
forall (m :: * -> *).
PrimMonad m =>
Int -> Builder String MutableString Word8 m () () -> m String
S.builderBuild_ Int
64 (Builder String MutableString Word8 (ST s) () () -> ST s String)
-> Builder String MutableString Word8 (ST s) () () -> ST s String
forall a b. (a -> b) -> a -> b
$ (Element a -> Element b -> Char)
-> [Element a]
-> [Element b]
-> Builder String MutableString Word8 (ST s) () ()
forall (state :: * -> *) t t err.
PrimMonad state =>
(t -> t -> Char)
-> [t] -> [t] -> Builder String MutableString Word8 state err ()
go Element a -> Element b -> Char
Element a -> Element b -> Element String
f (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
as) (b -> [Item b]
forall l. IsList l => l -> [Item l]
toList b
bs)
where
go :: (t -> t -> Char)
-> [t] -> [t] -> Builder String MutableString Word8 state err ()
go t -> t -> Char
_ [] [t]
_ = () -> Builder String MutableString Word8 state err ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go t -> t -> Char
_ [t]
_ [] = () -> Builder String MutableString Word8 state err ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go t -> t -> Char
f' (t
a':[t]
as') (t
b':[t]
bs') = Char -> Builder String MutableString Word8 state err ()
forall (state :: * -> *) err.
PrimMonad state =>
Char -> Builder String MutableString Word8 state err ()
S.builderAppend (t -> t -> Char
f' t
a' t
b') Builder String MutableString Word8 state err ()
-> Builder String MutableString Word8 state err ()
-> Builder String MutableString Word8 state err ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (t -> t -> Char)
-> [t] -> [t] -> Builder String MutableString Word8 state err ()
go t -> t -> Char
f' [t]
as' [t]
bs'
deriving instance Zippable AsciiString
class Zippable col => BoxedZippable col where
zip :: ( Sequential a, Sequential b
, Element col ~ (Element a, Element b) )
=> a -> b -> col
zip = (Element a -> Element b -> Element col) -> a -> b -> col
forall col a b.
(Zippable col, Sequential a, Sequential b) =>
(Element a -> Element b -> Element col) -> a -> b -> col
zipWith (,)
zip3 :: ( Sequential a, Sequential b, Sequential c
, Element col ~ (Element a, Element b, Element c) )
=> a -> b -> c -> col
zip3 = (Element a -> Element b -> Element c -> Element col)
-> a -> b -> c -> col
forall col a b c.
(Zippable col, Sequential a, Sequential b, Sequential c) =>
(Element a -> Element b -> Element c -> Element col)
-> a -> b -> c -> col
zipWith3 (,,)
zip4 :: ( Sequential a, Sequential b, Sequential c, Sequential d
, Element col ~ (Element a, Element b, Element c, Element d) )
=> a -> b -> c -> d -> col
zip4 = (Element a -> Element b -> Element c -> Element d -> Element col)
-> a -> b -> c -> d -> col
forall col a b c d.
(Zippable col, Sequential a, Sequential b, Sequential c,
Sequential d) =>
(Element a -> Element b -> Element c -> Element d -> Element col)
-> a -> b -> c -> d -> col
zipWith4 (,,,)
zip5 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e
, Element col ~ (Element a, Element b, Element c, Element d, Element e) )
=> a -> b -> c -> d -> e -> col
zip5 = (Element a
-> Element b -> Element c -> Element d -> Element e -> Element col)
-> a -> b -> c -> d -> e -> col
forall col a b c d e.
(Zippable col, Sequential a, Sequential b, Sequential c,
Sequential d, Sequential e) =>
(Element a
-> Element b -> Element c -> Element d -> Element e -> Element col)
-> a -> b -> c -> d -> e -> col
zipWith5 (,,,,)
zip6 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e, Sequential f
, Element col ~ (Element a, Element b, Element c, Element d, Element e, Element f) )
=> a -> b -> c -> d -> e -> f -> col
zip6 = (Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element col)
-> a -> b -> c -> d -> e -> f -> col
forall col a b c d e f.
(Zippable col, Sequential a, Sequential b, Sequential c,
Sequential d, Sequential e, Sequential f) =>
(Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element col)
-> a -> b -> c -> d -> e -> f -> col
zipWith6 (,,,,,)
zip7 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e, Sequential f, Sequential g
, Element col ~ (Element a, Element b, Element c, Element d, Element e, Element f, Element g) )
=> a -> b -> c -> d -> e -> f -> g -> col
zip7 = (Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element col)
-> a -> b -> c -> d -> e -> f -> g -> col
forall col a b c d e f g.
(Zippable col, Sequential a, Sequential b, Sequential c,
Sequential d, Sequential e, Sequential f, Sequential g) =>
(Element a
-> Element b
-> Element c
-> Element d
-> Element e
-> Element f
-> Element g
-> Element col)
-> a -> b -> c -> d -> e -> f -> g -> col
zipWith7 (,,,,,,)
unzip :: (Sequential a, Sequential b, Element col ~ (Element a, Element b))
=> col -> (a, b)
unzip = [(Element a, Element b)] -> (a, b)
forall a b.
(Sequential a, Sequential b) =>
[(Element a, Element b)] -> (a, b)
go ([(Element a, Element b)] -> (a, b))
-> (col -> [(Element a, Element b)]) -> col -> (a, b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. col -> [(Element a, Element b)]
forall l. IsList l => l -> [Item l]
toList
where go :: [(Element a, Element b)] -> (a, b)
go [] = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty)
go ((Element a
a, Element b
b):[(Element a, Element b)]
xs) =
let (a
as, b
bs) = [(Element a, Element b)] -> (a, b)
go [(Element a, Element b)]
xs
in (Element a
a Element a -> a -> a
forall c. Sequential c => Element c -> c -> c
`cons` a
as, Element b
b Element b -> b -> b
forall c. Sequential c => Element c -> c -> c
`cons` b
bs)
unzip3 :: ( Sequential a, Sequential b, Sequential c
, Element col ~ (Element a, Element b, Element c) )
=> col -> (a, b, c)
unzip3 = [(Element a, Element b, Element c)] -> (a, b, c)
forall a b c.
(Sequential a, Sequential b, Sequential c) =>
[(Element a, Element b, Element c)] -> (a, b, c)
go ([(Element a, Element b, Element c)] -> (a, b, c))
-> (col -> [(Element a, Element b, Element c)]) -> col -> (a, b, c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. col -> [(Element a, Element b, Element c)]
forall l. IsList l => l -> [Item l]
toList
where go :: [(Element a, Element b, Element c)] -> (a, b, c)
go [] = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty)
go ((Element a
a, Element b
b, Element c
c):[(Element a, Element b, Element c)]
xs) =
let (a
as, b
bs, c
cs) = [(Element a, Element b, Element c)] -> (a, b, c)
go [(Element a, Element b, Element c)]
xs
in (Element a
a Element a -> a -> a
forall c. Sequential c => Element c -> c -> c
`cons` a
as, Element b
b Element b -> b -> b
forall c. Sequential c => Element c -> c -> c
`cons` b
bs, Element c
c Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` c
cs)
unzip4 :: ( Sequential a, Sequential b, Sequential c, Sequential d
, Element col ~ (Element a, Element b, Element c, Element d) )
=> col -> (a, b, c, d)
unzip4 = [(Element a, Element b, Element c, Element d)] -> (a, b, c, d)
forall a b c d.
(Sequential a, Sequential b, Sequential c, Sequential d) =>
[(Element a, Element b, Element c, Element d)] -> (a, b, c, d)
go ([(Element a, Element b, Element c, Element d)] -> (a, b, c, d))
-> (col -> [(Element a, Element b, Element c, Element d)])
-> col
-> (a, b, c, d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. col -> [(Element a, Element b, Element c, Element d)]
forall l. IsList l => l -> [Item l]
toList
where go :: [(Element a, Element b, Element c, Element d)] -> (a, b, c, d)
go [] = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty, d
forall a. Monoid a => a
mempty)
go ((Element a
a, Element b
b, Element c
c, Element d
d):[(Element a, Element b, Element c, Element d)]
xs) =
let (a
as, b
bs, c
cs, d
ds) = [(Element a, Element b, Element c, Element d)] -> (a, b, c, d)
go [(Element a, Element b, Element c, Element d)]
xs
in (Element a
a Element a -> a -> a
forall c. Sequential c => Element c -> c -> c
`cons` a
as, Element b
b Element b -> b -> b
forall c. Sequential c => Element c -> c -> c
`cons` b
bs, Element c
c Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` c
cs, Element d
d Element d -> d -> d
forall c. Sequential c => Element c -> c -> c
`cons` d
ds)
unzip5 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e
, Element col ~ (Element a, Element b, Element c, Element d, Element e) )
=> col -> (a, b, c, d, e)
unzip5 = [(Element a, Element b, Element c, Element d, Element e)]
-> (a, b, c, d, e)
forall a b c d e.
(Sequential a, Sequential b, Sequential c, Sequential d,
Sequential e) =>
[(Element a, Element b, Element c, Element d, Element e)]
-> (a, b, c, d, e)
go ([(Element a, Element b, Element c, Element d, Element e)]
-> (a, b, c, d, e))
-> (col
-> [(Element a, Element b, Element c, Element d, Element e)])
-> col
-> (a, b, c, d, e)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. col -> [(Element a, Element b, Element c, Element d, Element e)]
forall l. IsList l => l -> [Item l]
toList
where go :: [(Element a, Element b, Element c, Element d, Element e)]
-> (a, b, c, d, e)
go [] = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty, d
forall a. Monoid a => a
mempty, e
forall a. Monoid a => a
mempty)
go ((Element a
a, Element b
b, Element c
c, Element d
d, Element e
e):[(Element a, Element b, Element c, Element d, Element e)]
xs) =
let (a
as, b
bs, c
cs, d
ds, e
es) = [(Element a, Element b, Element c, Element d, Element e)]
-> (a, b, c, d, e)
go [(Element a, Element b, Element c, Element d, Element e)]
xs
in (Element a
a Element a -> a -> a
forall c. Sequential c => Element c -> c -> c
`cons` a
as, Element b
b Element b -> b -> b
forall c. Sequential c => Element c -> c -> c
`cons` b
bs, Element c
c Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` c
cs, Element d
d Element d -> d -> d
forall c. Sequential c => Element c -> c -> c
`cons` d
ds, Element e
e Element e -> e -> e
forall c. Sequential c => Element c -> c -> c
`cons` e
es)
unzip6 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e, Sequential f
, Element col ~ (Element a, Element b, Element c, Element d, Element e, Element f) )
=> col -> (a, b, c, d, e, f)
unzip6 = [(Element a, Element b, Element c, Element d, Element e,
Element f)]
-> (a, b, c, d, e, f)
forall a b c d e f.
(Sequential a, Sequential b, Sequential c, Sequential d,
Sequential e, Sequential f) =>
[(Element a, Element b, Element c, Element d, Element e,
Element f)]
-> (a, b, c, d, e, f)
go ([(Element a, Element b, Element c, Element d, Element e,
Element f)]
-> (a, b, c, d, e, f))
-> (col
-> [(Element a, Element b, Element c, Element d, Element e,
Element f)])
-> col
-> (a, b, c, d, e, f)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. col
-> [(Element a, Element b, Element c, Element d, Element e,
Element f)]
forall l. IsList l => l -> [Item l]
toList
where go :: [(Element a, Element b, Element c, Element d, Element e,
Element f)]
-> (a, b, c, d, e, f)
go [] = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty, d
forall a. Monoid a => a
mempty, e
forall a. Monoid a => a
mempty, f
forall a. Monoid a => a
mempty)
go ((Element a
a, Element b
b, Element c
c, Element d
d, Element e
e, Element f
f):[(Element a, Element b, Element c, Element d, Element e,
Element f)]
xs) =
let (a
as, b
bs, c
cs, d
ds, e
es, f
fs) = [(Element a, Element b, Element c, Element d, Element e,
Element f)]
-> (a, b, c, d, e, f)
go [(Element a, Element b, Element c, Element d, Element e,
Element f)]
xs
in (Element a
a Element a -> a -> a
forall c. Sequential c => Element c -> c -> c
`cons` a
as, Element b
b Element b -> b -> b
forall c. Sequential c => Element c -> c -> c
`cons` b
bs, Element c
c Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` c
cs, Element d
d Element d -> d -> d
forall c. Sequential c => Element c -> c -> c
`cons` d
ds, Element e
e Element e -> e -> e
forall c. Sequential c => Element c -> c -> c
`cons` e
es, Element f
f Element f -> f -> f
forall c. Sequential c => Element c -> c -> c
`cons` f
fs)
unzip7 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e, Sequential f, Sequential g
, Element col ~ (Element a, Element b, Element c, Element d, Element e, Element f, Element g) )
=> col -> (a, b, c, d, e, f, g)
unzip7 = [(Element a, Element b, Element c, Element d, Element e, Element f,
Element g)]
-> (a, b, c, d, e, f, g)
forall a b c d e f g.
(Sequential a, Sequential b, Sequential c, Sequential d,
Sequential e, Sequential f, Sequential g) =>
[(Element a, Element b, Element c, Element d, Element e, Element f,
Element g)]
-> (a, b, c, d, e, f, g)
go ([(Element a, Element b, Element c, Element d, Element e,
Element f, Element g)]
-> (a, b, c, d, e, f, g))
-> (col
-> [(Element a, Element b, Element c, Element d, Element e,
Element f, Element g)])
-> col
-> (a, b, c, d, e, f, g)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. col
-> [(Element a, Element b, Element c, Element d, Element e,
Element f, Element g)]
forall l. IsList l => l -> [Item l]
toList
where go :: [(Element a, Element b, Element c, Element d, Element e, Element f,
Element g)]
-> (a, b, c, d, e, f, g)
go [] = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty, d
forall a. Monoid a => a
mempty, e
forall a. Monoid a => a
mempty, f
forall a. Monoid a => a
mempty, g
forall a. Monoid a => a
mempty)
go ((Element a
a, Element b
b, Element c
c, Element d
d, Element e
e, Element f
f, Element g
g):[(Element a, Element b, Element c, Element d, Element e, Element f,
Element g)]
xs) =
let (a
as, b
bs, c
cs, d
ds, e
es, f
fs, g
gs) = [(Element a, Element b, Element c, Element d, Element e, Element f,
Element g)]
-> (a, b, c, d, e, f, g)
go [(Element a, Element b, Element c, Element d, Element e, Element f,
Element g)]
xs
in (Element a
a Element a -> a -> a
forall c. Sequential c => Element c -> c -> c
`cons` a
as, Element b
b Element b -> b -> b
forall c. Sequential c => Element c -> c -> c
`cons` b
bs, Element c
c Element c -> c -> c
forall c. Sequential c => Element c -> c -> c
`cons` c
cs, Element d
d Element d -> d -> d
forall c. Sequential c => Element c -> c -> c
`cons` d
ds, Element e
e Element e -> e -> e
forall c. Sequential c => Element c -> c -> c
`cons` e
es, Element f
f Element f -> f -> f
forall c. Sequential c => Element c -> c -> c
`cons` f
fs, Element g
g Element g -> g -> g
forall c. Sequential c => Element c -> c -> c
`cons` g
gs)
instance BoxedZippable [a]
instance BoxedZippable (BA.Array ty)
uncons2 :: (Sequential a, Sequential b) => (a, b) -> Maybe ((Element a, Element b), (a, b))
uncons2 :: (a, b) -> Maybe ((Element a, Element b), (a, b))
uncons2 (a, b)
xs = let (a
as, b
bs) = (a, b)
xs
in do (Element a
a', a
as') <- a -> Maybe (Element a, a)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons a
as
(Element b
b', b
bs') <- b -> Maybe (Element b, b)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons b
bs
((Element a, Element b), (a, b))
-> Maybe ((Element a, Element b), (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Element a
a', Element b
b'), (a
as', b
bs'))
uncons3 :: (Sequential a, Sequential b, Sequential c)
=> (a, b, c)
-> Maybe ((Element a, Element b, Element c), (a, b, c))
uncons3 :: (a, b, c) -> Maybe ((Element a, Element b, Element c), (a, b, c))
uncons3 (a, b, c)
xs = let (a
as, b
bs, c
cs) = (a, b, c)
xs
in do (Element a
a', a
as') <- a -> Maybe (Element a, a)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons a
as
(Element b
b', b
bs') <- b -> Maybe (Element b, b)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons b
bs
(Element c
c', c
cs') <- c -> Maybe (Element c, c)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons c
cs
((Element a, Element b, Element c), (a, b, c))
-> Maybe ((Element a, Element b, Element c), (a, b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Element a
a', Element b
b', Element c
c'), (a
as', b
bs', c
cs'))
uncons4 :: (Sequential a, Sequential b, Sequential c, Sequential d)
=> (a, b, c, d)
-> Maybe ( (Element a, Element b, Element c, Element d)
, (a, b, c, d) )
uncons4 :: (a, b, c, d)
-> Maybe
((Element a, Element b, Element c, Element d), (a, b, c, d))
uncons4 (a, b, c, d)
xs = let (a
as, b
bs, c
cs, d
ds) = (a, b, c, d)
xs
in do (Element a
a', a
as') <- a -> Maybe (Element a, a)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons a
as
(Element b
b', b
bs') <- b -> Maybe (Element b, b)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons b
bs
(Element c
c', c
cs') <- c -> Maybe (Element c, c)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons c
cs
(Element d
d', d
ds') <- d -> Maybe (Element d, d)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons d
ds
((Element a, Element b, Element c, Element d), (a, b, c, d))
-> Maybe
((Element a, Element b, Element c, Element d), (a, b, c, d))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Element a
a', Element b
b', Element c
c', Element d
d'), (a
as', b
bs', c
cs', d
ds'))
uncons5 :: (Sequential a, Sequential b, Sequential c, Sequential d, Sequential e)
=> (a, b, c, d, e)
-> Maybe ( (Element a, Element b, Element c, Element d, Element e)
, (a, b, c, d, e) )
uncons5 :: (a, b, c, d, e)
-> Maybe
((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e))
uncons5 (a, b, c, d, e)
xs = let (a
as, b
bs, c
cs, d
ds, e
es) = (a, b, c, d, e)
xs
in do (Element a
a', a
as') <- a -> Maybe (Element a, a)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons a
as
(Element b
b', b
bs') <- b -> Maybe (Element b, b)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons b
bs
(Element c
c', c
cs') <- c -> Maybe (Element c, c)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons c
cs
(Element d
d', d
ds') <- d -> Maybe (Element d, d)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons d
ds
(Element e
e', e
es') <- e -> Maybe (Element e, e)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons e
es
((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e))
-> Maybe
((Element a, Element b, Element c, Element d, Element e),
(a, b, c, d, e))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Element a
a', Element b
b', Element c
c', Element d
d', Element e
e'), (a
as', b
bs', c
cs', d
ds', e
es'))
uncons6 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e
, Sequential f )
=> (a, b, c, d, e, f)
-> Maybe ( (Element a, Element b, Element c, Element d, Element e, Element f)
, (a, b, c, d, e, f) )
uncons6 :: (a, b, c, d, e, f)
-> Maybe
((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f))
uncons6 (a, b, c, d, e, f)
xs = let (a
as, b
bs, c
cs, d
ds, e
es, f
fs) = (a, b, c, d, e, f)
xs
in do (Element a
a', a
as') <- a -> Maybe (Element a, a)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons a
as
(Element b
b', b
bs') <- b -> Maybe (Element b, b)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons b
bs
(Element c
c', c
cs') <- c -> Maybe (Element c, c)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons c
cs
(Element d
d', d
ds') <- d -> Maybe (Element d, d)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons d
ds
(Element e
e', e
es') <- e -> Maybe (Element e, e)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons e
es
(Element f
f', f
fs') <- f -> Maybe (Element f, f)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons f
fs
((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f))
-> Maybe
((Element a, Element b, Element c, Element d, Element e,
Element f),
(a, b, c, d, e, f))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Element a
a', Element b
b', Element c
c', Element d
d', Element e
e', Element f
f'), (a
as', b
bs', c
cs', d
ds', e
es', f
fs'))
uncons7 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e
, Sequential f, Sequential g )
=> (a, b, c, d, e, f, g)
-> Maybe ( (Element a, Element b, Element c, Element d, Element e, Element f
, Element g)
, (a, b, c, d, e, f, g) )
uncons7 :: (a, b, c, d, e, f, g)
-> Maybe
((Element a, Element b, Element c, Element d, Element e, Element f,
Element g),
(a, b, c, d, e, f, g))
uncons7 (a, b, c, d, e, f, g)
xs = let (a
as, b
bs, c
cs, d
ds, e
es, f
fs, g
gs) = (a, b, c, d, e, f, g)
xs
in do (Element a
a', a
as') <- a -> Maybe (Element a, a)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons a
as
(Element b
b', b
bs') <- b -> Maybe (Element b, b)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons b
bs
(Element c
c', c
cs') <- c -> Maybe (Element c, c)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons c
cs
(Element d
d', d
ds') <- d -> Maybe (Element d, d)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons d
ds
(Element e
e', e
es') <- e -> Maybe (Element e, e)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons e
es
(Element f
f', f
fs') <- f -> Maybe (Element f, f)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons f
fs
(Element g
g', g
gs') <- g -> Maybe (Element g, g)
forall c. Sequential c => c -> Maybe (Element c, c)
uncons g
gs
((Element a, Element b, Element c, Element d, Element e, Element f,
Element g),
(a, b, c, d, e, f, g))
-> Maybe
((Element a, Element b, Element c, Element d, Element e, Element f,
Element g),
(a, b, c, d, e, f, g))
forall (m :: * -> *) a. Monad m => a -> m a
return ( (Element a
a', Element b
b', Element c
c', Element d
d', Element e
e', Element f
f', Element g
g')
, (a
as', b
bs', c
cs', d
ds', e
es', f
fs', g
gs') )
uncurry2 :: (a -> b -> c) -> (a, b) -> c
uncurry2 :: (a -> b -> c) -> (a, b) -> c
uncurry2 = (a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
Prelude.uncurry
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
fn (a
a, b
b, c
c) = a -> b -> c -> d
fn a
a b
b c
c
uncurry4 :: (a -> b -> c -> d -> g) -> (a, b, c, d) -> g
uncurry4 :: (a -> b -> c -> d -> g) -> (a, b, c, d) -> g
uncurry4 a -> b -> c -> d -> g
fn (a
a, b
b, c
c, d
d) = a -> b -> c -> d -> g
fn a
a b
b c
c d
d
uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5 a -> b -> c -> d -> e -> f
fn (a
a, b
b, c
c, d
d, e
e) = a -> b -> c -> d -> e -> f
fn a
a b
b c
c d
d e
e
uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
uncurry6 a -> b -> c -> d -> e -> f -> g
fn (a
a, b
b, c
c, d
d, e
e, f
f) = a -> b -> c -> d -> e -> f -> g
fn a
a b
b c
c d
d e
e f
f
uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> (a, b, c, d, e, f, g) -> h
uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> h)
-> (a, b, c, d, e, f, g) -> h
uncurry7 a -> b -> c -> d -> e -> f -> g -> h
fn (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = a -> b -> c -> d -> e -> f -> g -> h
fn a
a b
b c
c d
d e
e f
f g
g