git.iko.soy/generic-lens
on bfcd00a help sign in
generic-lens/src/Data/Generics/Product/Fields.hs
106 lines 2.9 kB history raw
1{-# LANGUAGE AllowAmbiguousTypes #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FunctionalDependencies #-}
5{-# LANGUAGE KindSignatures #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE TypeApplications #-}
9{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE TypeOperators #-}
11{-# LANGUAGE UndecidableInstances #-}
13-----------------------------------------------------------------------------
14-- |
15-- Module : Data.Generics.Product.Fields
16-- Copyright : (C) 2017 Csongor Kiss
17-- License : BSD3
18-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
19-- Stability : experimental
20-- Portability : non-portable
21--
22-- Derive record field getters and setters generically.
23--
24-----------------------------------------------------------------------------
26module Data.Generics.Product.Fields
27 ( -- *Lenses
29 -- $example
30 HasField (..)
31 ) where
33import Data.Generics.Internal.Families
34import Data.Generics.Internal.Lens
35import Data.Generics.Product.Internal.Fields
37import Data.Kind (Constraint, Type)
38import GHC.Generics
39import GHC.TypeLits (Symbol, ErrorMessage(..), TypeError)
41-- $example
42-- @
43-- module Example where
44--
45-- import Data.Generics.Product
46-- import GHC.Generics
47--
48-- data Human = Human
49-- { name :: String
50-- , age :: Int
51-- , address :: String
52-- }
53-- deriving (Generic, Show)
54--
55-- human :: Human
56-- human = Human \"Tunyasz\" 50 \"London\"
57-- @
59-- |Records that have a field with a given name.
60class HasField (field :: Symbol) a s | s field -> a where
61 -- |A lens that focuses on a field with a given name. Compatible with the
62 -- lens package's 'Control.Lens.Lens' type.
63 --
64 -- >>> human ^. field @"age"
65 -- 50
66 -- >>> human & field @"name" .~ "Tamas"
67 -- Human {name = "Tamas", age = 50, address = "London"}
68 field :: Lens' s a
69 field f s
70 = fmap (flip (setField @field) s) (f (getField @field s))
72 -- |Get 'field'
73 --
74 -- >>> getField @"name" human
75 -- "Tunyasz"
76 getField :: s -> a
77 getField s = s ^. field @field
79 -- |Set 'field'
80 --
81 -- >>> setField @"age" (setField @"name" "Tamas" human) 30
82 -- Human {name = "Tamas", age = 30, address = "London"}
83 setField :: a -> s -> s
84 setField = set (field @field)
86 {-# MINIMAL field | setField, getField #-}
88instance
89 ( Generic s
90 , ErrorUnless field s (HasTotalFieldP field (Rep s))
91 , GHasField field (Rep s) a
92 ) => HasField field a s where
94 field = repIso . gfield @field
96type family ErrorUnless (field :: Symbol) (s :: Type) (contains :: Bool) :: Constraint where
97 ErrorUnless field s 'False
98 = TypeError
99 ( 'Text "The type "
100 ':<>: 'ShowType s
101 ':<>: 'Text " does not contain a field named "
102 ':<>: 'ShowType field
103 )
105 ErrorUnless _ _ 'True
106 = ()