commit ea14af1e643dc76cded56d2341b3e9f338d88f79 Author: Paweł Nowak Date: Fri Nov 21 20:58:45 2014 +0100 The first version. diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..79257ef --- /dev/null +++ b/.gitignore @@ -0,0 +1,47 @@ +# Created by https://www.gitignore.io + +### Haskell ### +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +.virtualenv +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +cabal.config + + +### Emacs ### +# -*- mode: gitignore; -*- +*~ +\#*\# +/.emacs.desktop +/.emacs.desktop.lock +*.elc +auto-save-list +tramp +.\#* + +# Org-mode +.org-id-locations +*_archive + +# flymake-mode +*_flymake.* + +# eshell files +/eshell/history +/eshell/lastdir + +# elpa packages +/elpa/ + +# reftex files +*.rel + +# AUCTeX auto folder +/auto/ + diff --git a/Data/Tuple/Morph.hs b/Data/Tuple/Morph.hs new file mode 100644 index 0000000..941a561 --- /dev/null +++ b/Data/Tuple/Morph.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{- | +Module : Data.Tuple.Morph +Description : Morph isomorphic tuples. +Copyright : (c) Paweł Nowak +License : MIT + +Maintainer : Paweł Nowak +Stability : experimental + +Allows you to flatten, unflatten and morph tuples of matching types. +-} +module Data.Tuple.Morph ( + morph, + Rep, + HFoldable(..), + HUnfoldable(..), + HParser(..) + ) where + +import Data.HList.HList (HList(..)) +import Data.Proxy +import Data.Type.Equality +import Unsafe.Coerce + +-- | Morph a tuple to some isomorphic tuple. +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 + +-- | Recurisvely break down a tuple, representing it as a type list. +type family Rep (a :: *) :: [*] where + Rep (a, b, c, d, e) = Rep a ++ Rep b ++ Rep c ++ Rep d ++ Rep e + Rep (a, b, c, d) = Rep a ++ Rep b ++ Rep c ++ Rep d + Rep (a, b, c) = Rep a ++ Rep b ++ Rep c + Rep (a, b) = Rep a ++ Rep b + Rep () = '[] + Rep a = '[a] + +-- | 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 leftover. +newtype HParser rep val = HParser { + -- | Run the parser. + runHParser :: forall (leftover :: [*]). + HList (rep ++ leftover) -> (val, HList leftover) +} + +-- | 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 + + +type family (++) (a :: [*]) (b :: [*]) :: [*] where + '[] ++ b = b + (a ': as) ++ b = a ': (as ++ b) + +appendAssoc :: Proxy a -> Proxy b -> Proxy c + -> ((a ++ b) ++ c) :~: (a ++ (b ++ c)) +appendAssoc _ _ _ = unsafeCoerce Refl + +appendRightId :: Proxy a -> (a ++ '[]) :~: a +appendRightId _ = unsafeCoerce Refl + +(++@) :: HList a -> HList b -> HList (a ++ b) +HNil ++@ ys = ys +(HCons x xs) ++@ ys = HCons x (xs ++@ ys) + + + +instance (HFoldable a, HFoldable b, HFoldable c, HFoldable d, HFoldable e) => HFoldable (a, b, c, d, e) where + toHList (a, b, c, d, e) = toHList a ++@ toHList b ++@ toHList c ++@ toHList d ++@ toHList e + +instance (HFoldable a, HFoldable b, HFoldable c, HFoldable d) => HFoldable (a, b, c, d) where + toHList (a, b, c, d) = toHList a ++@ toHList b ++@ toHList c ++@ toHList d + +instance (HFoldable a, HFoldable b, HFoldable c) => HFoldable (a, b, c) where + toHList (a, b, c) = toHList a ++@ toHList b ++@ toHList c + +instance (HFoldable a, HFoldable b) => HFoldable (a, b) where + toHList (a, b) = toHList a ++@ toHList b + +instance HFoldable () where + toHList () = HNil + +instance (Rep a ~ '[a]) => HFoldable a where + toHList a = HCons a HNil + +returnWTF :: a -> HParser '[] a +returnWTF a = HParser $ \r -> (a, r) + +(>>>=) :: forall (a :: *) (aRep :: [*]) (b :: *) (bRep :: [*]). + HParser aRep a -> (a -> HParser bRep b) -> HParser (aRep ++ bRep) b +m >>>= f = HParser g + where + g :: forall (leftover :: [*]). + HList (aRep ++ bRep ++ leftover) -> (b, HList leftover) + g r0 = case appendAssoc (Proxy :: Proxy aRep) + (Proxy :: Proxy bRep) + (Proxy :: Proxy leftover) of + Refl -> let (a, r1) = runHParser m r0 + (b, r2) = runHParser (f a) r1 + in (b, r2) + +instance (HUnfoldable a, HUnfoldable b, HUnfoldable c, HUnfoldable d) => HUnfoldable (a, b, c, d) where + hListParser = case appendRightId (Proxy :: Proxy (Rep d)) of + Refl -> hListParser >>>= (\(a, b, c) -> + hListParser >>>= (\d -> + returnWTF (a, b, c, d))) + +instance (HUnfoldable a, HUnfoldable b, HUnfoldable c) => HUnfoldable (a, b, c) where + hListParser = case appendRightId (Proxy :: Proxy (Rep c)) of + Refl -> hListParser >>>= (\(a, b) -> + hListParser >>>= (\c -> + returnWTF (a, b, c))) + +instance (HUnfoldable a, HUnfoldable b) => HUnfoldable (a, b) where + hListParser = case appendRightId (Proxy :: Proxy (Rep b)) of + Refl -> hListParser >>>= (\a -> + hListParser >>>= (\b -> + returnWTF (a, b))) + +instance (Rep a ~ '[a]) => HUnfoldable a where + hListParser = HParser $ \(HCons a r) -> (a, r) + +instance HUnfoldable () where + hListParser = HParser $ \r -> ((), r) + + + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d57e6ec --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tuple-morph.cabal b/tuple-morph.cabal new file mode 100644 index 0000000..b365337 --- /dev/null +++ b/tuple-morph.cabal @@ -0,0 +1,17 @@ +name: tuple-morph +version: 0.1.0.0 +synopsis: Morph between isomorphic tuples. Convert tuples from an to heterogenous lists. +-- description: +license: MIT +license-file: LICENSE +author: Paweł Nowak +maintainer: Paweł Nowak +copyright: Paweł Nowak 2014 +category: Data +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Data.Tuple.Morph + build-depends: base <5, HList + default-language: Haskell2010 \ No newline at end of file