newtype-th 0.1 → 0.2
raw patch · 4 files changed
+99/−35 lines, 4 files
Files
- Control/Newtype/TH.hs +38/−31
- README +13/−0
- Tests.hs +43/−0
- newtype-th.cabal +5/−4
Control/Newtype/TH.hs view
@@ -1,43 +1,50 @@ {-# LANGUAGE TemplateHaskell #-}-{- |-This module provides a template Haskell based mechanism for deriving-instances of the Newtype class, defined in Control.Newtype. Example usage: -> newtype CartesianList a = CartesianList [a]-> $(mkNewTypes [''CartesianList])->-> instance Monoid (CartesianList a) where-> mempty = pack [[]]-> a `mappend` b = pack [x ++ y | x <- unpack a, y <- unpack b]+-----------------------------------------------------------------------------+-- |+-- Module : Control.Newtype.TH+-- Copyright : Michael Sloan 2011+--+-- Maintainer : Michael Sloan (mgsloan@gmail.com)+-- Portability : unportable+--+-- This module provides a template Haskell based mechanism for deriving+-- instances of the Newtype class, defined in Control.Newtype. Example usage:+-- +-- > newtype CartesianList a = CartesianList [a]+-- > $(mkNewTypes [''CartesianList])+-- >+-- > instance Monoid (CartesianList a) where+-- > mempty = pack [[]]+-- > a `mappend` b = pack [x ++ y | x <- unpack a, y <- unpack b]+-- +-- > *Main> print $ underF CartesianList (\xs -> [fold xs]) ([[[4],[5],[6]], [[1],[2]], [[0]]])+-- > [[[4,1,0],[4,2,0],[5,1,0],[5,2,0],[6,1,0],[6,2,0]]] -> *Main> print $ underF CartesianList (\xs -> [fold xs]) ([[[4],[5],[6]], [[1],[2]], [[0]]])-> [[[4,1,0],[4,2,0],[5,1,0],[5,2,0],[6,1,0],[6,2,0]]]--} module Control.Newtype.TH (mkNewTypes) where -import Control.Monad (liftM)- import Language.Haskell.TH import Language.Haskell.Meta.Utils (conName, conTypes) +import Control.Newtype (Newtype(pack, unpack))+ -- | Derive instances of Newtype, specified as a list of references to newtypes. mkNewTypes :: [Name] -> Q [Dec]-mkNewTypes = liftM concat . mapM (\n -> reify n >>= return . mkInst)- where mkInst (TyConI (NewtypeD context name vs con _)) =- [InstanceD context- -- Construct the class declaration- -- "class Newtype (<newtype> a ...) (<field type> a ...) where"- (AppT (AppT (ConT $ mkName "Control.Newtype.Newtype")- $ bndrsToType (ConT name) vs)- . head $ conTypes con)- (defs (mkName "x") (conName con))]- mkInst _ = []- defs xnam cnam =- [ FunD (mkName "unpack")- [Clause [ConP cnam [VarP xnam]] (NormalB $ VarE xnam) []]- , FunD (mkName "pack")- [Clause [] (NormalB $ (ConE cnam)) []]- ]+mkNewTypes = mapM mkInst+ where+ mkInst name = fmap (mkInstH name) $ reify name+ mkInstH name (TyConI (NewtypeD context _ vs con _)) =+ -- Construct the instance declaration+ -- "instance Newtype (<newtype> a ...) (<field type> a ...) where"+ InstanceD context+ (foldl1 AppT [ConT ''Newtype, bndrsToType (ConT name) vs, head $ conTypes con])+ (defs (conName con))+ mkInstH name _ = error $ show name ++ " is not a Newtype"+ defs cname =+ [ FunD 'unpack [Clause [ConP cname [VarP xname]] (NormalB $ VarE xname) []]+ , FunD 'pack [Clause [] (NormalB (ConE cname)) []]+ ]+ xname = mkName "x" -- Given a root type and a list of type variables, converts for use as -- parameters to the newtype's type in the instance head.@@ -45,7 +52,7 @@ bndrsToType = foldl (\x y -> AppT x $ bndrToType y) -- This converts a type variable binding to a type. Preserving kind--- signatures is probably unecessary, but we might as well.+-- signatures is probably unnecessary, but we might as well. bndrToType :: TyVarBndr -> Type bndrToType (PlainTV x) = VarT x bndrToType (KindedTV x k) = SigT (VarT x) k
+ README view
@@ -0,0 +1,13 @@+http://hackage.haskell.org/package/newtype-th++Provides a template haskell based mechanism for+deriving instances of djahandarie's Control.Newtype class.++To build / install:++chmod ugo+x Setup.hs+./Setup.hs configure --user+./Setup.hs build+./Setup.hs install++See the haddock or Control/Newtype/TH.hs for documentation.
+ Tests.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DatatypeContexts, FlexibleInstances, MultiParamTypeClasses,+ KindSignatures, TemplateHaskell #-}++import Control.Newtype+import Control.Newtype.TH+import Data.Monoid+import Data.Foldable (fold)++newtype Yarn = Yarn String++newtype Occasionally a = Occasionally (Maybe a)++-- Test that 'DatatypeContexts' are used as class constraints, despite this+-- extension being deprecated.+newtype (Num a, Show b) => ShowNum a b = ShowNum { pump :: a -> b }++newtype Kinda (a :: * -> *) (b :: *) = Kinda b++newtype CartesianList a = CartesianList [[a]] deriving Show++instance Monoid (CartesianList a) where+ mempty = pack [[]]+ a `mappend` b = pack [x ++ y | x <- unpack a, y <- unpack b]++$(mkNewTypes [''Yarn, ''Occasionally, ''ShowNum , ''Kinda, ''CartesianList])++pun :: (Newtype a b, Show b) => a -> IO ()+pun = print . unpack++klift :: Int -> Kinda Maybe Int+klift = Kinda++single x = [x]++main :: IO ()+main = do+ -- Let's see if we can use them. Going to assume that pack works..+ pun $ Yarn "ball"+ pun . Occasionally $ Just "ice"+ print $ unpack (ShowNum show) 42+ pun . klift $ 5+ print $ underF CartesianList (\xs -> [fold xs])+ [[[4],[5],[6]], [[1],[2]], [[0]]]
newtype-th.cabal view
@@ -1,6 +1,6 @@ Name: newtype-th-Version: 0.1-Synopsis: Provides a template haskell deriver for use with Control.Newtype.+Version: 0.2+Synopsis: A template haskell deriver to create Control.Newtype instances. Description: Provides a template haskell based mechanism for deriving instances of djahandarie's Control.Newtype class. License: BSD3@@ -8,10 +8,11 @@ Author: Michael Sloan Maintainer: Michael Sloan <mgsloan at gmail> Homepage: http://github.com/mgsloan/newtype-th--- Copyright: +Copyright: Michael Sloan 2011 Category: Control Build-type: Simple--- Extra-source-files: +Extra-source-files: Tests.hs+Data-files: README Cabal-version: >=1.6 Bug-Reports: http://github.com/mgsloan/newtype-th/issues Source-Repository head