type-spine 0.2 → 0.2.20120924

raw patch · 3 files changed

+7/−7 lines, 3 files

Files

• Type/Spine/Base.hs +2/−2
• Type/Spine/TH.hs +4/−4
• type-spine.cabal +1/−1

@@ -52,8 +52,8 @@ spineType_gen_ t ks = do   let rhs = ConT ''Atom `AppT` t       vars = [VarT $ mkName $ "t" ++ show i | i <- [0..]]-  let snoc ty1 ty2 = ConT ''(:@) `AppT` ty1 `AppT` ty2   return $ TySynInstD ''Spine [t] rhs :     [ case take n vars of-        vars -> TySynInstD ''Spine [foldl AppT t vars] $ foldl snoc t $ vars+        vars -> TySynInstD ''Spine [foldl AppT t vars] $+                  ConT ''(:@) `AppT` foldl AppT t (init vars) `AppT` last vars       | n <- [1..length ks] ]

@@ -64,8 +64,8 @@ -- | Returns the kinds of a type constructor's type parameters and range. tyConSignature :: Name -> Q ([Kind], Kind) tyConSignature n = do-  let bad = fail "Type.Spine.TH.tyConSignature expects the name of a data/newtype/data family"   i <- reify n+  let bad = fail $ "Type.Spine.TH.tyConSignature expects the name of a data/newtype/data family; got " ++ show i   case i of     DataConI _ tys n _ -> return (getArgTypes tys, PromotedT n)       where -- NB first, drop quantification over the data types' parameters@@ -81,16 +81,16 @@                     promote (AppT ty1 ty2) = AppT (promote ty1) (promote ty2)                     promote (TupleT i) = PromotedTupleT i                     promote ty =-                      error $ "type-spine:tyConSignature: cannot promote" ++ show ty+                      error $ "type-spine:tyConSignature: cannot promote " ++ show ty             loop _ = [] -- this is the ctor's codomain, so ignore it     TyConI dec -> case dec of       DataD _ _ tvbs _ _ -> return (map tvb_kind tvbs, StarT)       NewtypeD _ _ tvbs _ _ -> return (map tvb_kind tvbs, StarT)-      FamilyD DataFam _ tvbs mk -> return (map tvb_kind tvbs, maybe StarT (peel tvbs) mk)+      _ -> bad+    FamilyI (FamilyD DataFam _ tvbs mk) _ -> return (map tvb_kind tvbs, maybe StarT (peel tvbs) mk)         where peel [] k = k               peel (_ : l) (AppT (AppT ArrowT _) r) = peel l r               peel _ _ = error "Type.Spine.TH: bad FamilyD kind"-      _ -> bad     PrimTyConI _ i _ -> return (replicate i StarT, StarT)     _ -> bad 

@@ -1,5 +1,5 @@ Name:           type-spine-Version:        0.2+Version:        0.2.20120924 License:        BSD3 License-File:   LICENSE Author:         Nicolas Frisby <nicolas.frisby@gmail.com>