barbies-th 0.1 → 0.1.1

raw patch · 4 files changed

+18/−6 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG.md +5/−1
barbies-th.cabal +1/−1
src/Data/Barbie/TH.hs +9/−3
tests/Main.hs +3/−1

CHANGELOG.md view

@@ -1,5 +1,9 @@ # Revision history for barbies-th -## 0.1.0.0 -- YYYY-mm-dd+## 0.1.1 -- 2020/04/19++* Improved the deriving mechanism; deriving clauses within `declareBareB` are translated into `deriving via Barbie ...`++## 0.1 -- 2020/02  * First version. Released on an unsuspecting world.

barbies-th.cabal view

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                barbies-th-version:             0.1+version:             0.1.1 synopsis:            Create strippable HKD via TH description:         Please see Data.Barbie.TH bug-reports:         https://github.com/fumieval/barbies-th

src/Data/Barbie/TH.hs view

@@ -2,6 +2,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -47,7 +49,7 @@   decs' <- traverse go decs   return $ concat decs'   where-    go (DataD _ dataName tvbs _ [con@(RecC conName fields)] drv) = do+    go (DataD _ dataName tvbs _ [con@(RecC conName fields)] classes) = do       varS <- newName "sw"       varW <- newName "h"       let xs = varNames "x" fields@@ -100,12 +102,16 @@             (\r (x, y) -> [|$(r) (Pair $(varE x) $(varE y))|])             (conE conName) (zip xs ys))         |]+      drvs <- traverse (\cls ->+        [d|deriving via Barbie $(datC) $(varT varW)+            instance ($(cls) (Barbie $(datC) $(varT varW))) => $(cls) ($(datC) $(varT varW))|])+        [ pure t | DerivClause _ preds <- classes, t <- preds ]       return $ DataD [] dataName         (tvbs ++ [PlainTV varS, PlainTV varW])         Nothing         [transformed]-        (DerivClause Nothing [ConT ''Generic] : drv)-        : decs+        [DerivClause Nothing [ConT ''Generic]]+        : decs ++ concat drvs     go d = pure [d]  varNames :: String -> [VarBangType] -> [Name]

tests/Main.hs view

@@ -4,6 +4,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS -ddump-splices #-} module Main where import Data.Barbie.TH@@ -14,5 +16,5 @@   data Foo = Foo     { foo :: Int     , bar :: String-    }  |]+    } deriving (Show, Eq) |] main = pure ()