mirror of
https://github.com/ilyakooo0/tuple-morph.git
synced 2024-10-05 13:47:09 +03:00
The first version.
This commit is contained in:
commit
ea14af1e64
47
.gitignore
vendored
Normal file
47
.gitignore
vendored
Normal file
@ -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/
|
||||
|
150
Data/Tuple/Morph.hs
Normal file
150
Data/Tuple/Morph.hs
Normal file
@ -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 <pawel834@gmail.com>
|
||||
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)
|
||||
|
||||
|
||||
|
20
LICENSE
Normal file
20
LICENSE
Normal file
@ -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.
|
17
tuple-morph.cabal
Normal file
17
tuple-morph.cabal
Normal file
@ -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 <pawel834@gmail.com>
|
||||
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
|
Loading…
Reference in New Issue
Block a user