tuple-ops 0.0.0.1 → 0.0.0.2

raw patch · 5 files changed

+144/−23 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Data/Tuple/Ops.hs +3/−1
• src/Data/Tuple/Ops/Cons.hs +120/−0
• src/Data/Tuple/Ops/Internal.hs +5/−2
• src/Data/Tuple/Ops/Uncons.hs +10/−18
• tuple-ops.cabal +6/−2

@@ -14,11 +14,13 @@ {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StandaloneDeriving #-}
 module Data.Tuple.Ops(
-    module Data.Tuple.Ops.Uncons
+    module Data.Tuple.Ops.Uncons,
+    module Data.Tuple.Ops.Cons 
 ) where
 
 import GHC.Generics
 import Data.Tuple.Ops.Uncons 
+import Data.Tuple.Ops.Cons 
 
 deriving instance Generic Int
 deriving instance Generic Word

@@ -0,0 +1,120 @@+------------------------------------------------------------
+-- |
+-- Module      :  Data.Tuple.Ops.Cons
+-- Description :  various operations on n-ary tuples via GHC.Generics
+-- Copyright   :  (c) 2018 Jiasen Wu
+-- License     :  BSD-style (see the file LICENSE)
+-- Maintainer  :  Jiasen Wu <jiasenwu@hotmail.com>
+-- Stability   :  experimental
+-- Portability :  portable
+--
+--
+-- This module define 'cons'. Examples are given below:
+--
+-- >>> cons (1::Int) ()
+-- 1
+--
+-- >>> cons (1::Int) 'a'
+-- (1,'a')
+--
+-- >>> cons (True,'a') "S"
+-- ((True,'a'),"S")
+--
+-- >>> cons "S" (True,'a')
+-- ("S",True,'a')
+--
+------------------------------------------------------------
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Data.Tuple.Ops.Cons (cons, Cons, Consable) where
+
+import GHC.Generics (Generic(..), (:*:)(..), (:+:)(..), URec, Rec0, C1, D1, S1, M1(..), U1, K1(..))
+import GHC.TypeLits (Symbol)
+import Type.Family.List
+import Data.Tuple.Ops.Internal
+
+-- | Abstract type class for generic representation of a /cons/able datatype
+class ConsableR va rb where
+    -- | @consR@ takes a value of type @va@ and a value of type @vb@ together @vb@'s representation,
+    -- returns the cons'ed value. Note that, 'ConsableR' is inductively scrutinize @vb@'s 
+    -- representation, however this representation is only a dummy argument, since the result is
+    -- constructed from the value directly.
+    consR :: (Generic vb, Rep vb ~ D1 (MetaOfD1 (Rep vb)) rb) => va -> vb -> rb x -> ConsR va rb vb x
+
+-- | Type function to calculate the type of cons'ed value
+type family ConsR va rb vb where
+    ConsR va (C1 mc U1) vb = UnD1 (Rep va)
+    ConsR va (C1 mc (S1 ms (URec b))) vb = RepOfTuple "(,)" (S1 MetaS (Rec0 va) :*: S1 MetaS (Rec0 vb))
+    ConsR va (b0 :+: b1) vb = RepOfTuple "(,)" (S1 MetaS (Rec0 va) :*: S1 MetaS (Rec0 vb))
+    ConsR va (RepOfTuple tcon (b0 :*: b1)) vb = RepOfTuple (TupleConSucc tcon) (N (L (S1 MetaS (Rec0 va) :*: b0 :*: b1)))
+
+instance (Generic a, Rep a ~ D1 (MetaOfD1 (Rep a)) (UnD1 (Rep a))) => ConsableR a (C1 mc U1) where
+    consR a _ _ = unM1 $ from a
+
+instance ConsableR va (C1 mc (S1 ms (URec b))) where
+    consR a b _ = M1 (M1 (K1 a) :*: M1 (K1 b))
+
+instance ConsableR va (b0 :+: b1) where
+    consR a b _ = M1 (M1 (K1 a) :*: M1 (K1 b))
+
+instance (Linearize b0, Linearize b1, 
+          Normalize ((S1 MetaS (Rec0 va) :< L b0 ++ L b1)), 
+          AppDistributive (L b0)) => ConsableR va (RepOfTuple tcon (b0 :*: b1)) where
+    consR a b _ = M1 $ normalize $ linearize $ (M1 (K1 a) :: S1 MetaS (Rec0 va) x) :*: unM1 (unM1 (from b))
+
+-- | calculate the tuple constructor of the size 1 bigger
+-- upto the tupel of arity of 15
+type family TupleConSucc (a :: Symbol) where
+    TupleConSucc "(,)" = "(,,)"
+    TupleConSucc "(,,)" = "(,,,)"
+    TupleConSucc "(,,,)" = "(,,,,)"
+    TupleConSucc "(,,,,)" = "(,,,,,)"
+    TupleConSucc "(,,,,,)" = "(,,,,,,)"
+    TupleConSucc "(,,,,,,)" = "(,,,,,,,)"
+    TupleConSucc "(,,,,,,,)" = "(,,,,,,,,)"
+    TupleConSucc "(,,,,,,,,)" = "(,,,,,,,,,)"
+    TupleConSucc "(,,,,,,,,,)" = "(,,,,,,,,,,)"
+    TupleConSucc "(,,,,,,,,,,)" = "(,,,,,,,,,,,)"
+    TupleConSucc "(,,,,,,,,,,,)" = "(,,,,,,,,,,,,)"
+    TupleConSucc "(,,,,,,,,,,,,)" = "(,,,,,,,,,,,,,)"
+    TupleConSucc "(,,,,,,,,,,,,,)" = "(,,,,,,,,,,,,,,)"
+    TupleConSucc "(,,,,,,,,,,,,,,)" = "(,,,,,,,,,,,,,,,)"
+    TupleConSucc "(,,,,,,,,,,,,,,,)" = "(,,,,,,,,,,,,,,,,)"
+
+-- | calculate the result type of 'cons'
+type family Cons a b where
+    Cons z (a,b) = (z,a,b)
+    Cons z (a,b,c) = (z,a,b,c)
+    Cons z (a,b,c,d) = (z,a,b,c,d)
+    Cons z (a,b,c,d,e) = (z,a,b,c,d,e)
+    Cons z (a,b,c,d,e,f) = (z,a,b,c,d,e,f)
+    Cons z (a,b,c,d,e,f,g) = (z,a,b,c,d,e,f,g)
+    Cons z (a,b,c,d,e,f,g,h) = (z,a,b,c,d,e,f,g,h)
+    Cons z (a,b,c,d,e,f,g,h,i) = (z,a,b,c,d,e,f,g,h,i)
+    Cons z (a,b,c,d,e,f,g,h,i,j) = (z,a,b,c,d,e,f,g,h,i,j)
+    Cons z (a,b,c,d,e,f,g,h,i,j,k) = (z,a,b,c,d,e,f,g,h,i,j,k)
+    Cons z (a,b,c,d,e,f,g,h,i,j,k,l) = (z,a,b,c,d,e,f,g,h,i,j,k,l)
+    Cons z (a,b,c,d,e,f,g,h,i,j,k,l,m) = (z,a,b,c,d,e,f,g,h,i,j,k,l,m)
+    Cons z (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = (z,a,b,c,d,e,f,g,h,i,j,k,l,m,n)
+    Cons z (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = (z,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
+    Cons z () = z
+    Cons z a  = (z,a)
+
+-- | A constraint on any 'cons'able data type, where
+-- @a@ and @b@ are the input, and @c@ is the output.
+type Consable a b c = (Generic a, Generic b, Generic c, Cons a b ~ c, 
+                       Rep b ~ D1 (MetaOfD1 (Rep b)) (UnD1 (Rep b)), 
+                       Rep c ~ D1 (MetaOfD1 (Rep c)) (UnD1 (Rep c)),
+                       ConsableR a (UnD1 (Rep b)), 
+                       ConsR a (UnD1 (Rep b)) b ~ (UnD1 (Rep c)))
+
+-- | 'cons' takes two datatype, and produces a tuple of them.
+-- if @b@ is unit, then @a@ is returned.
+-- if @b@ is not a tuple, then a pair of @(a,b)@ is returned.
+-- otherwise, @a@ is placed in front of @b@.
+cons :: Consable a b c => a -> b -> c
+cons a b = to $ M1 $ consR a b (unM1 $ from b)

@@ -19,7 +19,7 @@ 
 module Data.Tuple.Ops.Internal where
 
-import GHC.Generics ((:*:)(..), Rec0, D1, S1, Meta(..), SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..))
+import GHC.Generics ((:*:)(..), Rec0, C1, D1, S1, Meta(..), SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..), FixityI(..))
 import Data.Proxy
 import Data.Type.Combinator
 import Data.Type.Product
@@ -143,4 +143,7 @@     UnD1 (D1 _ t) = t
 -- | utility type function to extract the meta information
 type family MetaOfD1 t where
-    MetaOfD1 (D1 m _) = m+    MetaOfD1 (D1 m _) = m
+
+-- | representation of a tuple of arity > 2, in which @/u/@ is of the form @_ :*: _@
+type RepOfTuple c u = C1 ('MetaCons c 'PrefixI 'False) u 

@@ -34,38 +34,33 @@ import Type.Family.Nat (N1)
 import Data.Tuple.Ops.Internal
 
--- | representation of a pair
-type RepOfPair t1 t2 = C1 ('MetaCons "(,)" 'PrefixI 'False) (S1 MetaS (Rec0 t1) :*: S1 MetaS (Rec0 t2))
--- | representation of a tuple of arity > 2, in which @/u/@ is of the form @_ :*: _@
-type RepOfTuple c u = C1 ('MetaCons c 'PrefixI 'False) u 
-
 -- | 'HeadR' is a type function that takes the first element of a tuple
 type family HeadR (f :: * -> *) :: * -> * where
     HeadR (C1 mc (S1 ms (URec a))) = C1 mc (S1 ms (URec a))
     HeadR (a :+: b) = a :+: b
-    HeadR (RepOfPair t1 t2) = UnD1 (Rep t1)
-    HeadR (RepOfTuple tcon (a :*: b :*: c)) = UnD1 (Rep (UnRec0 (UnS1 (N (T N1 (L (a :*: b :*: c)))))))
+    HeadR (RepOfTuple "(,)" (S1 MetaS (Rec0 a) :*: S1 MetaS (Rec0 b))) = UnD1 (Rep a)
+    HeadR (RepOfTuple tcon  (a :*: b :*: c)) = UnD1 (Rep (UnRec0 (UnS1 (N (T N1 (L (a :*: b :*: c)))))))
 -- | 'TailR' is a type function that drops the first element of a tuple
 type family TailR (f :: * -> *) :: * -> * where
     TailR (C1 mc (S1 ms (URec a))) = C1 ('MetaCons "()" 'PrefixI 'False) U1
     TailR (a :+: b) = C1 ('MetaCons "()" 'PrefixI 'False) U1
-    TailR (RepOfPair t1 t2) = UnD1 (Rep t2)
-    TailR (RepOfTuple tcon (a :*: b :*: c)) = RepOfTuple (TupleConPred tcon) (N (D N1 (L (a :*: b :*: c))))
+    TailR (RepOfTuple "(,)" (S1 MetaS (Rec0 a) :*: S1 MetaS (Rec0 b))) = UnD1 (Rep b)
+    TailR (RepOfTuple tcon  (a :*: b :*: c)) = RepOfTuple (TupleConPred tcon) (N (D N1 (L (a :*: b :*: c))))
 
 -- | Abstract type class for generic representation of a /uncons/able datatype
-class UnconsR f where
+class UnconsableR f where
     unconsR :: f a -> (HeadR f a, TailR f a)
 
 -- | primitive datatype
 -- 'HeadR' is the datatype itself
 -- 'TailR' is ()
-instance UnconsR (C1 mc (S1 ms (URec a))) where
+instance UnconsableR (C1 mc (S1 ms (URec a))) where
     unconsR a = (a, unM1 (from ()))
 
 -- | sum datatype
 -- 'HeadR' is the datatype itself
 -- 'TailR' is ()
-instance UnconsR (a :+: b) where
+instance UnconsableR (a :+: b) where
     unconsR a = (a, unM1 (from ()))
 
 -- | pair
@@ -73,7 +68,7 @@ -- 'TailR' is the second element
 instance (Generic t1, Rep t1 ~ D1 mt1 ct1,
           Generic t2, Rep t2 ~ D1 mt2 ct2)
-    => UnconsR (RepOfPair t1 t2) where
+    => UnconsableR (RepOfTuple "(,)" (S1 MetaS (Rec0 t1) :*: S1 MetaS (Rec0 t2))) where
     unconsR (M1 (a :*: b)) = (unM1 $ from $ unK1 $ unM1 a, unM1 $ from $ unK1 $ unM1 b)
 
 -- | tuple of arity > 2
@@ -81,15 +76,12 @@ -- 'TailR' is the rest all elements
 instance (Linearize (a :*: b :*: c), L (a :*: b :*: c) ~ (S1 MetaS (Rec0 t) : w), 
           Generic t, Rep t ~ D1 hm hc, Normalize w) 
-    => UnconsR (RepOfTuple tcon (a :*: b :*: c)) where
+    => UnconsableR (RepOfTuple tcon (a :*: b :*: c)) where
     unconsR a = let tup = linearize (unM1 a)
                     one = Proxy :: Proxy N1
                     h = unM1 $ from $ unK1 $ unM1 $ normalize $ take' one tup
                     t = M1 $ normalize $ drop' one tup
                 in (h, t)
-    -- unconsR a = case linearize (unM1 a) of
-    --               (TupleR (u :< v) :: TupleR (S1 MetaS (Rec0 t) : w) x) -> 
-    --                 (unM1 $ from $ (unK1 (unM1 (getI u)) :: t), M1 $ normalize $ (TupleR v :: TupleR w x))
 
 -- | calculate the tuple constructor of the size 1 smaller
 -- upto the tupel of arity of 16
@@ -135,7 +127,7 @@                          Rep a ~ D1 (MetaOfD1 (Rep a)) (UnD1 (Rep a)), 
                          Rep b ~ D1 (MetaOfD1 (Rep b)) (UnD1 (Rep b)), 
                          Rep c ~ D1 (MetaOfD1 (Rep c)) (UnD1 (Rep c)),
-                         UnconsR (UnD1 (Rep a)), 
+                         UnconsableR (UnD1 (Rep a)), 
                          HeadR (UnD1 (Rep a)) ~ (UnD1 (Rep b)), 
                          TailR (UnD1 (Rep a)) ~ (UnD1 (Rep c)))
 

@@ -1,11 +1,14 @@ name:                       tuple-ops
-version:                    0.0.0.1
+version:                    0.0.0.2
 category:                   Data
 author:                     Jiasen Wu
 maintainer:                 Jiasen Wu <jiasenwu@hotmail.com>
 homepage:                   https://github.com/pierric/tuple-ops
 synopsis:                   various operations on n-ary tuples via GHC.Generics
-description:                Uncons operation on n-ary tuples
+description:                Some operations on n-ary tuples, including 'uncons', 'cons', etc. This package distinguish itself from other packages
+                            on tuple mainly on the the implementation under the cover. It converts Generic datatype into the its representation 
+                            form, and carries out the operations on there.  The other point is that this package tends to treat non-tuples directly as
+                            1-ary, without need of 'OneTuple' or similar intermediate wrapper.
 license:                    BSD3
 license-file:               LICENSE
 build-type:                 Simple
@@ -15,6 +18,7 @@     hs-source-dirs:         src
     exposed-modules:        Data.Tuple.Ops
                           , Data.Tuple.Ops.Uncons
+                          , Data.Tuple.Ops.Cons
                           , Data.Tuple.Ops.Internal
     default-language:       Haskell2010
     default-extensions:     DataKinds