git.iko.soy/generic-lens
on ccc8bcf help sign in
generic-lens/src/Data/Generics/Sum/Any.hs
96 lines 2.4 kB history raw
1{-# LANGUAGE AllowAmbiguousTypes #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE MonoLocalBinds #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE PolyKinds #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE TypeApplications #-}
9{-# LANGUAGE UndecidableInstances #-}
11-----------------------------------------------------------------------------
12-- |
13-- Module : Data.Generics.Sum.Any
14-- Copyright : (C) 2017 Csongor Kiss
15-- License : BSD3
16-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
17-- Stability : experimental
18-- Portability : non-portable
19--
20-- Derive a variety of prisms generically.
21--
22-----------------------------------------------------------------------------
24module Data.Generics.Sum.Any
25 ( -- *Prisms
26 --
27 -- $setup
28 AsAny (..)
29 ) where
31import Data.Generics.Internal.Lens
32import Data.Generics.Sum.Constructors
33import Data.Generics.Sum.Typed
35-- $setup
36-- == /Running example:/
37--
38-- >>> :set -XTypeApplications
39-- >>> :set -XDataKinds
40-- >>> :set -XDeriveGeneric
41-- >>> import GHC.Generics
42-- >>> :m +Data.Generics.Internal.Lens
43-- >>> :{
44-- data Animal
45-- = Dog Dog
46-- | Cat Name Age
47-- | Duck Age
48-- deriving (Generic, Show)
49-- data Dog
50-- = MkDog
51-- { name :: Name
52-- , age :: Age
53-- }
54-- deriving (Generic, Show)
55-- type Name = String
56-- type Age = Int
57-- dog, cat, duck :: Animal
58-- dog = Dog (MkDog "Shep" 3)
59-- cat = Cat "Mog" 5
60-- duck = Duck 2
61-- :}
63-- |Sums that have generic prisms.
64class AsAny (sel :: k) a s | s sel k -> a where
65 -- |A prism that projects a sum as identified by some selector. Currently
66 -- supported selectors are constructor names and unique types. Compatible
67 -- with the lens package's 'Control.Lens.Prism' type.
68 --
69 -- >>> dog ^? _As @"Dog"
70 -- Just (MkDog {name = "Shep", age = 3})
71 --
72 -- >>> dog ^? _As @Dog
73 -- Just (MkDog {name = "Shep", age = 3})
74 --
75 -- >>> dog ^? _As @"Cat"
76 -- Nothing
77 --
78 -- >>> cat ^? _As @(Name, Age)
79 -- Just ("Mog",5)
80 --
81 -- >>> cat ^? _As @"Cat"
82 -- Just ("Mog",5)
83 --
84 -- >>> _As @"Cat" # ("Garfield", 6) :: Animal
85 -- Cat "Garfield" 6
86 --
87 -- >>> duck ^? _As @Age
88 -- Just 2
89 _As :: Prism' s a
91instance AsConstructor ctor s s a a => AsAny ctor a s where
92 _As = _Ctor @ctor
94instance AsType a s => AsAny a a s where
95 _As = _Typed @a