derive-has-field 0.0.1.4 → 0.0.1.5

raw patch · 4 files changed

+78/−4 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• README.md +3/−0
• derive-has-field.cabal +1/−1
• src/DeriveHasField.hs +12/−0
• test/DeriveHasFieldSpec.hs +62/−3

@@ -30,6 +30,9 @@     { bankAccountAccountNumber :: String     } +deriveHasField ''BankAccount++-- alternatively, for prefixes that don't match the data constructor name deriveHasFieldWith (dropPrefix "bankAccount") ''BankAccount ``` 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           derive-has-field-version:        0.0.1.4+version:        0.0.1.5 synopsis:       Derive HasField instances with Template Haskell description:    A Template Haskell function to derive HasField instances to utilize OverloadedRecordDot more effectively. category:       Template Haskell

@@ -4,6 +4,7 @@  module DeriveHasField (   module GHC.Records,+  deriveHasField,   deriveHasFieldWith, ) where@@ -11,6 +12,8 @@ import Control.Monad import Data.Char (toLower) import Data.Foldable as Foldable+import Data.List (stripPrefix)+import Data.Maybe (fromMaybe) import Data.Traversable (for) import GHC.Records import Language.Haskell.TH@@ -18,6 +21,15 @@  deriveHasFieldWith :: (String -> String) -> Name -> DecsQ deriveHasFieldWith fieldModifier = makeDeriveHasField fieldModifier <=< reifyDatatype++deriveHasField :: Name -> DecsQ+deriveHasField name = do+  datatypeInfo <- reifyDatatype name+  constructorInfo <- case datatypeInfo.datatypeCons of+    [info] -> pure info+    _ -> fail "deriveHasField: only supports product types with a single data constructor"+  let dropPrefix prefix input = fromMaybe input $ stripPrefix prefix input+  makeDeriveHasField (dropPrefix $ lowerFirst $ nameBase constructorInfo.constructorName) datatypeInfo  makeDeriveHasField :: (String -> String) -> DatatypeInfo -> DecsQ makeDeriveHasField fieldModifier datatypeInfo = do

@@ -18,7 +18,7 @@   , someTypeSomeEitherField :: Either String Int   } -DeriveHasField.deriveHasFieldWith (dropPrefix "someType") ''SomeType+DeriveHasField.deriveHasField ''SomeType  someType :: SomeType someType =@@ -29,12 +29,30 @@     , someTypeSomeEitherField = Right 0     } +data SomeTypePrefix = SomeTypePrefix+  { someTypePrefixSomeField :: String+  , someTypePrefixSomeOtherField :: Int+  , someTypePrefixSomeMaybeField :: Maybe Int+  , someTypePrefixSomeEitherField :: Either String Int+  }++DeriveHasField.deriveHasFieldWith (dropPrefix "someTypePrefix") ''SomeTypePrefix++someTypePrefix :: SomeTypePrefix+someTypePrefix =+  SomeTypePrefix+    { someTypePrefixSomeField = "hello"+    , someTypePrefixSomeOtherField = 0+    , someTypePrefixSomeMaybeField = Just 0+    , someTypePrefixSomeEitherField = Right 0+    }+ data OtherType a b = OtherType   { otherTypeField :: Maybe a   , otherTypeOtherField :: Either a b   } -DeriveHasField.deriveHasFieldWith (dropPrefix "otherType") ''OtherType+DeriveHasField.deriveHasField ''OtherType  otherType :: OtherType Int String otherType =@@ -43,12 +61,26 @@     , otherTypeOtherField = Right "hello"     } +data OtherTypePrefix a b = OtherTypePrefix+  { otherTypePrefixField :: Maybe a+  , otherTypePrefixOtherField :: Either a b+  }++DeriveHasField.deriveHasFieldWith (dropPrefix "otherTypePrefix") ''OtherTypePrefix++otherTypePrefix :: OtherTypePrefix Int String+otherTypePrefix =+  OtherTypePrefix+    { otherTypePrefixField = Just 0+    , otherTypePrefixOtherField = Right "hello"+    }+ data KindedType (kind :: * -> *) (sym :: Symbol) = KindedType   { kindedTypeWithKind :: kind ()   , kindedTypeWithSymbol :: Proxy sym   } -DeriveHasField.deriveHasFieldWith (dropPrefix "kindedType") ''KindedType+DeriveHasField.deriveHasField ''KindedType  kindedType :: KindedType Maybe "hello" kindedType =@@ -57,6 +89,20 @@     , kindedTypeWithSymbol = Proxy @"hello"     } +data KindedTypePrefix (kind :: * -> *) (sym :: Symbol) = KindedTypePrefix+  { kindedTypePrefixWithKind :: kind ()+  , kindedTypePrefixWithSymbol :: Proxy sym+  }++DeriveHasField.deriveHasFieldWith (dropPrefix "kindedTypePrefix") ''KindedTypePrefix++kindedTypePrefix :: KindedTypePrefix Maybe "hello"+kindedTypePrefix =+  KindedTypePrefix+    { kindedTypePrefixWithKind = Just ()+    , kindedTypePrefixWithSymbol = Proxy @"hello"+    }+ spec :: Spec spec = do   describe "deriveHasField" $ do@@ -71,3 +117,16 @@     it "compiles and gets the right field" $ do       kindedType.withKind `shouldBe` Just ()       kindedType.withSymbol `shouldBe` Proxy @"hello"++  describe "deriveHasFieldWith" $ do+    it "compiles and gets the right field" $ do+      someTypePrefix.someField `shouldBe` "hello"+      someTypePrefix.someOtherField `shouldBe` 0+      someTypePrefix.someMaybeField `shouldBe` Just 0+      someTypePrefix.someEitherField `shouldBe` Right 0+    it "compiles and gets the right field" $ do+      otherTypePrefix.field `shouldBe` Just 0+      otherTypePrefix.otherField `shouldBe` Right "hello"+    it "compiles and gets the right field" $ do+      kindedTypePrefix.withKind `shouldBe` Just ()+      kindedTypePrefix.withSymbol `shouldBe` Proxy @"hello"