tuple-morph (empty) → 0.1.0.0
raw patch · 6 files changed
+347/−0 lines, 6 filesdep +HListdep +basedep +template-haskellsetup-changed
Dependencies added: HList, base, template-haskell
Files
- Data/Tuple/Morph.hs +140/−0
- Data/Tuple/Morph/Append.hs +44/−0
- Data/Tuple/Morph/TH.hs +119/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- tuple-morph.cabal +22/−0
+ Data/Tuple/Morph.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{- |+Module : Data.Tuple.Morph+Description : Morph between tuples with the same "flattened" representation.+Copyright : (c) Paweł Nowak+License : MIT++Maintainer : Paweł Nowak <pawel834@gmail.com>+Stability : provisional++Allows you to flatten, unflatten and morph tuples of matching types.++Note: by design units are ignored. For example @(Int, (), Char)@ is the same as @(Int, Char)@.+-}+module Data.Tuple.Morph (+ -- * Morphing tuples.+ morph,+ sizeLimit,++ -- * Converting between tuples and HLists.+ Rep,+ HFoldable(..),+ HUnfoldable(..),++ -- * HList parser.+ HParser(..),+ MonoidIndexedMonad(..),+ ) where++import Data.HList.HList (HList(..))+import Data.Proxy+import Data.Type.Equality++import Data.Tuple.Morph.Append+import Data.Tuple.Morph.TH++-- | Recurisvely break down a tuple type, representing it as a type list.+$(mkRep sizeLimit)++-- | Morph a tuple to some isomorphic tuple with the same order of types.+--+-- Works with arbitrary nested tuples, each tuple can have size up to 'sizeLimit'.+--+-- >>> morph ("a", ("b", "c")) :: (String, String, String)+-- ("a","b","c")+--+-- >>> morph ((1 :: Int, 2 :: Int), 3 :: Double) :: (Int, (Int, Double))+-- (1,(2,3.0))+-- +-- >>> morph ("a", (), (5 :: Int, (), "c")) :: ((), (String, Int), String)+-- ((),("a",5),"c")+--+-- >>> morph (((("a", "b"), "c"), "d"), "e") :: ((String, String), (String, (String, String)))+-- (("a","b"),("c",("d","e")))+morph :: forall a b. (HFoldable a, HUnfoldable b, Rep a ~ Rep b) => a -> b+morph = case appendRightId (Proxy :: Proxy (Rep a)) of+ Refl -> fromHList . toHList++-- | Types that can be flattened to a heterogenous list.+class HFoldable t where+ -- | Converts a structure to a heterogenous list.+ toHList :: t -> HList (Rep t)++-- | A function that parses some value @val@ with representation @rep@+-- from a heterogenous list and returns the parsed value and leftovers.+newtype HParser (rep :: [*]) val = HParser {+ -- | Run the parser.+ runHParser :: forall (leftover :: [*]). + HList (rep ++ leftover) -> (val, HList leftover) +}++-- | An indexed monad on a monoid.+class MonoidIndexedMonad (m :: k -> * -> *) where+ type Empty :: k+ type Append (x :: k) (y :: k) :: k+ returnMI :: a -> m Empty a+ bindMI :: m x a -> (a -> m y b) -> m (Append x y) b++instance MonoidIndexedMonad HParser where+ type Empty = ('[] :: [*])+ type Append x y = (x ++ y :: [*])++ returnMI a = HParser $ \r -> (a, r)++ bindMI :: forall (x :: [*]) a (y :: [*]) b.+ HParser x a -> (a -> HParser y b) -> HParser (Append x y) b+ bindMI m f = HParser $ g+ where+ g :: forall (leftover :: [*]). + HList ((Append x y) ++ leftover) -> (b, HList leftover)+ -- TODO: Explicit type application would be so nice here.+ g r0 = case appendAssoc (Proxy :: Proxy x) + (Proxy :: Proxy y)+ (Proxy :: Proxy leftover) of+ Refl -> let (a, r1) = runHParser m r0+ (b, r2) = runHParser (f a) r1+ in (b, r2)++-- | Types that can be built from a heterogenous list.+class HUnfoldable t where+ -- | Build a structure from a heterogenous list.+ fromHList :: HList (Rep t) -> t+ fromHList = case appendRightId (Proxy :: Proxy (Rep t)) of + Refl -> let parser :: HList (Rep t ++ '[]) -> (t, HList '[])+ parser = runHParser hListParser+ in fst . parser++ -- | Builds a structure from a heterogenous list and yields the leftovers.+ hListParser :: HParser (Rep t) t++-- HFoldable instances.++instance HFoldable () where+ toHList () = HNil++instance (Rep a ~ '[a]) => HFoldable a where+ toHList a = HCons a HNil++$(mapM mkHFoldableInst [2 .. sizeLimit])++-- HUnfoldable instances.++instance HUnfoldable () where+ hListParser = HParser $ \r -> ((), r)++instance (Rep a ~ '[a]) => HUnfoldable a where+ hListParser = HParser $ \(HCons a r) -> (a, r)++$(mapM mkHUnfoldableInst [2 .. sizeLimit])
+ Data/Tuple/Morph/Append.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{- |+Module : Data.Tuple.Morph.Append+Description : Appending type lists.+Copyright : (c) Paweł Nowak+License : MIT++Maintainer : Paweł Nowak <pawel834@gmail.com>+Stability : experimental++Appending type lists and HLists.+-}+module Data.Tuple.Morph.Append where++import Data.HList.HList (HList(..))+import Data.Proxy+import Data.Type.Equality+import Unsafe.Coerce++infixr 5 ++, ++@++-- | Appends two type lists.+type family (++) (a :: [k]) (b :: [k]) :: [k] where+ '[] ++ b = b+ (a ': as) ++ b = a ': (as ++ b)++-- TODO: Proofs could use some love when GHC 7.10 comes out.++-- | Proof (by unsafeCoerce) that appending is associative.+appendAssoc :: Proxy a -> Proxy b -> Proxy c+ -> ((a ++ b) ++ c) :~: (a ++ (b ++ c))+appendAssoc _ _ _ = unsafeCoerce Refl++-- | Proof (by unsafeCoerce) that '[] is a right identity of (++).+appendRightId :: Proxy a -> (a ++ '[]) :~: a+appendRightId _ = unsafeCoerce Refl++-- | Appends two HLists.+(++@) :: HList a -> HList b -> HList (a ++ b)+HNil ++@ ys = ys+(HCons x xs) ++@ ys = HCons x (xs ++@ ys)
+ Data/Tuple/Morph/TH.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE DataKinds #-}+{- |+Module : Data.Tuple.Morph.TH+Description : Template haskell used to generate instances.+Copyright : (c) Paweł Nowak+License : MIT++Maintainer : Paweł Nowak <pawel834@gmail.com>+Stability : experimental+-}+module Data.Tuple.Morph.TH (+ sizeLimit,+ mkRep,+ mkHFoldableInst,+ mkHUnfoldableInst+ ) where++import Control.Monad+import Data.Proxy+import Data.Tuple.Morph.Append+import Data.Type.Equality+import Language.Haskell.TH++-- | Generates names starting with letters of the alphabet, then+-- pairs of letters, triples of letters and so on.+mkNames :: Int -> [Name]+mkNames n = take n $ map mkName $ [1 ..] >>= flip replicateM ['a' .. 'z']++tupleFrom :: [Type] -> Type+tupleFrom vars = foldl AppT (TupleT (length vars)) vars++-- | Size of the largest tuple that this library will work with. Equal to 13.+--+-- Note that size of ((((((1, 1), 1), 1), 1), 1), 1) is 2, not 7.+sizeLimit :: Int+sizeLimit = 13++-- | Creates the "Rep" type family.+mkRep :: Int -> Q [Dec]+mkRep n = fmap (:[])+ $ closedTypeFamilyKindD (mkName "Rep")+ [(PlainTV (mkName "tuple"))] (AppT ListT StarT)+ -- Try to match tuples from biggest to smallest.+ $ map mkEqn [n, n-1 .. 2] ++ map return+ -- Match the unit after all tuples but before the base case.+ [ TySynEqn [TupleT 0] PromotedNilT+ , TySynEqn [a] (AppT (AppT PromotedConsT a) PromotedNilT)+ ]+ where+ a = VarT (mkName "a")+ repName = mkName "Rep"+ append = VarT ''(++)+ mkEqn k = do+ let names = mkNames k+ -- a, b, c, ...+ vars = map VarT names+ -- (a, b, c, ...)+ tuple = tupleFrom vars+ -- Rep a, Rep b, Rep c, ...+ reps = map (AppT (ConT repName)) vars+ -- Rep a ++ Rep b ++ Rep c ++ ...+ rep = foldr1 (\x y -> AppT (AppT append x) y) reps+ return $ TySynEqn [tuple] rep++mkInst :: Name -> Int -> ([Name] -> [Dec]) -> Dec+mkInst className k decs =+ let names = mkNames k+ tvars = map VarT names+ in InstanceD [ClassP className [tvar] | tvar <- tvars]+ (AppT (ConT className) (tupleFrom tvars))+ (decs names)++-- | Creates a HFoldable instance for @k@ element tuples.+mkHFoldableInst :: Int -> Q Dec+mkHFoldableInst k = return $ mkInst (mkName "HFoldable") k $ \names ->+ let toHListName = mkName "toHList"+ -- pattern (a, b, c, ...)+ tupleP = TupP $ map VarP names+ -- toHList a, toHList b, toHList c, ...+ hlists = map (\n -> AppE (VarE toHListName) (VarE n)) names+ -- toHList a ++@ toHList b ++@ toHList c ++@ ...+ body = NormalB $ foldr1 (\x y -> AppE (AppE (VarE '(++@)) x) y) hlists+ toHList = FunD toHListName [Clause [tupleP] body []]+ in [toHList]++-- | Creates a HUnfoldable instance for @k@ element tuples.+mkHUnfoldableInst :: Int -> Q Dec+mkHUnfoldableInst k = return $ mkInst (mkName "HUnfoldable") k $ \names ->+ let hListParserName = mkName "hListParser"+ repName = mkName "Rep"+ bindMIName = mkName "bindMI"+ returnMIName = mkName "returnMI"++ -- Proxy :: Proxy (Rep z)+ proxy = SigE (ConE 'Proxy)+ (AppT (ConT ''Proxy)+ (AppT (ConT repName)+ (VarT $ last names)))++ -- appendRightId proxy+ theorem = AppE (VarE 'appendRightId) proxy++ -- bindMI hListParser (\a ->+ -- bindMI hListParser (\b ->+ -- ...+ -- returnMI (a, b, c, ...))...)+ bindE n e = AppE (AppE (VarE bindMIName)+ (VarE hListParserName))+ (LamE [VarP n] e)+ returnE = (AppE (VarE returnMIName) (TupE (map VarE names)))++ matchBody = NormalB $ foldr bindE returnE names++ -- case theorem of Refl -> ???+ body = NormalB $ CaseE theorem [Match (ConP 'Refl []) matchBody []]+ hListParser = FunD hListParserName [Clause [] body []]+ in [hListParser]
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Paweł Nowak++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ tuple-morph.cabal view
@@ -0,0 +1,22 @@+name: tuple-morph+version: 0.1.0.0+synopsis: Morph between tuples with the same "flattened" representation+description: Morph between tuples with the same "flattened" representation. Convert+ tuples from an to heterogenous lists.+ .+ See "Data.Tuple.Morph".+license: MIT+license-file: LICENSE+author: Paweł Nowak+maintainer: Paweł Nowak <pawel834@gmail.com>+copyright: Paweł Nowak 2014+category: Data+build-type: Simple+cabal-version: >=1.10++library+ exposed-modules: Data.Tuple.Morph+ Data.Tuple.Morph.Append+ other-modules: Data.Tuple.Morph.TH+ build-depends: base <5, HList, template-haskell+ default-language: Haskell2010