haskus-utils-data (empty) → 1.0
raw patch · 10 files changed
+933/−0 lines, 10 filesdep +basedep +containersdep +extra
Dependencies added: base, containers, extra, haskus-utils-types, mtl, recursion-schemes, transformers
Files
- LICENSE +27/−0
- haskus-utils-data.cabal +41/−0
- src/lib/Haskus/Utils/Functor.hs +7/−0
- src/lib/Haskus/Utils/HList.hs +252/−0
- src/lib/Haskus/Utils/List.hs +16/−0
- src/lib/Haskus/Utils/Map.hs +6/−0
- src/lib/Haskus/Utils/Map/Strict.hs +7/−0
- src/lib/Haskus/Utils/Maybe.hs +32/−0
- src/lib/Haskus/Utils/Monad.hs +43/−0
- src/lib/Haskus/Utils/Tuple.hs +502/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2013-2017, Haskus organization+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++ * Neither the name of Sylvain Henry nor the names of other contributors + may be used to endorse or promote products derived from this software + without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER BE LIABLE FOR ANY DIRECT,+INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ haskus-utils-data.cabal view
@@ -0,0 +1,41 @@+name: haskus-utils-data+version: 1.0+cabal-version: >=1.20+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Sylvain Henry 2018+maintainer: sylvain@haskus.fr+homepage: http://www.haskus.org+synopsis: Haskus utility modules+description:+ Haskus data utility modules+category: System+author: Sylvain Henry++source-repository head+ type: git+ location: git://github.com/haskus/haskus-utils.git++library+ exposed-modules:+ Haskus.Utils.Monad+ Haskus.Utils.HList+ Haskus.Utils.Functor+ Haskus.Utils.List+ Haskus.Utils.Map+ Haskus.Utils.Map.Strict+ Haskus.Utils.Maybe+ Haskus.Utils.Tuple+ build-depends:+ base >=4.9 && <4.12,+ haskus-utils-types ==1.0.*,+ extra >=1.4 && <1.7,+ recursion-schemes ==5.0.*,+ containers ==0.5.*,+ mtl ==2.2.*,+ transformers >=0.4 && <0.6+ default-language: Haskell2010+ hs-source-dirs: src/lib+ ghc-options: -Wall+
+ src/lib/Haskus/Utils/Functor.hs view
@@ -0,0 +1,7 @@+-- | Functor helpers+module Haskus.Utils.Functor+ ( module Data.Functor.Foldable+ )+where++import Data.Functor.Foldable
+ src/lib/Haskus/Utils/HList.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE StandaloneDeriving #-}++-- | Heterogeneous list utils+module Haskus.Utils.HList+ ( HList (..)+ , hHead+ , hTail+ , hLength+ , hAppend+ , HFoldr' (..)+ , HFoldl' (..)+ , HTuple' (..)+ , Apply (..)+ , HZipList+ , hZipList+ , HFoldr+ , hFoldr+ , HFoldl+ , hFoldl+ , HReverse (..)+ )+where++import Haskus.Utils.Tuple+import Haskus.Utils.Types+import Haskus.Utils.Types.List++-- | Heterogeneous list+data family HList (l :: [*])+data instance HList '[] = HNil+data instance HList (x ': xs) = x `HCons` HList xs++infixr 2 `HCons`++deriving instance Eq (HList '[])+deriving instance (Eq x, Eq (HList xs)) => Eq (HList (x ': xs))++deriving instance Ord (HList '[])+deriving instance (Ord x, Ord (HList xs)) => Ord (HList (x ': xs))+++instance Show (HList '[]) where+ show _ = "H[]"++instance (Show e, Show (HList l)) => Show (HList (e ': l)) where+ show (HCons x l) = let 'H':'[':s = show l+ in "H[" ++ show x +++ (if s == "]" then s else "," ++ s)++-- | Head+hHead :: HList (e ': l) -> e+hHead (HCons x _) = x++-- | Tail+hTail :: HList (e ': l) -> HList l+hTail (HCons _ l) = l++-- | Length+hLength :: forall xs. (KnownNat (Length xs)) => HList xs -> Word+hLength _ = natValue' @(Length xs)++class HAppendList l1 l2 where+ hAppend :: HList l1 -> HList l2 -> HList (Concat l1 l2)++instance HAppendList '[] l2 where+ hAppend HNil l = l++instance HAppendList l l' => HAppendList (x ': l) l' where+ hAppend (HCons x l) l' = HCons x (hAppend l l')+++-- | Apply the function identified by the data type f from type a to type b.+class Apply f a b where+ apply :: f -> a -> b++--------------------------------------+-- Folding+--------------------------------------++class HFoldr f v (l :: [*]) r where+ hFoldr :: f -> v -> HList l -> r++instance (v ~ v') => HFoldr f v '[] v' where+ hFoldr _ v _ = v++instance+ ( Apply f (e, r) r'+ , HFoldr f v l r+ ) => HFoldr f v (e ': l) r'+ where+ hFoldr f v (HCons x l) = apply f (x, hFoldr f v l :: r)+++-- | Like HFoldr but only use types, not values!+--+-- It allows us to foldr over a list of types, without any associated hlist of+-- values.+class HFoldr' f v (l :: [*]) r where+ hFoldr' :: f -> v -> HList l -> r++instance (v ~ v') => HFoldr' f v '[] v' where+ hFoldr' _ v _ = v++instance+ ( Apply f (e, r) r'+ , HFoldr' f v l r+ ) => HFoldr' f v (e ': l) r'+ where+ -- compared to hFoldr, we pass undefined values instead of the values+ -- supposedly in the list (we don't have a real list associated to HList l)+ hFoldr' f v _ = apply f (undefined :: e, hFoldr' f v (undefined :: HList l) :: r)++class HFoldl f (z :: *) xs (r :: *) where+ hFoldl :: f -> z -> HList xs -> r++instance forall f z z' r x zx xs.+ ( zx ~ (z,x)+ , Apply f zx z'+ , HFoldl f z' xs r+ ) => HFoldl f z (x ': xs) r+ where+ hFoldl f z (x `HCons` xs) = hFoldl f (apply f (z,x) :: z') xs++instance (z ~ z') => HFoldl f z '[] z' where+ hFoldl _ z _ = z++-- | Like HFoldl but only use types, not values!+--+-- It allows us to foldr over a list of types, without any associated hlist of+-- values.+class HFoldl' f (z :: *) xs (r :: *) where+ hFoldl' :: f -> z -> HList xs -> r++instance forall f z z' r x zx xs.+ ( zx ~ (z,x)+ , Apply f zx z'+ , HFoldl' f z' xs r+ ) => HFoldl' f z (x ': xs) r+ where+ hFoldl' f z (_ `HCons` xs) = hFoldl' f (apply f (z,(undefined :: x)) :: z') xs++instance (z ~ z') => HFoldl' f z '[] z' where+ hFoldl' _ z _ = z++++class HZipList x y l | x y -> l, l -> x y where+ hZipList :: HList x -> HList y -> HList l+ hUnzipList :: HList l -> (HList x, HList y)++instance HZipList '[] '[] '[] where+ hZipList _ _ = HNil+ hUnzipList _ = (HNil, HNil)++instance ((x,y)~z, HZipList xs ys zs) => HZipList (x ': xs) (y ': ys) (z ': zs) where+ hZipList (HCons x xs) (HCons y ys) = (x,y) `HCons` hZipList xs ys+ hUnzipList (HCons ~(x,y) zs) = let ~(xs,ys) = hUnzipList zs in (x `HCons` xs, y `HCons` ys)+++class HRevApp l1 l2 l3 | l1 l2 -> l3 where+ hRevApp :: HList l1 -> HList l2 -> HList l3++instance HRevApp '[] l2 l2 where+ hRevApp _ l = l++instance HRevApp l (x ': l') z => HRevApp (x ': l) l' z where+ hRevApp (HCons x l) l' = hRevApp l (HCons x l')++++class HReverse xs sx | xs -> sx, sx -> xs where+ hReverse :: HList xs -> HList sx++instance+ ( HRevApp xs '[] sx+ , HRevApp sx '[] xs+ ) => HReverse xs sx+ where+ hReverse l = hRevApp l HNil+++--------------------------------------+-- Tuple convertion+--------------------------------------++-- * Conversion to and from tuples++-- | Convert between hlists and tuples+class HTuple' v t | v -> t, t -> v where+ -- | Convert an heterogeneous list into a tuple+ hToTuple' :: HList v -> t+ + -- | Convert a tuple into an heterogeneous list+ hFromTuple' :: t -> HList v+++instance HTuple' '[] () where+ hToTuple' HNil = ()+ hFromTuple' () = HNil++instance HTuple' '[a] (Single a) where+ hToTuple' (a `HCons` HNil) = Single a+ hFromTuple' (Single a) = a `HCons` HNil++instance HTuple' '[a,b] (a,b) where+ hToTuple' (a `HCons` b `HCons` HNil) = (a,b)+ hFromTuple' (a,b) = a `HCons` b `HCons` HNil++instance HTuple' '[a,b,c] (a,b,c) where+ hToTuple' (a `HCons` b `HCons` c `HCons` HNil) = (a,b,c)+ hFromTuple' (a,b,c) = a `HCons` b `HCons` c `HCons` HNil++instance HTuple' '[a,b,c,d] (a,b,c,d) where+ hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` HNil) = (a,b,c,d)+ hFromTuple' (a,b,c,d) = a `HCons` b `HCons` c `HCons` d `HCons` HNil++instance HTuple' '[a,b,c,d,e] (a,b,c,d,e) where+ hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` HNil) = (a,b,c,d,e)+ hFromTuple' (a,b,c,d,e) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` HNil++instance HTuple' '[a,b,c,d,e,f] (a,b,c,d,e,f) where+ hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil) = (a,b,c,d,e,f)+ hFromTuple' (a,b,c,d,e,f) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil++instance HTuple' '[a,b,c,d,e,f,g] (a,b,c,d,e,f,g) where+ hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` HNil) = (a,b,c,d,e,f,g)+ hFromTuple' (a,b,c,d,e,f,g) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` HNil++instance HTuple' '[a,b,c,d,e,f,g,h] (a,b,c,d,e,f,g,h) where+ hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` HNil) = (a,b,c,d,e,f,g,h)+ hFromTuple' (a,b,c,d,e,f,g,h) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` HNil++instance HTuple' '[a,b,c,d,e,f,g,h,i] (a,b,c,d,e,f,g,h,i) where+ hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` i `HCons` HNil) = (a,b,c,d,e,f,g,h,i)+ hFromTuple' (a,b,c,d,e,f,g,h,i) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` i `HCons` HNil++instance HTuple' '[a,b,c,d,e,f,g,h,i,j] (a,b,c,d,e,f,g,h,i,j) where+ hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` i `HCons` j `HCons` HNil) = (a,b,c,d,e,f,g,h,i,j)+ hFromTuple' (a,b,c,d,e,f,g,h,i,j) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` i `HCons` j `HCons` HNil
+ src/lib/Haskus/Utils/List.hs view
@@ -0,0 +1,16 @@+module Haskus.Utils.List+ ( checkLength+ , module Data.List+ , module Data.List.Extra+ )+where++import Data.List+import Data.List.Extra++-- | Check that a list has the given length (support infinite lists)+checkLength :: Word -> [a] -> Bool+checkLength 0 [] = True+checkLength 0 _ = False+checkLength _ [] = False+checkLength i (_:xs) = checkLength (i-1) xs
+ src/lib/Haskus/Utils/Map.hs view
@@ -0,0 +1,6 @@+module Haskus.Utils.Map+ ( module Data.Map+ )+where++import Data.Map
+ src/lib/Haskus/Utils/Map/Strict.hs view
@@ -0,0 +1,7 @@+module Haskus.Utils.Map.Strict+ ( module Data.Map.Strict+ )+where++import Data.Map.Strict+
+ src/lib/Haskus/Utils/Maybe.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE LambdaCase #-}++-- | Utils for Maybe data type+module Haskus.Utils.Maybe+ ( onNothing+ , onNothingM+ , fromMaybeM+ , headMaybe+ , module Data.Maybe+ )+where++import Data.Maybe++-- | Flipped `fromMaybe`+onNothing :: Maybe a -> a -> a+onNothing = flip fromMaybe++-- | Flipped `fromMaybeM`+onNothingM :: Monad m => m (Maybe a) -> m a -> m a+onNothingM = flip fromMaybeM++-- | fromMaybe in a Monad+fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a+fromMaybeM v f = f >>= \case+ Nothing -> v+ Just x -> return x++-- | Get the head of the list if the latter is not empty+headMaybe :: [a] -> Maybe a+headMaybe [] = Nothing+headMaybe (x:_) = Just x
+ src/lib/Haskus/Utils/Monad.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}++-- | Utils for Monads+module Haskus.Utils.Monad+ ( MonadInIO (..)+ , module Control.Monad+ , module Control.Monad.IO.Class+ , module Control.Monad.Extra+ , module Control.Monad.Trans.Class+ )+where++import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad+import Control.Monad.Extra+import Control.Monad.State++class MonadIO m => MonadInIO m where+ -- | Lift with*-like functions into IO (alloca, etc.)+ liftWith :: (forall c. (a -> IO c) -> IO c) -> (a -> m b) -> m b++ -- | Lift with*-like functions into IO (alloca, etc.)+ liftWith2 :: (forall c. (a -> b -> IO c) -> IO c) -> (a -> b -> m e) -> m e++instance MonadInIO IO where+ {-# INLINE liftWith #-}+ liftWith = id++ {-# INLINE liftWith2 #-}+ liftWith2 = id++instance MonadInIO m => MonadInIO (StateT s m) where+ {-# INLINE liftWith #-}+ liftWith wth f =+ StateT $ \s -> do+ liftWith wth (\a -> runStateT (f a) s)++ {-# INLINE liftWith2 #-}+ liftWith2 wth f =+ StateT $ \s ->+ liftWith2 wth (\a b -> runStateT (f a b) s)
+ src/lib/Haskus/Utils/Tuple.hs view
@@ -0,0 +1,502 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++-- | Tuple helpers+module Haskus.Utils.Tuple+ ( uncurry3+ , uncurry4+ , take4+ , fromTuple4+ , module Data.Tuple+ , Single (..)+ , TupleToList+ , ListToTuple+ , ExtractTuple (..)+ , TupleHead (..)+ , TupleTail (..)+ , TupleCons (..)+ , ReorderTuple (..)+ )+where++import Data.Tuple+import Haskus.Utils.Types++-- | Uncurry specialised for triple+uncurry3 :: (a -> b -> c -> e) -> (a,b,c) -> e+{-# INLINE uncurry3 #-}+uncurry3 f (a,b,c) = f a b c++-- | Uncurry specialised for quadruple+uncurry4 :: (a -> b -> c -> d -> e) -> (a,b,c,d) -> e+{-# INLINE uncurry4 #-}+uncurry4 f (a,b,c,d) = f a b c d+++-- | Take specialised for quadruple+take4 :: [a] -> (a,a,a,a)+{-# INLINE take4 #-}+take4 [a,b,c,d] = (a,b,c,d)+take4 _ = error "take4: invalid list (exactly 4 elements required)"+++-- | toList for quadruple+fromTuple4 :: (a,a,a,a) -> [a]+{-# INLINE fromTuple4 #-}+fromTuple4 (a,b,c,d) = [a,b,c,d]++-- | Singleton type+newtype Single a = Single a deriving (Show,Eq)+++type family TupleToList t where+ TupleToList (Single a) = '[a]+ TupleToList (a,b) = '[a,b]+ TupleToList (a,b,c) = '[a,b,c]+ TupleToList (a,b,c,d) = '[a,b,c,d]+ TupleToList (a,b,c,d,e) = '[a,b,c,d,e]+ TupleToList (a,b,c,d,e,f) = '[a,b,c,d,e,f]+ TupleToList (a,b,c,d,e,f,g) = '[a,b,c,d,e,f,g]+ TupleToList (a,b,c,d,e,f,g,h) = '[a,b,c,d,e,f,g,h]+ TupleToList (a,b,c,d,e,f,g,h,i) = '[a,b,c,d,e,f,g,h,i]+ TupleToList (a,b,c,d,e,f,g,h,i,j) = '[a,b,c,d,e,f,g,h,i,j]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k) = '[a,b,c,d,e,f,g,h,i,j,k]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l) = '[a,b,c,d,e,f,g,h,i,j,k,l]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m) = '[a,b,c,d,e,f,g,h,i,j,k,l,m]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y]+ TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z]++type family ListToTuple t where+ ListToTuple '[a] = Single a+ ListToTuple '[a,b] = (a,b)+ ListToTuple '[a,b,c] = (a,b,c)+ ListToTuple '[a,b,c,d] = (a,b,c,d)+ ListToTuple '[a,b,c,d,e] = (a,b,c,d,e)+ ListToTuple '[a,b,c,d,e,f] = (a,b,c,d,e,f)+ ListToTuple '[a,b,c,d,e,f,g] = (a,b,c,d,e,f,g)+ ListToTuple '[a,b,c,d,e,f,g,h] = (a,b,c,d,e,f,g,h)+ ListToTuple '[a,b,c,d,e,f,g,h,i] = (a,b,c,d,e,f,g,h,i)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j] = (a,b,c,d,e,f,g,h,i,j)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k] = (a,b,c,d,e,f,g,h,i,j,k)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l] = (a,b,c,d,e,f,g,h,i,j,k,l)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m] = (a,b,c,d,e,f,g,h,i,j,k,l,m)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y)+ ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z)++-- | Extract a tuple value statically+class ExtractTuple (n :: Nat) t x | n t -> x where+ -- | Extract a tuple value by type-level index+ tupleN :: t -> x++instance ExtractTuple 0 (Single t) t where+ {-# INLINE tupleN #-}+ tupleN (Single t) = t++instance ExtractTuple 0 (e0, e1) e0 where+ {-# INLINE tupleN #-}+ tupleN (t,_) = t++instance ExtractTuple 1 (e0, e1) e1 where+ {-# INLINE tupleN #-}+ tupleN (_,t) = t++instance ExtractTuple 0 (e0, e1, e2) e0 where+ {-# INLINE tupleN #-}+ tupleN (t,_,_) = t++instance ExtractTuple 1 (e0, e1, e2) e1 where+ {-# INLINE tupleN #-}+ tupleN (_,t,_) = t++instance ExtractTuple 2 (e0, e1, e2) e2 where+ {-# INLINE tupleN #-}+ tupleN (_,_,t) = t++instance ExtractTuple 0 (e0, e1, e2, e3) e0 where+ {-# INLINE tupleN #-}+ tupleN (t,_,_,_) = t++instance ExtractTuple 1 (e0, e1, e2, e3) e1 where+ {-# INLINE tupleN #-}+ tupleN (_,t,_,_) = t++instance ExtractTuple 2 (e0, e1, e2, e3) e2 where+ {-# INLINE tupleN #-}+ tupleN (_,_,t,_) = t++instance ExtractTuple 3 (e0, e1, e2, e3) e3 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,t) = t+++instance ExtractTuple 0 (e0, e1, e2, e3, e4) e0 where+ {-# INLINE tupleN #-}+ tupleN (t,_,_,_,_) = t++instance ExtractTuple 1 (e0, e1, e2, e3, e4) e1 where+ {-# INLINE tupleN #-}+ tupleN (_,t,_,_,_) = t++instance ExtractTuple 2 (e0, e1, e2, e3, e4) e2 where+ {-# INLINE tupleN #-}+ tupleN (_,_,t,_,_) = t++instance ExtractTuple 3 (e0, e1, e2, e3, e4) e3 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,t,_) = t++instance ExtractTuple 4 (e0, e1, e2, e3, e4) e4 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,t) = t+++instance ExtractTuple 0 (e0, e1, e2, e3, e4, e5) e0 where+ {-# INLINE tupleN #-}+ tupleN (t,_,_,_,_,_) = t++instance ExtractTuple 1 (e0, e1, e2, e3, e4, e5) e1 where+ {-# INLINE tupleN #-}+ tupleN (_,t,_,_,_,_) = t++instance ExtractTuple 2 (e0, e1, e2, e3, e4, e5) e2 where+ {-# INLINE tupleN #-}+ tupleN (_,_,t,_,_,_) = t++instance ExtractTuple 3 (e0, e1, e2, e3, e4, e5) e3 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,t,_,_) = t++instance ExtractTuple 4 (e0, e1, e2, e3, e4, e5) e4 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,t,_) = t++instance ExtractTuple 5 (e0, e1, e2, e3, e4, e5) e5 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,_,t) = t+++instance ExtractTuple 0 (e0, e1, e2, e3, e4, e5, e6) e0 where+ {-# INLINE tupleN #-}+ tupleN (t,_,_,_,_,_,_) = t++instance ExtractTuple 1 (e0, e1, e2, e3, e4, e5, e6) e1 where+ {-# INLINE tupleN #-}+ tupleN (_,t,_,_,_,_,_) = t++instance ExtractTuple 2 (e0, e1, e2, e3, e4, e5, e6) e2 where+ {-# INLINE tupleN #-}+ tupleN (_,_,t,_,_,_,_) = t++instance ExtractTuple 3 (e0, e1, e2, e3, e4, e5, e6) e3 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,t,_,_,_) = t++instance ExtractTuple 4 (e0, e1, e2, e3, e4, e5, e6) e4 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,t,_,_) = t++instance ExtractTuple 5 (e0, e1, e2, e3, e4, e5, e6) e5 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,_,t,_) = t++instance ExtractTuple 6 (e0, e1, e2, e3, e4, e5, e6) e6 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,_,_,t) = t+++instance ExtractTuple 0 (e0, e1, e2, e3, e4, e5, e6, e7) e0 where+ {-# INLINE tupleN #-}+ tupleN (t,_,_,_,_,_,_,_) = t++instance ExtractTuple 1 (e0, e1, e2, e3, e4, e5, e6, e7) e1 where+ {-# INLINE tupleN #-}+ tupleN (_,t,_,_,_,_,_,_) = t++instance ExtractTuple 2 (e0, e1, e2, e3, e4, e5, e6, e7) e2 where+ {-# INLINE tupleN #-}+ tupleN (_,_,t,_,_,_,_,_) = t++instance ExtractTuple 3 (e0, e1, e2, e3, e4, e5, e6, e7) e3 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,t,_,_,_,_) = t++instance ExtractTuple 4 (e0, e1, e2, e3, e4, e5, e6, e7) e4 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,t,_,_,_) = t++instance ExtractTuple 5 (e0, e1, e2, e3, e4, e5, e6, e7) e5 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,_,t,_,_) = t++instance ExtractTuple 6 (e0, e1, e2, e3, e4, e5, e6, e7) e6 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,_,_,t,_) = t++instance ExtractTuple 7 (e0, e1, e2, e3, e4, e5, e6, e7) e7 where+ {-# INLINE tupleN #-}+ tupleN (_,_,_,_,_,_,_,t) = t+++class TupleHead ts ts' | ts -> ts' where+ tupleHead :: ts -> ts'++instance TupleHead (Single a) a where+ {-# INLINE tupleHead #-}+ tupleHead (Single a) = a++instance TupleHead (a,b) a where+ {-# INLINE tupleHead #-}+ tupleHead (a,_) = a++instance TupleHead (a,b,c) a where+ {-# INLINE tupleHead #-}+ tupleHead (a,_,_) = a++instance TupleHead (a,b,c,d) a where+ {-# INLINE tupleHead #-}+ tupleHead (a,_,_,_) = a++instance TupleHead (a,b,c,d,e) a where+ {-# INLINE tupleHead #-}+ tupleHead (a,_,_,_,_) = a++instance TupleHead (a,b,c,d,e,f) a where+ {-# INLINE tupleHead #-}+ tupleHead (a,_,_,_,_,_) = a+++class TupleTail ts ts' | ts -> ts' where+ tupleTail :: ts -> ts'++instance TupleTail (a,b) (Single b) where+ {-# INLINE tupleTail #-}+ tupleTail (_,b) = Single b++instance TupleTail (a,b,c) (b,c) where+ {-# INLINE tupleTail #-}+ tupleTail (_,b,c) = (b,c)++instance TupleTail (a,b,c,d) (b,c,d) where+ {-# INLINE tupleTail #-}+ tupleTail (_,b,c,d) = (b,c,d)++instance TupleTail (a,b,c,d,e) (b,c,d,e) where+ {-# INLINE tupleTail #-}+ tupleTail (_,b,c,d,e) = (b,c,d,e)++instance TupleTail (a,b,c,d,e,f) (b,c,d,e,f) where+ {-# INLINE tupleTail #-}+ tupleTail (_,b,c,d,e,f) = (b,c,d,e,f)++++class TupleCons t ts ts' | t ts -> ts' where+ tupleCons :: t -> ts -> ts'++instance TupleCons a (Single b) (a,b) where+ {-# INLINE tupleCons #-}+ tupleCons a (Single b) = (a,b)++instance TupleCons a (b,c) (a,b,c) where+ {-# INLINE tupleCons #-}+ tupleCons a (b,c) = (a,b,c)++instance TupleCons a (b,c,d) (a,b,c,d) where+ {-# INLINE tupleCons #-}+ tupleCons a (b,c,d) = (a,b,c,d)++instance TupleCons a (b,c,d,e) (a,b,c,d,e) where+ {-# INLINE tupleCons #-}+ tupleCons a (b,c,d,e) = (a,b,c,d,e)++instance TupleCons a (b,c,d,e,f) (a,b,c,d,e,f) where+ {-# INLINE tupleCons #-}+ tupleCons a (b,c,d,e,f) = (a,b,c,d,e,f)+++-- | Reorder tuple elements+class ReorderTuple t1 t2 where+ -- | Reorder tuple elements+ tupleReorder :: t1 -> t2+++instance ReorderTuple (Single a) (Single a) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b) (a,b) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b,c) (a,b,c) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b,c,d) (a,b,c,d) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b,c,d,e) (a,b,c,d,e) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b,c,d,e,f) (a,b,c,d,e,f) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b,c,d,e,f,g) (a,b,c,d,e,f,g) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b,c,d,e,f,g,h) (a,b,c,d,e,f,g,h) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g,h,i) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id++instance ReorderTuple (a,b,c,d,e,f,g,h,i,j) (a,b,c,d,e,f,g,h,i,j) where+ {-# INLINE tupleReorder #-}+ tupleReorder = id+++instance ReorderTuple (a,b) (b,a) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b) = (b,a)++instance ReorderTuple (a,b,c) (a,c,b) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c) = (a,c,b)++instance ReorderTuple (a,b,c) (b,a,c) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c) = (b,a,c)++instance ReorderTuple (a,b,c) (b,c,a) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c) = (b,c,a)++instance ReorderTuple (a,b,c) (c,a,b) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c) = (c,a,b)++instance ReorderTuple (a,b,c) (c,b,a) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c) = (c,b,a)++instance ReorderTuple (b,c,d) (x,y,z) => ReorderTuple (a,b,c,d) (a,x,y,z) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d) = let (x,y,z) = tupleReorder (b,c,d) in (a,x,y,z)++instance ReorderTuple (a,c,d) (x,y,z) => ReorderTuple (a,b,c,d) (x,b,y,z) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d) = let (x,y,z) = tupleReorder (a,c,d) in (x,b,y,z)++instance ReorderTuple (a,b,d) (x,y,z) => ReorderTuple (a,b,c,d) (x,y,c,z) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d) = let (x,y,z) = tupleReorder (a,b,d) in (x,y,c,z)++instance ReorderTuple (a,b,c) (x,y,z) => ReorderTuple (a,b,c,d) (x,y,z,d) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d) = let (x,y,z) = tupleReorder (a,b,c) in (x,y,z,d)++instance ReorderTuple (b,c,d,e) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (a,x,y,z,w) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (b,c,d,e) in (a,x,y,z,w)++instance ReorderTuple (a,c,d,e) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (x,b,y,z,w) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (a,c,d,e) in (x,b,y,z,w)++instance ReorderTuple (a,b,d,e) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (x,y,c,z,w) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (a,b,d,e) in (x,y,c,z,w)++instance ReorderTuple (a,b,c,e) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (x,y,z,d,w) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (a,b,c,e) in (x,y,z,d,w)++instance ReorderTuple (a,b,c,d) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (x,y,z,w,e) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (a,b,c,d) in (x,y,z,w,e)++instance ReorderTuple (b,c,d,e,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (a,x,y,z,w,v) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (b,c,d,e,f) in (a,x,y,z,w,v)++instance ReorderTuple (a,c,d,e,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,b,y,z,w,v) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,c,d,e,f) in (x,b,y,z,w,v)++instance ReorderTuple (a,b,d,e,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,y,c,z,w,v) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,b,d,e,f) in (x,y,c,z,w,v)++instance ReorderTuple (a,b,c,e,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,y,z,d,w,v) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,b,c,e,f) in (x,y,z,d,w,v)++instance ReorderTuple (a,b,c,d,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,y,z,w,e,v) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,b,c,d,f) in (x,y,z,w,e,v)++instance ReorderTuple (a,b,c,d,e) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,y,z,w,v,f) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,b,c,d,e) in (x,y,z,w,v,f)+++instance ReorderTuple (b,c,d,e,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (a,x,y,z,w,v,u) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (b,c,d,e,f,g) in (a,x,y,z,w,v,u)++instance ReorderTuple (a,c,d,e,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,b,y,z,w,v,u) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,c,d,e,f,g) in (x,b,y,z,w,v,u)++instance ReorderTuple (a,b,d,e,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,c,z,w,v,u) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,d,e,f,g) in (x,y,c,z,w,v,u)++instance ReorderTuple (a,b,c,e,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,z,d,w,v,u) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,c,e,f,g) in (x,y,z,d,w,v,u)++instance ReorderTuple (a,b,c,d,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,z,w,e,v,u) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,c,d,f,g) in (x,y,z,w,e,v,u)++instance ReorderTuple (a,b,c,d,e,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,z,w,v,f,u) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,c,d,e,g) in (x,y,z,w,v,f,u)++instance ReorderTuple (a,b,c,d,e,f) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,z,w,v,u,g) where+ {-# INLINE tupleReorder #-}+ tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,c,d,e,f) in (x,y,z,w,v,u,g)