partial-isomorphisms 0.1 → 0.2

raw patch · 3 files changed

+66/−15 lines, 3 files

Files

• LICENSE +1/−1
• partial-isomorphisms.cabal +1/−1
• src/Control/Isomorphism/Partial/TH.hs +64/−13

@@ -1,4 +1,4 @@-Copyright (c)2010, University of Marburg
+Copyright (c)2010-11 University of Marburg
 
 All rights reserved.
 

@@ -1,5 +1,5 @@ Name:                partial-isomorphisms
-Version:             0.1
+Version:             0.2
 Synopsis:            Partial isomorphisms.
 Description:         Partial isomorphisms as described in the 
                      paper:

@@ -11,28 +11,77 @@  import Control.Isomorphism.Partial.Unsafe (Iso (Iso)) +-- | Extract the name of a constructor, e.g. ":" or "Just".+conName :: Con -> Name+conName (NormalC name fields)       =   name+conName (RecC name fields)          =   name+conName (InfixC lhs name rhs)       =   name+conName (ForallC vars context con)  =   conName con++-- | Extract the types of the constructor's fields.+conFields :: Con -> [Type]+conFields (NormalC name fields)       =   map (\(s, t) -> t) fields+conFields (RecC name fields)          =   map (\(n, s, t) -> t) fields+conFields (InfixC lhs name rhs)       =   map (\(s, t) -> t) [lhs, rhs]+conFields (ForallC vars context con)  =   conFields con++-- | Extract the constructors of a type declaration+decConstructors :: Dec -> Q [Con]+decConstructors (DataD _ _ _ cs _)    =  return cs+decConstructors (NewtypeD _ _ _ c _)  =  return [c]+decConstructors _                      +  = fail "partial isomorphisms can only be derived for constructors of data type or newtype declarations."++-- | Construct a partial isomorphism expression for a constructor, +-- given the constructor's name.+constructorIso :: Name -> ExpQ constructorIso c = do-  DataConI n _ d _             <-  reify c-  TyConI ((DataD _ _ _ cs _))  <-  reify d-  let Just con = find (\(NormalC n' _) -> n == n') cs+  DataConI n _ d _  <-  reify c+  TyConI dec        <-  reify d+  cs                <-  decConstructors dec+  let Just con      =   find (\c -> n == conName c) cs   isoFromCon (wildcard cs) con +wildcard :: [Con] -> [MatchQ] wildcard cs    =  if length cs > 1      then  [match (wildP) (normalB [| Nothing |]) []]      else  []-  ++-- | Converts a constructor name (starting with an upper-case+--   letter) into a function name (starting with a lower-case+--   letter).+rename :: Name -> Name+rename n +  = mkName (toLower c : cs) where c : cs = nameBase n++-- | Construct partial isomorphism definitions for all +--   constructors of a datatype, given the datatype's name.+--   The names of the partial isomorphisms are constructed by+--   spelling the constructor names with an initial lower-case+--   letter.+defineIsomorphisms :: Name -> Q [Dec] defineIsomorphisms d = do-  TyConI (DataD _ _ _ cs _) <- reify d-  let rename n -        = mkName (toLower c : cs) where c : cs = nameBase n-      defFromCon con@(NormalC n _) -        =  funD (rename n) -             [clause [] (normalB (isoFromCon (wildcard cs) con)) []]-  -  mapM defFromCon cs+  TyConI dec  <-  reify d+  cs          <-  decConstructors dec+  mapM (defFromCon (wildcard cs)) cs -isoFromCon wildcard (NormalC c fs) = do+-- | Constructs a partial isomorphism definition for a+--   constructor, given information about the constructor.+--   The name of the partial isomorphisms is constructed by+--   spelling the constructor name with an initial lower-case+--   letter.+defFromCon :: [MatchQ] -> Con -> DecQ+defFromCon wildcard con+  = funD (rename (conName con)) +      [clause [] (normalB (isoFromCon wildcard con)) []]++-- | Constructs a partial isomorphism expression for a+--   constructor, given information about the constructor.+isoFromCon :: [MatchQ] -> Con -> ExpQ+isoFromCon wildcard con = do+  let c     =   conName con+  let fs    =   conFields con   let n     =   length fs   (ps, vs)  <-  genPE n   v         <-  newName "x"@@ -44,6 +93,8 @@                         (normalB [| Just $(nested tupE vs) |]) []                     ] ++ wildcard)   [| Iso $f $g |]++  genPE n = do   ids <- replicateM n (newName "x")