on master help sign in
Add IsLabel instance
commit5b0c027be46734c2e194ba6541590e9423688917 authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateSun 10 Dec 2017, 13:47 (9 years ago) parent01d7893
3 files changed+45
examples/Examples.hs+8 generic-lens.cabal+1 src/Data/Generics/Labels.hs+36
examples/Examples.hs+8
@@ -20,6 +20,7 @@ import Data.Generics.Internal.Lens
2020import Data.Generics.Product
2121import Data.Generics.Sum
2222import GHC.Generics
23+import Data.Generics.Labels
2324
2425data Animal = Animal
2526 { name :: String
@@ -102,3 +103,10 @@ stuff ::
102103 , HasField "bar" a' b' s t
103104 ) => s' -> t'
104105stuff r = r & field @"test" . field @"bar" . position @15 .~ "hello"
106+
107+stuff' ::
108+ ( HasPosition 15 s t a String
109+ , HasField "test" s' t' a' b'
110+ , HasField "bar" a' b' s t
111+ ) => s' -> t'
112+stuff' r = r & #test . #bar . position @15 .~ "hello"
generic-lens.cabal+1
@@ -25,6 +25,7 @@ library
2525 , Data.Generics.Product.Positions
2626 , Data.Generics.Product.Subtype
2727 , Data.Generics.Product.Typed
28+ , Data.Generics.Labels
2829
2930 , Data.Generics.Sum
3031 , Data.Generics.Sum.Any
src/Data/Generics/Labels.hsnew file+36
@@ -0,0 +1,36 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE TypeApplications #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE UndecidableInstances #-}
8+{-# OPTIONS_GHC -Wno-orphans #-}
9+
10+
11+--------------------------------------------------------------------------------
12+-- |
13+-- Module : Data.Generics.Labels
14+-- Copyright : (C) 2017 Csongor Kiss
15+-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
16+-- License : BSD3
17+-- Stability : experimental
18+-- Portability : non-portable
19+--
20+-- Provide an (orphan) IsLabel instance for field lenses
21+--
22+--------------------------------------------------------------------------------
23+
24+module Data.Generics.Labels () where
25+
26+import Data.Generics.Product
27+import GHC.OverloadedLabels
28+
29+
30+instance (HasField field s t a b, Functor f, sft ~ (s -> f t)) =>
31+ IsLabel field ((a -> f b) -> sft) where
32+#if __GLASGOW_HASKELL__ >= 802
33+ fromLabel = field @field
34+#else
35+ fromLabel _ = field @field
36+#endif