tuple-sop (empty) → 0.1.0.0
raw patch · 7 files changed
+849/−0 lines, 7 filesdep +basedep +generics-sopdep +tuple-sopsetup-changed
Dependencies added: base, generics-sop, tuple-sop
Files
- ChangeLog.md +5/−0
- LICENSE +165/−0
- README.md +1/−0
- Setup.hs +2/−0
- src/Data/Tuple/Ops.hs +620/−0
- test/Spec.hs +2/−0
- tuple-sop.cabal +54/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for tuple-sop++## 0.1.0.0 -- 2018-13-04++* Initial release
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library.
+ README.md view
@@ -0,0 +1,1 @@+# tuple-sop
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Tuple/Ops.hs view
@@ -0,0 +1,620 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilyDependencies #-}+module Data.Tuple.Ops+ ( -- * Selection+ sel+ , selN+ -- ** convenience functions + , sel1+ , sel2+ , sel3+ , sel4+ , sel5+ , sel6+ , sel7+ , sel8+ , sel9+ , sel10+ , lastT+ -- * Application+ , app+ , appPoly+ , appN+ , mapT+ , mapPolyT+ -- ** convenience functions + , app1+ , app2+ , app3+ , app4+ , app5+ , app6+ , app7+ , app8+ , app9+ , app10+ -- * Constructing tuples+ , consT+ , snocT+ , appendT+ , initT+ , tailT+ -- * Deletion+ , del+ , delN+ -- ** convenience functions+ , del1+ , del2+ , del3+ , del4+ , del5+ , del6+ , del7+ , del8+ , del9+ , del10+ -- * Currying+ , uncurryT+ , curryT) where++import Generics.SOP+import GHC.Exts+import GHC.TypeLits++class Select s t where+ -- | Takes an n-ary tuple and returns the first element of the requested type+ --+ -- >>> sel (1,'d','c') :: Char+ -- 'd'+ sel :: s -> t++instance (GenericNP s, GSelect (RepNP s) t) => Select s t where+ sel s = gsel (from_np s)++class GSelect s t where+ gsel :: s -> t++instance {-# OVERLAPPING #-} GSelect (NP I (t ': xs)) t where+ gsel = unI . hd++instance {-# OVERLAPPING #-} GSelect (NP I xs) t => GSelect (NP I (a ': xs)) t where+ gsel = gsel . tl++class SelectN s (n :: Nat) t | s n -> t where+ -- | Takes an n-ary tuple and a `Proxy` carrying a `Nat`, returns the element with the index specified by the @Nat@+ --+ -- >>> selN (1,'d',False,'c') (Proxy :: Proxy 2)+ -- False+ selN :: s -> Proxy n -> t++instance (GenericNP s, GSelectN (RepNP s) (Lit n) t) => SelectN s n t where+ selN s Proxy = gselN (from_np s) (Proxy :: Proxy (Lit n))++class GSelectN s (n :: Nat') t | s n -> t where+ gselN :: s -> Proxy n -> t++instance GSelectN (NP I (t ': xs)) Z' t where+ gselN np _ = unI $ hd np++instance GSelectN (NP I xs) n t => GSelectN (NP I (a ': xs)) (S' n) t where+ gselN np _ = gselN (tl np) (Proxy :: Proxy n)+++-- | Selects the first element in an n-ary tuple+--+-- >>> sel1 (0,'d','c')+-- 0+sel1 :: SelectN s 0 t => s -> t+sel1 s = selN s (Proxy :: Proxy 0)+sel2 :: SelectN s 1 t => s -> t+sel2 s = selN s (Proxy :: Proxy 1)+sel3 :: SelectN s 2 t => s -> t+sel3 s = selN s (Proxy :: Proxy 2)+sel4 :: SelectN s 3 t => s -> t+sel4 s = selN s (Proxy :: Proxy 3)+sel5 :: SelectN s 4 t => s -> t+sel5 s = selN s (Proxy :: Proxy 4)+sel6 :: SelectN s 5 t => s -> t+sel6 s = selN s (Proxy :: Proxy 5)+sel7 :: SelectN s 6 t => s -> t+sel7 s = selN s (Proxy :: Proxy 6)+sel8 :: SelectN s 7 t => s -> t+sel8 s = selN s (Proxy :: Proxy 7)+sel9 :: SelectN s 8 t => s -> t+sel9 s = selN s (Proxy :: Proxy 8)+sel10 :: SelectN s 9 t => s -> t+sel10 s = selN s (Proxy :: Proxy 9)++-- | Selects the last element of any n-ary tuple+--+-- >>> lastT (1,2,3,4)+-- 4+--+-- >>> lastT (1,2,3)+-- 3+lastT :: forall s n t. (LengthT s ~ n, SelectN s (n - 1) t) => s -> t+lastT s = selN s (Proxy :: Proxy (n - 1))++class TailT s t where+ -- | Takes an n-ary tuple and returns the same tuple minus the first element.+ --+ -- >>> tailT (1,2,3,4)+ -- (2,3,4)+ --+ -- Works only only tuples of size at least 3+ --+ -- >>> tailT (1,2)+ -- Couldn't match type `2 ':<= 3' with `2 ':>= 3'+ tailT :: s -> t++instance (GenericNP s, GenericNP t, LEQ (LengthT s) 3, GTailT (RepNP s) (RepNP t)) => TailT s t where+ tailT = to_np . gtailT . from_np+ +class GTailT s t | s -> t where+ gtailT :: s -> t++instance GTailT (NP I (a ': xs)) (NP I xs) where+ gtailT (_ :* xs) = xs++class InitT s t where+ -- | Takes an n-ary tuple and returns the same tuple minus the first element.+ --+ -- >>> initT (1,2,3,4)+ -- (1,2,3)+ --+ -- Works only only tuples of size at least 3+ --+ -- >>> initT (1,2)+ -- Couldn't match type `2 ':<= 3' with `2 ':>= 3'+ initT :: s -> t++instance (GenericNP s, GenericNP t, LEQ (LengthT s) 3, GInitT (RepNP s) (RepNP t)) => InitT s t where+ initT = to_np . ginitT . from_np++class GInitT s t | s -> t where+ ginitT :: s -> t++instance GInitT (NP I '[c]) (NP I '[]) where+ ginitT _ = Nil :: NP I '[]++instance GInitT (NP I (b ': xs)) (NP I xs') => GInitT (NP I (a ': b ': xs)) (NP I (a ': xs')) where+ ginitT (a :* b :* xs) = a :* ginitT (b :* xs)++class App f s t where+ -- | Applies a monomorphic function to the first element of an n-ary tuple that matches the type of the argument of the function.+ --+ -- >>> app not ('d',True)+ -- ('d',False)+ --+ -- Sometimes it is necessary to specify the result type, such that the function becomes monomorphic+ -- >>> app (+1) (True,5) :: (Bool,Integer)+ -- (True,6)+ --+ -- One may also use `appPoly`, which doesn't require specifying the result type. However it can only apply functions+ -- to the first element of an n-ary tuple. For application to other elements use `appPolyN` or one of its derivatives.+ app :: f -> s -> t++instance (GenericNP s, GenericNP t, Applicable f (RepNP s) ~ app, GApp f app (RepNP s) (RepNP t)) => App f s t where+ app f s = to_np $ gapp f (Proxy :: Proxy app) (from_np s)++class GApp f (app :: [Bool]) s t | f s app -> t where+ gapp :: f -> Proxy app -> s -> t++instance (a ~ a', b ~ b') => GApp (Poly a b) ('True ': app) (NP I (a' ': xs)) (NP I (b' ': xs)) where+ gapp (Poly f) _ (I t :* xs) = I (f t) :* xs++instance GApp (a -> b) ('True ': app) (NP I (a ': xs)) (NP I (b ': xs)) where+ gapp f _ (I t :* xs) = I (f t) :* xs++instance GApp f app (NP I xs) (NP I xs') => GApp f ('False ': app) (NP I (c ': xs)) (NP I (c ': xs')) where+ gapp f _ (c :* xs) = c :* gapp f (Proxy :: Proxy app) xs++-- | Applies a polymorphic function to the first element of an n-ary tuple. Since the function is polymorphic in its argument it can always be applied to the first element of a tuple.+--+-- >>> appPoly show (5,False)+-- ("5",False)+appPoly :: App (Poly a b) s t => (a -> b) -> s -> t+appPoly f s = app (poly f) s+ +class AppN f s (n :: Nat) t where+ -- | Applies a function to the element at index @n@ in an n-ary tuple.+ --+ -- >>> appN not (Proxy 2) (False,True,False)+ -- (False,True,True)+ --+ -- `appN` also works for polymorphic functions+ --+ -- >>> appN show (5,'c',False) (Proxy :: Proxy 2)+ -- (5,'c',"False")+ appN :: f -> s -> Proxy n -> t++instance (GenericNP s, GenericNP t, GAppN (Poly a b) (RepNP s) (Lit n) (RepNP t)) => AppN (a -> b) s n t where+ appN f s Proxy = to_np $ gappN (poly f) (from_np s) (Proxy :: Proxy (Lit n))++class GAppN f s (n :: Nat') t | f s n -> t where+ gappN :: f -> s -> Proxy n -> t++instance (a ~ a', b ~ b') => GAppN (Poly a b) (NP I (a' ': xs)) Z' (NP I (b' ': xs)) where+ gappN (Poly f) (I a :* xs) _ = I (f a) :* xs++instance GAppN f (NP I xs) n (NP I xs') => GAppN f (NP I (c ': xs)) (S' n) (NP I (c ': xs')) where+ gappN f (c :* xs) _ = c :* gappN f xs (Proxy :: Proxy n)++-- | Applies a function to the first element of an n-ary tuple+--+-- >>> app1 (+1) (5,6,7)+-- (6,6,7)+app1 :: AppN f s 0 t => f -> s -> t+app1 f s = appN f s (Proxy :: Proxy 0)+app2 :: AppN f s 1 t => f -> s -> t+app2 f s = appN f s (Proxy :: Proxy 1)+app3 :: AppN f s 2 t => f -> s -> t+app3 f s = appN f s (Proxy :: Proxy 2)+app4 :: AppN f s 3 t => f -> s -> t+app4 f s = appN f s (Proxy :: Proxy 3)+app5 :: AppN f s 4 t => f -> s -> t+app5 f s = appN f s (Proxy :: Proxy 4)+app6 :: AppN f s 5 t => f -> s -> t+app6 f s = appN f s (Proxy :: Proxy 5)+app7 :: AppN f s 6 t => f -> s -> t+app7 f s = appN f s (Proxy :: Proxy 6)+app8 :: AppN f s 7 t => f -> s -> t+app8 f s = appN f s (Proxy :: Proxy 7)+app9 :: AppN f s 8 t => f -> s -> t+app9 f s = appN f s (Proxy :: Proxy 8)+app10 :: AppN f s 9 t => f -> s -> t+app10 f s = appN f s (Proxy :: Proxy 9)++class MapT f s t where+ -- | Maps a monomorphic function over each element in an n-ary tuple that matches the type of the argument of the function+ --+ -- >>> map not (True,5,'c',False)+ -- (False,5,'c',True)+ --+ -- Sometimes it is necessary to specify the result type.+ --+ -- >>> map (+1) (5,6,7,False) :: (Integer,Integer,Integer,Bool)+ -- (6,7,8,False)+ --+ -- Using `mapPolyT` this is not necessary, but this comes with a limitation.+ mapT :: f -> s -> t++instance (GenericNP s, GenericNP t, Applicable f (RepNP s) ~ app, GMapT f app (RepNP s) (RepNP t)) => MapT f s t where+ mapT f s = to_np $ gmapT f (Proxy :: Proxy app) (from_np s)++class GMapT f (app :: [Bool]) s t | f app s -> t where+ gmapT :: f -> Proxy app -> s -> t++instance GMapT f '[] (NP I '[]) (NP I '[]) where+ gmapT _ _ = id++instance GMapT (a -> b) apps (NP I xs) (NP I xs') => GMapT (a -> b) ('True ': apps) (NP I (a ': xs)) (NP I (b ': xs')) where+ gmapT f _ (I a :* xs) = I (f a) :* gmapT f (Proxy :: Proxy apps) xs++instance (a ~ a', b ~ b', GMapT (Poly a b) apps (NP I xs) (NP I xs')) => GMapT (Poly a b) ('True ': apps) (NP I (a' ': xs)) (NP I (b' ': xs')) where+ gmapT p@(Poly f) _ (I a :* xs) = I (f a) :* gmapT p (Proxy :: Proxy apps) xs++instance GMapT f apps (NP I xs) (NP I xs') => GMapT f ('False ': apps) (NP I (c ': xs)) (NP I (c ': xs')) where+ gmapT f _ (c :* xs) = c :* gmapT f (Proxy :: Proxy apps) xs++-- | Applies a polymorphic function to each element in an n-ary tuple. Requires all elements in the tuple to be of the same type.+--+-- >>> mapPolyT (+1) (5,6,7,8)+-- (6,7,8,9)+--+-- >>> mapPolyT (+1) (5,6,7,False)+-- No instance for (Num Bool) arising from the literal `5'+mapPolyT :: MapT (Poly a b) s t => (a -> b) -> s -> t+mapPolyT f s = mapT (poly f) s++class ConsT a s t where+ -- | Adds an element to the head of an n-ary tuple+ --+ -- >>> consT 5 (True,'c')+ -- (5,True,'c')+ consT :: a -> s -> t++instance (GenericNP s, GenericNP t, GConsT a (RepNP s) (RepNP t)) => ConsT a s t where+ consT a s = to_np $ gconsT a (from_np s)++class GConsT a s t | a s -> t where+ gconsT :: a -> s -> t++instance GConsT a (NP I xs) (NP I (a ': xs)) where+ gconsT a xs = I a :* xs++class SnocT a s t where+ -- | Adds an element to the back of an n-ary tuple+ --+ -- >>> snocT 5 (True,'c')+ -- (True,'c',5)+ snocT :: a -> s -> t++instance (GenericNP s, GenericNP t, GSnocT a (RepNP s) (RepNP t)) => SnocT a s t where+ snocT a s = to_np $ gsnocT a (from_np s)++class GSnocT a s t | a s -> t where+ gsnocT :: a -> s -> t++instance GSnocT a (NP I '[]) (NP I '[a]) where+ gsnocT a Nil = I a :* Nil++instance GSnocT a (NP I xs) (NP I xs') => GSnocT a (NP I (b ': xs)) (NP I (b ': xs')) where+ gsnocT a (b :* xs) = b :* gsnocT a xs++class Delete s t where+ -- | Deletes the first element in an n-ary tuple whose type does not exist in the target type+ --+ -- >>> del ('c',False,5) :: (Char,Bool)+ -- ('c',False)+ del :: s -> t++instance (GenericNP s, GenericNP t, LEQ (LengthT s) 3, GDelete (RepNP s) (RepNP t)) => Delete s t where+ del = to_np . gdel . from_np++class GDelete s t where+ gdel :: s -> t++instance GDelete (NP I (a ': xs)) (NP I xs) where+ gdel (a :* xs) = xs++instance GDelete (NP I xs) (NP I xs') => GDelete (NP I (a ': xs)) (NP I (a ': xs')) where+ gdel (a :* xs) = a :* gdel xs++class DeleteN s (n :: Nat) t where+ -- | Deletes an element specified by an index in an n-ary tuple+ --+ -- >>> delN ('c',False,5) (Proxy :: Proxy 1)+ -- ('c',5)+ delN :: s -> Proxy n -> t++instance (GenericNP s, GenericNP t, LEQ (LengthT s) 3, GDeleteN (RepNP s) (Lit n) (RepNP t)) => DeleteN s n t where+ delN s Proxy = to_np $ gdelN (from_np s) (Proxy :: Proxy (Lit n))++class GDeleteN s (n :: Nat') t | s n -> t where+ gdelN :: s -> Proxy n -> t++instance GDeleteN (NP I (t ': xs)) Z' (NP I xs) where+ gdelN (_ :* xs) _ = xs++instance GDeleteN (NP I xs) n (NP I xs') => GDeleteN (NP I (a ': xs)) (S' n) (NP I (a ': xs')) where+ gdelN (a :* xs) _ = a :* gdelN xs (Proxy :: Proxy n) ++-- | Deletes the first element of an n-ary tuple+-- +-- >>> del1 ('c',False,5)+-- (False,5)+del1 :: DeleteN s 0 t => s -> t+del1 s = delN s (Proxy :: Proxy 0)+del2 :: DeleteN s 1 t => s -> t+del2 s = delN s (Proxy :: Proxy 1)+del3 :: DeleteN s 2 t => s -> t+del3 s = delN s (Proxy :: Proxy 2)+del4 :: DeleteN s 3 t => s -> t+del4 s = delN s (Proxy :: Proxy 3)+del5 :: DeleteN s 4 t => s -> t+del5 s = delN s (Proxy :: Proxy 4)+del6 :: DeleteN s 5 t => s -> t+del6 s = delN s (Proxy :: Proxy 5)+del7 :: DeleteN s 6 t => s -> t+del7 s = delN s (Proxy :: Proxy 6)+del8 :: DeleteN s 7 t => s -> t+del8 s = delN s (Proxy :: Proxy 7)+del9 :: DeleteN s 8 t => s -> t+del9 s = delN s (Proxy :: Proxy 8)+del10 :: DeleteN s 9 t => s -> t+del10 s = delN s (Proxy :: Proxy 9)++-- Currently broken. So not exported until I can properly fix it.+class FlattenT s t where+ -- | Compresses sub-tuples into their paren-tuples+ --+ -- >>> flattenT (5,6,(1,2,(3,4)))+ -- + flattenT :: s -> t++instance (GenericNP s, GenericNP t, GFlattenT (AreProducts (RepNP s)) (RepNP s) (RepNP t)) => FlattenT s t where+ flattenT = to_np . gflattenT (Proxy :: Proxy (AreProducts (RepNP s))) . from_np+ +class GFlattenT (ps :: [Bool]) s t | ps s -> t where+ gflattenT :: Proxy ps -> s -> t++instance GFlattenT '[] (NP I '[]) (NP I '[]) where+ gflattenT _ = id++instance (GenericNP x, GFlattenT (AreProducts (RepNP x)) (RepNP x) x', GFlattenT ps (NP I xs) (NP I xs'), GAppendT x' (NP I xs') (NP I xss)) => GFlattenT ('True ': ps) (NP I (x ': xs)) (NP I xss) where+ gflattenT _ (I x :* xs) = case (gflattenT (Proxy :: Proxy (AreProducts (RepNP x))) $ from_np x, gflattenT (Proxy :: Proxy ps) xs) of+ (x', xs') -> gappendT x' xs'++instance GFlattenT ps (NP I xs) (NP I xs') => GFlattenT ('False ': ps) (NP I (x ': xs)) (NP I (x ': xs')) where+ gflattenT _ (x :* xs) = x :* gflattenT (Proxy :: Proxy ps) xs++class AppendT s r t where+ -- | Appends two n-ary tuple into one larger tuple+ --+ -- >>> appendT (5,'c') ('d',False)+ -- (5,'c','d',False)+ appendT :: s -> r -> t++instance (GenericNP s, GenericNP r, GenericNP t, GAppendT (RepNP s) (RepNP r) (RepNP t)) => AppendT s r t where+ appendT s r = to_np $ gappendT (from_np s) (from_np r)++class GAppendT s r t | s r -> t where+ gappendT :: s -> r -> t++instance GAppendT (NP I '[]) ys ys where+ gappendT _ = id++instance GAppendT (NP I xs) ys (NP I zs) => GAppendT (NP I (x ': xs)) ys (NP I (x ': zs)) where+ gappendT (x :* xs) ys = x :* gappendT xs ys++class UnCurryT s t b | s -> b where+ -- | Converts a curried function to a function that works on n-ary tuples+ -- + -- >>> uncurryT (\a b c -> a + b + c) (1,2,3)+ -- 6+ uncurryT :: s -> t -> b++instance (GenericNP t, GUnCurryT s (RepNP t) b) => UnCurryT s t b where+ uncurryT f t = guncurryT f (from_np t)++class GUnCurryT s t b | s -> b where+ guncurryT :: s -> t -> b++instance b ~ b' => GUnCurryT b (NP I '[]) b' where+ guncurryT f Nil = f++instance (a ~ a', GUnCurryT c (NP I xs) b') => GUnCurryT (a -> c) (NP I (a' ': xs)) b' where+ guncurryT f (I x :* xs) = guncurryT (f x) xs++class CurryT s t | s -> t where+ -- | Converts a function that works on n-ary tuples to a curried function+ --+ -- >>> curryT (\(a,b,c) -> a + b + c) 1 2 3 :: Integer+ -- 6+ --+ -- Currently, type inference is partially broken for this function+ curryT :: s -> t ++instance (FuncToGen s (NP I xs -> b), ToFun xs b ~ t, GCurryT (NP I xs -> b) (NP I '[]) xs t) => CurryT s t where+ curryT s = gcurryT (funcToGen s) (Nil :: NP I '[]) (Proxy :: Proxy xs)++class GCurryT s d (p :: [*]) t | s d p -> t where+ gcurryT :: s -> d -> Proxy p -> t ++instance (b ~ b', ys ~ Reverse xs '[], GReverse (NP I xs) (NP I '[]) (NP I ys)) => GCurryT (NP I ys -> b) (NP I xs) '[] b' where+ gcurryT f d _ = f $ greverse d (Nil :: NP I '[])++instance (f ~ (NP I ys -> c), Head (Diff ys (Reverse xs '[])) ~ a, ToFun (Tail (Diff ys (Reverse xs '[]))) c ~ b, GCurryT f (NP I (a ': xs)) ps b) => GCurryT f (NP I xs) (a ': ps) (a -> b) where+ gcurryT t xs _ = \a -> gcurryT t (I a :* xs) (Proxy :: Proxy ps)++class GenericNP s where+ type RepNP s :: *+ from_np :: s -> RepNP s+ to_np :: RepNP s -> s++instance (Generic s, Rep s ~ SOP I '[xs], ToTuple (RepNP s) ~ s) => GenericNP s where+ type RepNP s = ToNP (Rep s)+ from_np s = gtoNP $ from s+ to_np p = to $ gfromNP p++type family ToNP s where+ ToNP (SOP I '[xs]) = NP I xs++gtoNP :: (SOP I '[xs]) -> NP I xs+gtoNP (SOP (Z np)) = np++gfromNP :: NP I xs -> SOP I '[xs]+gfromNP np = SOP $ Z np++class FuncToGen s t | s -> t where+ funcToGen :: s -> t++instance {-# OVERLAPPING #-} b ~ b' => FuncToGen b b' where+ funcToGen = id++instance {-# OVERLAPPING #-} (GenericNP a, RepNP a ~ g, FuncToGen b b') => FuncToGen (a -> b) (g -> b') where+ funcToGen f = \s -> funcToGen (f $ to_np s)++class GReverse s d t | s d -> t where+ greverse :: s -> d -> t++instance GReverse (NP I '[]) (NP I ys) (NP I ys) where+ greverse _ = id++instance GReverse (NP I xs) (NP I (a ': ys)) t => GReverse (NP I (a ': xs)) (NP I ys) t where+ greverse (a :* xs) ys = greverse xs (a :* ys)++data Nat' = Z' | S' Nat'++type family Lit (n :: Nat) :: Nat' where+ Lit 0 = Z'+ Lit n = S' (Lit (n - 1))++type family IsProductType' s where+ IsProductType' (SOP I '[xs]) = 'True+ IsProductType' _ = False++type family AreProducts s where+ AreProducts (NP I '[]) = '[]+ AreProducts (NP I (x ': xs)) = IsProductType' (Rep x) ': AreProducts (NP I xs)++type family LengthT s where+ LengthT s = GLengthT (RepNP s)++type family GLengthT s where+ GLengthT (NP I '[]) = 0+ GLengthT (NP I (a ': xs)) = 1 + GLengthT (NP I xs)++type family Applicable f s where+ Applicable f (NP I '[]) = '[]+ Applicable (a -> b) (NP I (a ': xs)) = 'True ': Applicable (a -> b) (NP I xs)+ Applicable (Poly a b) (NP I (d ': xs)) = 'True ': Applicable (Poly a b) (NP I xs)+ Applicable (a -> b) (NP I (c ': xs)) = 'False ': Applicable (a -> b) (NP I xs)++type family ApplicableN f s n where+ ApplicableN (a -> b) (NP I (a ': xs)) Z' = '[ 'True ]+ ApplicableN (Poly a b) (NP I (d ': xs)) Z' = '[ 'True ]+ ApplicableN f (NP I (a ': xs)) (S' n) = 'False ': ApplicableN f (NP I xs) n++data Poly a b where+ Poly :: (a -> b) -> Poly a b++poly :: (a -> b) -> Poly a b+poly = Poly++type family Head xs where+ Head (x ': xs) = x++type family Tail xs where+ Tail (x ': xs) = xs++type family Diff xs ys where+ Diff (x ': xs) (x ': ys) = Diff xs ys+ Diff (x ': xs) (y ': ys) = x ': xs+ Diff xs '[] = xs++type family Reverse xs ys where+ Reverse (x ': xs) ys = Reverse xs (x ': ys)+ Reverse '[] ys = ys++type family ToFun xs r where+ ToFun (a ': xs) f = a -> ToFun xs f+ ToFun '[] (a -> b) = a -> ToFun '[] b+ ToFun '[] b = b++data Rel = Nat :<= Nat | Nat :>= Nat++type family LEQ n m :: Constraint where+ LEQ n m = Relation n m ~ (n :>= m)++type family Relation n m where+ Relation n m = Relation' n m n m++type family Relation' n m i j where+ Relation' n m i 0 = n :>= m+ Relation' n m 0 j = n :<= m+ Relation' n m i j = Relation' n m (i - 1) (j - 1)++type family ToTuple s = t | t -> s where+ ToTuple (NP I '[a, b]) = (a,b)+ ToTuple (NP I '[a, b, c]) = (a,b,c)+ ToTuple (NP I '[a, b, c, d]) = (a,b,c,d)+ ToTuple (NP I '[a, b, c, d, e]) = (a,b,c,d,e)+ ToTuple (NP I '[a, b, c, d, e, f]) = (a,b,c,d,e,f)+ ToTuple (NP I '[a, b, c, d, e, f, g]) = (a,b,c,d,e,f,g)+ ToTuple (NP I '[a, b, c, d, e, f, g, h]) = (a,b,c,d,e,f,g,h)+ ToTuple (NP I '[a, b, c, d, e, f, g, h, i]) = (a,b,c,d,e,f,g,h,i)+ ToTuple (NP I '[a, b, c, d, e, f, g, h, i, j]) = (a,b,c,d,e,f,g,h,i,j)+ ToTuple (NP I '[a, b, c, d, e, f, g, h, i, j, k]) = (a,b,c,d,e,f,g,h,i,j,k)
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"
+ tuple-sop.cabal view
@@ -0,0 +1,54 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b998f09418c853e1d134628dc31b5fdcd245d1090811aa276d89cd874053d36b++name: tuple-sop+version: 0.1.0.0+synopsis: functions on n-ary tuples using generics-sop+description: Exports various functions on n-ary tuples. This library uses generics-sop to create a generic representation of n-ary product types. To regain type inference, the exported functions work only on tuples with at most 10 components.+category: Data+homepage: https://github.com/Ferdinand-vW/tuple-sop#readme+bug-reports: https://github.com/Ferdinand-vW/tuple-sop/issues+author: Ferdinand van Walree+maintainer: ferdinandvwalree@gmail.com+copyright: 2018 Ferdinand van Walree+license: GPL-3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/Ferdinand-vW/tuple-sop++library+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , generics-sop+ exposed-modules:+ Data.Tuple.Ops+ other-modules:+ Paths_tuple_sop+ default-language: Haskell2010++test-suite tuple-sop-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , generics-sop+ , tuple-sop+ other-modules:+ Paths_tuple_sop+ default-language: Haskell2010