product-isomorphic (empty) → 0.0.1.0
raw patch · 10 files changed
+331/−0 lines, 10 filesdep +basedep +template-haskelldep +th-data-compatsetup-changed
Dependencies added: base, template-haskell, th-data-compat
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- product-isomorphic.cabal +45/−0
- src/Data/Functor/ProductIsomorphic.hs +20/−0
- src/Data/Functor/ProductIsomorphic/Class.hs +37/−0
- src/Data/Functor/ProductIsomorphic/Instances.hs +71/−0
- src/Data/Functor/ProductIsomorphic/TH.hs +20/−0
- src/Data/Functor/ProductIsomorphic/TH/Internal.hs +65/−0
- src/Data/Functor/ProductIsomorphic/TupleInstances.hs +23/−0
- src/Data/Functor/ProductIsomorphic/Unsafe.hs +18/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Kei Hibino++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Kei Hibino nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ product-isomorphic.cabal view
@@ -0,0 +1,45 @@+name: product-isomorphic+version: 0.0.1.0+synopsis: Weaken applicative functor on products+description: Weaken applicative functor which allows only product+ construction. Product constructions and deconstructions+ are always isomorphic.+homepage: http://github.com/khibino/haskell-product-isomorphic+license: BSD3+license-file: LICENSE+author: Kei Hibino+maintainer: ex8k.hibino@gmail.com+copyright: Copyright (c) 2017 Kei Hibino+category: Data+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ exposed-modules:+ Data.Functor.ProductIsomorphic.Class+ Data.Functor.ProductIsomorphic.Instances+ Data.Functor.ProductIsomorphic.TupleInstances+ Data.Functor.ProductIsomorphic.Unsafe+ Data.Functor.ProductIsomorphic++ Data.Functor.ProductIsomorphic.TH++ other-modules:+ Data.Functor.ProductIsomorphic.TH.Internal++ build-depends: base <5+ , template-haskell+ , th-data-compat+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+++source-repository head+ type: git+ location: https://github.com/khibino/haskell-product-isomorphic++source-repository head+ type: mercurial+ location: https://bitbucket.org/khibino/haskell-product-isomorphic
+ src/Data/Functor/ProductIsomorphic.hs view
@@ -0,0 +1,20 @@+-- |+-- Module : Data.Functor.ProductIsomorphic+-- Copyright : 2017 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This is the integrated interface module for product restricted functors.+module Data.Functor.ProductIsomorphic+ ( module Data.Functor.ProductIsomorphic.Unsafe+ , module Data.Functor.ProductIsomorphic.Class+ , module Data.Functor.ProductIsomorphic.Instances+ ) where++import Data.Functor.ProductIsomorphic.Unsafe (ProductConstructor)+import Data.Functor.ProductIsomorphic.Class+import Data.Functor.ProductIsomorphic.Instances+import Data.Functor.ProductIsomorphic.TupleInstances ()
+ src/Data/Functor/ProductIsomorphic/Class.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module : Data.Functor.ProductIsomorphic.Class+-- Copyright : 2017 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This module defines functor interfaces which morphed functions+-- are restricted to products.+module Data.Functor.ProductIsomorphic.Class+ ( ProductIsoFunctor (..)+ , ProductIsoApplicative (..)+ , ProductIsoAlternative (..)+ ) where++import Data.Functor.ProductIsomorphic.Unsafe (ProductConstructor)++-- | Restricted functor on products.+class ProductIsoFunctor f where+ (|$|) :: ProductConstructor (a -> b) => (a -> b) -> f a -> f b++-- | Restricted applicative functor on products.+class ProductIsoFunctor f => ProductIsoApplicative f where+ pureP :: ProductConstructor a => a -> f a+ (|*|) :: f (a -> b) -> f a -> f b++-- | Restricted alternative on products.+class ProductIsoApplicative f => ProductIsoAlternative f where+ emptyP :: f a+ (|||) :: f a -> f a -> f a++infixl 4 |$|, |*|+infixl 3 |||
+ src/Data/Functor/ProductIsomorphic/Instances.hs view
@@ -0,0 +1,71 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module : Data.Functor.ProductIsomorphic.Instances+-- Copyright : 2017 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This module defines functor instances morphed functions+-- are restricted to products.+module Data.Functor.ProductIsomorphic.Instances+ ( WrappedFunctor (..)+ , WrappedAlter (..)+ ) where++import Data.Monoid (Monoid, mempty, (<>))+import Control.Applicative+ ((<$>), Applicative, pure, (<*>),+ Alternative, empty, (<|>),+ Const (..))++import Data.Functor.ProductIsomorphic.Class+ (ProductIsoFunctor(..), ProductIsoApplicative (..), ProductIsoAlternative (..))+++instance ProductIsoFunctor (Const a) where+ _ |$| Const a = Const a+ {-# INLINABLE (|$|) #-}++instance Monoid a => ProductIsoApplicative (Const a) where+ pureP _ = Const mempty+ {-# INLINABLE pureP #-}+ Const a |*| Const b = Const $ a <> b+ {-# INLINABLE (|*|) #-}+++-- | Wrapped functor type to make instances of product-iso functors.+newtype WrappedFunctor f a = WrapFunctor { unwrapFunctor :: f a }++instance Functor f => ProductIsoFunctor (WrappedFunctor f) where+ f |$| fa = WrapFunctor $ f <$> unwrapFunctor fa+ {-# INLINABLE (|$|) #-}++instance Applicative f => ProductIsoApplicative (WrappedFunctor f) where+ pureP = WrapFunctor . pure+ {-# INLINABLE pureP #-}+ WrapFunctor ff |*| WrapFunctor fa = WrapFunctor $ ff <*> fa+ {-# INLINABLE (|*|) #-}++instance Alternative f => ProductIsoAlternative (WrappedFunctor f) where+ emptyP = WrapFunctor empty+ {-# INLINABLE emptyP #-}+ WrapFunctor fa1 ||| WrapFunctor fa2 = WrapFunctor $ fa1 <|> fa2+ {-# INLINABLE (|||) #-}+++-- | Wrapped Const Alternative objects to make instances like Const functor.+newtype WrappedAlter f a b = WrapAlter { unWrapAlter :: Const (f a) b }++instance ProductIsoFunctor (WrappedAlter f a) where+ _ |$| WrapAlter (Const fa) = WrapAlter $ Const fa+ {-# INLINABLE (|$|) #-}++instance Alternative f => ProductIsoApplicative (WrappedAlter f a) where+ pureP _ = WrapAlter $ Const empty+ {-# INLINABLE pureP #-}+ WrapAlter (Const a) |*| WrapAlter (Const b) = WrapAlter $ Const $ a <|> b+ {-# INLINABLE (|*|) #-}
+ src/Data/Functor/ProductIsomorphic/TH.hs view
@@ -0,0 +1,20 @@+-- |+-- Module : Data.Functor.ProductIsomorphic.TH+-- Copyright : 2017 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This module exports templates to make product constructors.+module Data.Functor.ProductIsomorphic.TH (+ -- * Template of ProductConstructor+ defineProductConstructor, defineTupleProductConstructor,++ -- * Low-level API to get record info+ reifyRecordType,+ ) where++import Data.Functor.ProductIsomorphic.TH.Internal+ (defineProductConstructor, defineTupleProductConstructor, reifyRecordType, )
+ src/Data/Functor/ProductIsomorphic/TH/Internal.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}++-- |+-- Module : Data.Functor.ProductIsomorphic.TH.Internal+-- Copyright : 2017 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This module defines templates to make product constructors.+module Data.Functor.ProductIsomorphic.TH.Internal (+ defineProductConstructor, defineTupleProductConstructor,++ reifyRecordType,+ ) where++import Language.Haskell.TH+ (Q, Name, tupleTypeName, Info (..), reify,+ TypeQ, arrowT, appT, conT, varT,+ Dec, ExpQ, conE, Con (..), TyVarBndr (..), )+import Language.Haskell.TH.Compat.Data (unDataD)+import Data.List (foldl')++import Data.Functor.ProductIsomorphic.Unsafe (ProductConstructor (..))+++recordInfo' :: Info -> Maybe ((TypeQ, ExpQ), (Maybe [Name], [TypeQ]))+recordInfo' = d where+ d (TyConI tcon) = do+ (_cxt, tcn, bs, _mk, [r], _ds) <- unDataD tcon+ case r of+ NormalC dcn ts -> Just ((buildT tcn bs, conE dcn), (Nothing, [return t | (_, t) <- ts]))+ RecC dcn vts -> Just ((buildT tcn bs, conE dcn), (Just ns, ts))+ where (ns, ts) = unzip [(n, return t) | (n, _, t) <- vts]+ _ -> Nothing+ d _ = Nothing+ getTV (PlainTV n) = n+ getTV (KindedTV n _) = n+ buildT tcn bs = foldl' appT (conT tcn) [ varT $ getTV b | b <- bs]++-- | Low-level reify interface for record type name.+reifyRecordType :: Name -> Q ((TypeQ, ExpQ), (Maybe [Name], [TypeQ]))+reifyRecordType recTypeName =+ maybe+ (fail $ "Defined record type constructor not found: " ++ show recTypeName)+ return+ . recordInfo' =<< reify recTypeName++-- | Make template of ProductConstructor instance from type constructor name.+defineProductConstructor :: Name -- ^ name of product or record type constructor+ -> Q [Dec] -- ^ result template+defineProductConstructor tyN = do+ ((tyQ, dtQ), (_, colts)) <- reifyRecordType tyN+ [d| instance ProductConstructor $(foldr (appT . (arrowT `appT`)) tyQ colts) where+ productConstructor = $(dtQ)+ |]++-- | Make template of ProductConstructor instance of tuple type.+defineTupleProductConstructor :: Int -- ^ n-tuple+ -> Q [Dec] -- ^ result template+defineTupleProductConstructor =+ defineProductConstructor . tupleTypeName
+ src/Data/Functor/ProductIsomorphic/TupleInstances.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module : Data.Functor.ProductIsomorphic.TupleInstances+-- Copyright : 2017 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This module defines instances of tuple types.+module Data.Functor.ProductIsomorphic.TupleInstances () where++import Control.Applicative ((<$>))++import Data.Functor.ProductIsomorphic.TH.Internal+ (defineTupleProductConstructor)+++$(concat <$> mapM defineTupleProductConstructor [2..7])
+ src/Data/Functor/ProductIsomorphic/Unsafe.hs view
@@ -0,0 +1,18 @@+-- |+-- Module : Data.Functor.ProductIsomorphic.Unsafe+-- Copyright : 2017 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This module defines unsafe class interfaces.+module Data.Functor.ProductIsomorphic.Unsafe+ ( ProductConstructor (..)+ ) where++-- | Define product isomorphic inference rule+-- to specify record constructor+class ProductConstructor c where+ productConstructor :: c