yoko 0.3.2 → 0.3.2.1

raw patch · 3 files changed

+46/−12 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Yoko/TH.hs +3/−11
• Data/Yoko/TH/Internal.hs +42/−0
• yoko.cabal +1/−1

@@ -75,6 +75,7 @@ import qualified Language.Haskell.TH.SCCs as SCCs  import qualified Data.Yoko.TH.Internal as Int+import Data.Yoko.TH.Internal (tvbName, peelApp, peelAppAcc, expandSyn)  import Data.Functor.Invariant (invmap, invmap2) @@ -82,6 +83,7 @@ import qualified Control.Monad.Trans as Trans  import qualified Control.Arrow as Arrow+import Control.Monad ((<=<))  import Data.Set (Set) import qualified Data.Set as Set@@ -196,10 +198,6 @@ renameCon f (InfixC fieldL n fieldR) = InfixC fieldL (f n) fieldR renameCon f (ForallC tvbs cxt c) = ForallC tvbs cxt $ renameCon f c -tvbName :: TyVarBndr -> Name-tvbName (PlainTV n) = n-tvbName (KindedTV n _) = n- tvbKind :: TyVarBndr -> Kind tvbKind (PlainTV _) = StarK tvbKind (KindedTV _ k) = k@@ -231,17 +229,11 @@     where lk = k `div` 2   ;   rk = k - lk           (l, r) = List.splitAt lk as -peelApp :: Type -> (Type, [Type])-peelApp = peelAppAcc []--peelAppAcc acc (AppT ty0 ty1) = peelAppAcc (ty1 : acc) ty0-peelAppAcc acc ty             = (ty, acc)- data FieldRO = FieldRO {repF :: Exp, objF :: Exp}  fieldRO :: [(Int, Mapping)] -> Set Name -> Type -> Q (Type, FieldRO) fieldRO maps bg = w' where-  w' = uncurry w . peelApp+  w' = uncurry w <=< uncurry expandSyn . peelApp    isRec n = Set.member n bg 

@@ -1,5 +1,9 @@+{-# LANGUAGE ViewPatterns #-}+ module Data.Yoko.TH.Internal where +import Data.Maybe (fromMaybe)+ import Language.Haskell.TH  @@ -27,3 +31,41 @@ dataType2Dec n (DataType tvbs cons) = case cons of   Left  con  -> NewtypeD [] n tvbs con  []   Right cons -> DataD    [] n tvbs cons []+++++tvbName :: TyVarBndr -> Name+tvbName (PlainTV n) = n+tvbName (KindedTV n _) = n++++peelApp :: Type -> (Type, [Type])+peelApp = peelAppAcc []++peelAppAcc acc (AppT ty0 ty1) = peelAppAcc (ty1 : acc) ty0+peelAppAcc acc ty             = (ty, acc)++++expandSyn :: Type -> [Type] -> Q (Type, [Type])+expandSyn ty@(ConT n) tys = do+  i <- reify n+  case i of+    TyConI (TySynD _ (map tvbName -> formals) rhs) ->+      uncurry expandSyn $ peelApp $ msubst (zip formals tys) rhs+    _ -> return (ty, tys)+expandSyn ty tys = return (ty, tys)++++msubst :: [(Name, Type)] -> Type -> Type+msubst sigma = w where+  w ty@(VarT n) = fromMaybe ty $ lookup n sigma+  w (ForallT tvbs cxt ty) =+    ForallT tvbs cxt $ msubst (filter p sigma) ty+    where p = (`elem` map tvbName tvbs) . fst+  w (AppT ty1 ty2) = AppT (w ty1) (w ty2)+  w (SigT ty k) = SigT (w ty) k+  w ty = ty

@@ -1,5 +1,5 @@ name: yoko-version: 0.3.2+version: 0.3.2.1 synopsis: Generic Programming with Disbanded Data Types  description: