record-hasfield (empty) → 1.0

raw patch · 8 files changed

+245/−0 lines, 8 filesdep +basedep +record-hasfieldsetup-changed

Dependencies added: base, record-hasfield

Files

CHANGES.txt +4/−0
LICENSE +30/−0
README.md +14/−0
Setup.hs +2/−0
record-hasfield.cabal +45/−0
src/GHC/Records/Compat.hs +35/−0
src/GHC/Records/Extra.hs +89/−0
test/Test.hs +26/−0

+ CHANGES.txt view

@@ -0,0 +1,4 @@+Changelog for record-hasfield++1.0, released 2019-03-21+    Initial version

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Adam Gundry and Neil Mitchell 2018-2019.+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 Neil Mitchell 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,14 @@+# record-hasfield [![Hackage version](https://img.shields.io/hackage/v/record-hasfield.svg?label=Hackage)](https://hackage.haskell.org/package/record-hasfield) [![Stackage version](https://www.stackage.org/package/record-hasfield/badge/nightly?label=Stackage)](https://www.stackage.org/package/record-hasfield) [![Build status](https://img.shields.io/travis/ndmitchell/record-hasfield/master.svg?label=Build)](https://travis-ci.org/ndmitchell/record-hasfield)++This package provides a version of "GHC.Records" as it will be after the implementation of+[GHC proposal #42](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0042-record-set-field.rst), which reads:++```haskell+-- | Constraint representing the fact that the field @x@ can be get and set on+--   the record type @r@ and has field type @a@.+class HasField x r a | x r -> a where+    -- | Function to get and set a field in a record.+    hasField :: r -> (a -> r, a)+```++In GHC these will be magically solved, but this package doesn't provide that. This package does provide extra helper functions for working with the `HasField` type class.

+ Setup.hs view

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

+ record-hasfield.cabal view

@@ -0,0 +1,45 @@+cabal-version:      >= 1.18+build-type:         Simple+name:               record-hasfield+version:            1.0+license:            BSD3+license-file:       LICENSE+category:           Development+author:             Neil Mitchell <ndmitchell@gmail.com>+maintainer:         Neil Mitchell <ndmitchell@gmail.com>+copyright:          Adam Gundry and Neil Mitchell 2018-2019+synopsis:           A version of GHC.Records as available in future GHCs.+description:+    This package provides a version of "GHC.Records" as it will be after the implementation of+    <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0042-record-set-field.rst GHC proposal #42>,+    plus some helper functions over it.+homepage:           https://github.com/ndmitchell/record-hasfield#readme+bug-reports:        https://github.com/ndmitchell/record-hasfield/issues+tested-with:        GHC==8.6.4, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2++extra-doc-files:+    CHANGES.txt+    README.md++source-repository head+    type:     git+    location: https://github.com/ndmitchell/record-hasfield.git++library+    default-language: Haskell2010+    hs-source-dirs: src+    build-depends:+        base >= 4.4 && < 5++    exposed-modules:+        GHC.Records.Compat+        GHC.Records.Extra++test-suite record-hasfield-test+    type:               exitcode-stdio-1.0+    main-is:            test/Test.hs+    default-language:   Haskell2010++    build-depends:+        base,+        record-hasfield

+ src/GHC/Records/Compat.hs view

