persistable-record 0.4.0.0 → 0.4.0.1

raw patch · 2 files changed

+13/−9 lines, 2 filesdep +th-data-compat

Dependencies added: th-data-compat

Files

• persistable-record.cabal +3/−2
• src/Database/Record/TH.hs +10/−7

@@ -1,5 +1,5 @@ name:                persistable-record-version:             0.4.0.0+version:             0.4.0.1 synopsis:            Binding between SQL database values and haskell records. description:         This package contiains types to represent table constraints and                      interfaces to bind between SQL database values and Haskell records.@@ -8,7 +8,7 @@ license-file:        LICENSE author:              Kei Hibino maintainer:          ex8k.hibino@gmail.com-copyright:           Copyright (c) 2013 Kei Hibino+copyright:           Copyright (c) 2013-2016 Kei Hibino category:            Database build-type:          Simple cabal-version:       >=1.10@@ -25,6 +25,7 @@    build-depends:          base <5                         , template-haskell+                        , th-data-compat                         , array                         , containers                         , transformers

@@ -74,10 +74,11 @@    conCamelcaseName, varCamelcaseName, varNameWithPrefix,    toTypeCon, toDataCon, toVarExp) import Language.Haskell.TH.Lib.Extra (integralE, simpleValD)+import Language.Haskell.TH.Compat.Data (dataD', unDataD) import Language.Haskell.TH   (Q, newName, nameBase, reify, Info(TyConI), Name,    TypeQ, conT, Con (NormalC, RecC),-   Dec(DataD), dataD, sigD, valD,+   Dec, sigD, valD,    ExpQ, Exp(ConE), conE, varE, lamE, listE, sigE,    varP, conP, normalB, recC,    cxt, varStrictType, strictType, isStrict)@@ -223,7 +224,7 @@ defineRecordType typeName' columns derives = do   let typeName = conName typeName'       fld (n, tq) = varStrictType (varName n) (strictType isStrict tq)-  rec  <- dataD (cxt []) typeName [] [recC typeName (map fld columns)] derives+  rec  <- dataD' (cxt []) typeName [] [recC typeName (map fld columns)] derives   offs <- defineColumnOffsets typeName' [ty | (_, ty) <- columns]   return $ rec : offs @@ -345,11 +346,13 @@  recordInfo' :: Info -> Maybe ((TypeQ, ExpQ), (Maybe [Name], [TypeQ])) recordInfo' =  d  where-  d (TyConI (DataD _cxt tcn _bs [r] _ds)) = case r of-    NormalC dcn ts     -> Just ((conT tcn, conE dcn), (Nothing, [return t | (_, t) <- ts]))-    RecC    dcn vts    -> Just ((conT tcn, conE dcn), (Just ns, ts))-      where (ns, ts) = unzip [(n, return t) | (n, _, t) <- vts]-    _                  -> Nothing+  d (TyConI tcon) = do+    (_cxt, tcn, _bs, _mk, [r], _ds) <- unDataD tcon+    case r of+      NormalC dcn ts   -> Just ((conT tcn, conE dcn), (Nothing, [return t | (_, t) <- ts]))+      RecC    dcn vts  -> Just ((conT tcn, conE dcn), (Just ns, ts))+        where (ns, ts) = unzip [(n, return t) | (n, _, t) <- vts]+      _                -> Nothing   d _                  =  Nothing  -- | Low-level reify interface for record type name.