beam-th 0.1.0.0 → 0.1.0.1
raw patch · 3 files changed
+9/−5 lines, 3 files
Files
- CHANGELOG.md +4/−0
- beam-th.cabal +1/−1
- src/Database/Beam/TH.hs +4/−4
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog for the [`beam-th` package](http://hackage.haskell.org/package/beam-th) +## 0.1.0.1++ * Fix name lookup for `LensFor`+ ## 0.1.0.0 *June 2016* * Initial release
beam-th.cabal view
@@ -1,5 +1,5 @@ name: beam-th-version: 0.1.0.0+version: 0.1.0.1 synopsis: Template Haskell utilities for beam description: (Completely optional) Template Haskell functions
src/Database/Beam/TH.hs view
@@ -10,10 +10,9 @@ import GHC.Generics (Generic) import Language.Haskell.TH import Language.Haskell.TH.Syntax hiding (lift)-import Language.Haskell.TH.ExpandSyns+import Language.Haskell.TH.ExpandSyns (expandSyns) import Database.Beam (Table, TableField, Columnar, PrimaryKey, primaryKey, tableConfigLenses, LensFor)- import Database.Beam.TH.Internal {-# INLINE getColTy #-}@@ -57,6 +56,7 @@ nm <- name nmT <- nameT -- Lens' (AdT (TableField AdT)) (TableField AdT _)+ (Just lf) <- lift . lookupTypeName $ "LensFor" (TyConI (DataD _ _ _ _ (RecC _ vsts:_) _)) <- lift $ reify nmT let fields = fmap renameFields vsts fields' <- forM fields (\(x, t) -> lift (opportunisticExpand t) >>= \case@@ -64,8 +64,8 @@ tellD . SigD x $ ConT lens' <~> (ConT nmT <~> (ConT ''TableField <~> ConT nmT)) <~> (ConT ''TableField <~> ConT nmT <~> WildCardT) c <- lift . extractCon $ t- pure . ConP c . pure . ConP ''LensFor . pure . VarP $ x- _ -> pure . ConP ''LensFor . pure $ VarP x)+ pure . ConP c . pure . ConP lf . pure . VarP $ x+ _ -> pure . ConP lf . pure . VarP $ x) tellD $ ValD (ConP nm fields') (NormalB (VarE 'tableConfigLenses)) [] where renameFields (cname, _, t) = (rename (++ "C") cname, t)