safe-wild-cards (empty) → 1.0.0

raw patch · 8 files changed

+242/−0 lines, 8 filesdep +basedep +safe-wild-cardsdep +template-haskellsetup-changed

Dependencies added: base, safe-wild-cards, template-haskell, th-abstraction

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
README.md +4/−0
Setup.hs +2/−0
safe-wild-cards.cabal +61/−0
src/SafeWildCards.hs +73/−0
test/Test.hs +56/−0
test/TestTypes.hs +11/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for safe-wild-cards++## 1.0.0++First version.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Monadfix++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Monadfix nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,4 @@+# safe-wild-cards++`-XRecordWildCards` is convenient, but sometimes you want to assert that+you have handled all fields of a record. `safe-wild-cards` lets you do this.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ safe-wild-cards.cabal view

@@ -0,0 +1,61 @@+cabal-version: >=1.10++name: safe-wild-cards+version: 1.0.0+synopsis: Use RecordWildCards safely+description:+  @-XRecordWildCards@ is convenient, but sometimes you want to assert that+  you have handled all fields of a record, and there is no easy way to do that.++license: BSD3+license-file: LICENSE+author: Artyom Kazak+maintainer: Monadfix <hi@monadfix.com>+homepage: https://github.com/monadfix/safe-wild-cards+category: Control+build-type: Simple+extra-source-files:+  CHANGELOG.md+  README.md+tested-with:+  GHC ==8.0.2+  GHC ==8.2.2+  GHC ==8.4.4+  GHC ==8.6.5+  GHC ==8.8.4+  GHC ==8.10.4+  GHC ==9.0.1++source-repository head+  type: git+  location: git@github.com:monadfix/safe-wild-cards.git++library+  exposed-modules:+    SafeWildCards+  build-depends:+    base <5,+    template-haskell <2.18,+    th-abstraction >=0.3 && <0.5+  hs-source-dirs:+    src+  default-language:+    Haskell2010+  ghc-options:+    -Wall++test-suite test+  type: exitcode-stdio-1.0+  main-is:+    Test.hs+  other-modules:+    TestTypes+  build-depends:+    base,+    safe-wild-cards+  hs-source-dirs:+    test+  default-language:+    Haskell2010+  ghc-options:+    -Wall

+ src/SafeWildCards.hs view

@@ -0,0 +1,73 @@+-- | Use @-XRecordWildCards@ safely.+module SafeWildCards (fields, fieldsPrefixed, fieldsNamed) where++import Language.Haskell.TH (Name, PatQ, mkName, conP, varP, nameBase, recover)+import Language.Haskell.TH.Datatype++-- | Put all fields of a record constructor into scope.+--+-- @f $(fields 'Rec) = ...@ is equivalent to @f Rec{..}@, but the compiler+-- will warn you about all unused fields. Thus 'fields' brings compile-time+-- safety whenever you want to guarantee that a certain function uses all+-- fields of @Rec@.+--+-- To explicitly ignore a field, match it against @_@:+--+-- @+-- f $(fields 'Rec) = ...+--   where+--     -- Ignored fields+--     _ = (recUselessField1, recUselessField2)+-- @+--+-- Usage examples include @ToJSON@ instances and various encoders in+-- general:+--+-- @+-- instance ToJSON Rec where+--   toJSON $(fields 'Rec) = ...+-- @+--+-- __Note:__ if you want to define the data type and use 'fields' in the+-- same module, you will need to add @\$(pure [])@ after the type+-- declaration. See the post about <https://blog.monadfix.com/th-groups declaration groups>+-- for more details. Your code will look like this:+--+-- @+-- data Rec = ...+-- \$(pure [])+--+-- f $(fields 'Rec) = ...+-- @+fields :: Name -> PatQ+fields = fieldsNamed id++-- | Like 'fields', but prefixes all fields with the given prefix.+--+-- Useful if you need to put fields from more than one record into scope:+--+-- @+-- diff :: Rec -> Rec -> Text+-- diff $(fieldsPrefixed "a_" 'Rec) $(fieldsPrefixed "b_" 'Rec) = ...+-- @+fieldsPrefixed :: String -> Name -> PatQ+fieldsPrefixed prefix = fieldsNamed (prefix ++)++-- | General form of 'fields' and 'fieldsPrefixed'.+fieldsNamed :: (String -> String) -> Name -> PatQ+fieldsNamed f recordConstructor = do+  cons <-+    recover+      (fail $+         "Could not find " ++ nameBase recordConstructor ++ ". If it is defined in the same module where you are using\n" +++         "      'safe-wild-cards', you need to break the declaration group like this:\n" +++         "          data ... = " ++ nameBase recordConstructor ++ " ...\n" +++         "          $(pure [])\n" +++         "      Read the 'SafeWildCards' module documentation for more details.\n"+      )+      (reifyConstructor recordConstructor)+  case constructorVariant cons of+    RecordConstructor recordFields ->+      conP recordConstructor (map (varP . mkName . f . nameBase) recordFields)+    _ -> fail $+      "Expected " ++ show recordConstructor ++ " to be a record constructor"

+ test/Test.hs view

@@ -0,0 +1,56 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Main (main) where++import SafeWildCards+import TestTypes (Rec (Rec1, Rec2), RecFamily (RecFamily1))++main :: IO ()+main = do+  fieldsSpec+  fieldsPrefixedSpec++----------------------------------------------------------------------------+-- fields+----------------------------------------------------------------------------++f :: Rec -> [Int]+f $(fields 'Rec1) = [a, b]+f $(fields 'Rec2) = [a, b, c]++fFamily :: RecFamily -> [Int]+fFamily $(fields 'RecFamily1) = [af, bf]++fieldsSpec :: IO ()+fieldsSpec = do+  f (Rec1 1 2) `mustBe` [1, 2]+  f (Rec2 1 2 3) `mustBe` [1, 2, 3]+  fFamily (RecFamily1 1 2) `mustBe` [1, 2]++----------------------------------------------------------------------------+-- fieldsPrefixed+----------------------------------------------------------------------------++p :: Rec -> Rec -> [Int]+p $(fieldsPrefixed "r1_" 'Rec1) $(fieldsPrefixed "r2_" 'Rec2) =+  [r1_a, r1_b, r2_a, r2_b, r2_c]+p _ _ = undefined++pFamily :: RecFamily -> RecFamily -> [Int]+pFamily $(fieldsPrefixed "r1_" 'RecFamily1) $(fieldsPrefixed "r2_" 'RecFamily1) =+  [r1_af, r1_bf, r2_af, r2_bf]++fieldsPrefixedSpec :: IO ()+fieldsPrefixedSpec = do+  p (Rec1 1 2) (Rec2 3 4 5) `mustBe` [1, 2, 3, 4, 5]+  pFamily (RecFamily1 1 2) (RecFamily1 3 4) `mustBe` [1, 2, 3, 4]++----------------------------------------------------------------------------+-- Helpers+----------------------------------------------------------------------------++mustBe :: (Eq a, Show a) => a -> a -> IO ()+mustBe x y+  | x == y = return ()+  | otherwise = error $ show x ++ " must be " ++ show y

+ test/TestTypes.hs view

@@ -0,0 +1,11 @@+{-# LANGUAGE TypeFamilies #-}++module TestTypes (Rec(..), RecFamily(..)) where++data Rec+  = Rec1 { a :: Int, b :: Int }+  | Rec2 { a :: Int, b :: Int, c :: Int }++data family RecFamily++data instance RecFamily = RecFamily1 { af :: Int, bf :: Int }