@@ -0,0 +1,35 @@+{-# LANGUAGE AllowAmbiguousTypes+           , FunctionalDependencies+           , ScopedTypeVariables+           , PolyKinds+           , TypeApplications+  #-}++-- | This module provides a version of "GHC.Records" as it will be after the implementation of+--   <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0042-record-set-field.rst GHC proposal #42>.+--+--   In future GHC versions it will be an alias for "GHC.Records".+module GHC.Records.Compat+    ( HasField(..)+    , getField+    , setField+    ) where++-- | Constraint representing the fact that the field @x@ can be get and set on+--   the record type @r@ and has field type @a@.  This constraint will be solved+--   automatically, but manual instances may be provided as well.+--+--   The function should satisfy the invariant:+--+-- > uncurry ($) (hasField @x r) == r+class HasField x r a | x r -> a where+    -- | Function to get and set a field in a record.+    hasField :: r -> (a -> r, a)++-- | Get a field in a record.+getField :: forall x r a . HasField x r a => r -> a+getField = snd . hasField @x++-- | Set a field in a record.+setField :: forall x r a . HasField x r a => r -> a -> r+setField = fst . hasField @x

+ src/GHC/Records/Extra.hs view

@@ -0,0 +1,89 @@+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE AllowAmbiguousTypes+           , MultiParamTypeClasses+           , ScopedTypeVariables+           , PolyKinds+           , TypeApplications+           , FlexibleInstances+           , UndecidableInstances+           , DataKinds+           , GADTs+           , TupleSections+  #-}++-- | Extensions over a future version of "GHC.Records".+--   Provides the function 'modifyField' plus the orphan instances:+--+-- * @HasField \'(x1,x2)@ for selecting first the @x1@ field, then the @x2@ field.+--   Available for @()@ and tuples up to arity 5.+--+-- * @HasField \"_1\" (a,b) a@ for selecting the first compomnent of a pair,+--   plus similarly for all fields up of all tuples up to arity 5.+--+--   Using these functions together you get:+--+-- > modifyField @'("_1","_2") negate ((1,2),3,4,5) == ((1,-2),3,4,5)+module GHC.Records.Extra+    ( module GHC.Records.Compat+    , modifyField+    ) where++import GHC.Records.Compat++-- | Modify a field in a record.+modifyField :: forall x r a . HasField x r a => r -> (a -> a) -> r+modifyField r f = gen $ f val+    where (gen, val) = hasField @x r++instance HasField '() a a where+    hasField r = (id, r)++instance (a1 ~ r2, HasField x1 r1 a1, HasField x2 r2 a2) => HasField '(x1, x2) r1 a2 where+    hasField r = (gen1 . gen2, val2)+        where+            (gen1, val1) = hasField @x1 r+            (gen2, val2) = hasField @x2 val1++instance (a1 ~ r2, a2 ~ r3, HasField x1 r1 a1, HasField x2 r2 a2, HasField x3 r3 a3) =>+        HasField '(x1, x2, x3) r1 a3 where+    hasField = hasField @'(x1, '(x2, x3))++instance (a1 ~ r2, a2 ~ r3, a3 ~ r4, HasField x1 r1 a1, HasField x2 r2 a2, HasField x3 r3 a3, HasField x4 r4 a4) =>+        HasField '(x1, x2, x3, x4) r1 a4 where+    hasField = hasField @'(x1, '(x2, x3, x4))++instance (a1 ~ r2, a2 ~ r3, a3 ~ r4, a4 ~ r5, HasField x1 r1 a1, HasField x2 r2 a2, HasField x3 r3 a3, HasField x4 r4 a4, HasField x5 r5 a5) =>+        HasField '(x1, x2, x3, x4, x5) r1 a5 where+    hasField = hasField @'(x1, '(x2, x3, x4, x5))++instance HasField "_1" (a,b) a where+    hasField (a,b) = ((,b), a)+instance HasField "_2" (a,b) b where+    hasField (a,b) = ((a,), b)++instance HasField "_1" (a,b,c) a where+    hasField (a,b,c) = ((,b,c), a)+instance HasField "_2" (a,b,c) b where+    hasField (a,b,c) = ((a,,c), b)+instance HasField "_3" (a,b,c) c where+    hasField (a,b,c) = ((a,b,), c)++instance HasField "_1" (a,b,c,d) a where+    hasField (a,b,c,d) = ((,b,c,d), a)+instance HasField "_2" (a,b,c,d) b where+    hasField (a,b,c,d) = ((a,,c,d), b)+instance HasField "_3" (a,b,c,d) c where+    hasField (a,b,c,d) = ((a,b,,d), c)+instance HasField "_4" (a,b,c,d) d where+    hasField (a,b,c,d) = ((a,b,c,), d)++instance HasField "_1" (a,b,c,d,e) a where+    hasField (a,b,c,d,e) = ((,b,c,d,e), a)+instance HasField "_2" (a,b,c,d,e) b where+    hasField (a,b,c,d,e) = ((a,,c,d,e), b)+instance HasField "_3" (a,b,c,d,e) c where+    hasField (a,b,c,d,e) = ((a,b,,d,e), c)+instance HasField "_4" (a,b,c,d,e) d where+    hasField (a,b,c,d,e) = ((a,b,c,,e), d)+instance HasField "_5" (a,b,c,d,e) e where+    hasField (a,b,c,d,e) = ((a,b,c,d,), e)

+ test/Test.hs view

@@ -0,0 +1,26 @@+{-# LANGUAGE MultiParamTypeClasses+           , TypeApplications+           , DataKinds+           , FlexibleInstances+  #-}++module Main(main) where++import GHC.Records.Extra++newtype Foo = Foo {foo :: Int} deriving (Show,Eq)+instance HasField "foo" Foo Int where+    hasField r = (\x -> r{foo=x}, foo r)++newtype Bar = Bar {bar :: Foo} deriving (Show,Eq)+instance HasField "bar" Bar Foo where+    hasField r = (\x -> r{bar=x}, bar r)++main :: IO ()+main = do+    let a === b = if a == b then putStr "." else fail $ "Mismatch: " ++ show a ++ " /= " ++ show b+    modifyField @'("bar","foo") (Bar $ Foo 12) (*2) === Bar {bar = Foo {foo = 24}}+    getField @"foo" (Foo 3) === 3+    setField @"_1" (1, True) 8 === (8, True)+    modifyField @'("_1","_2") ((1,2),3,4,5) negate === ((1,-2),3,4,5)+    putStrLn " success"