git.iko.soy/generic-lens
on bfcd00a help sign in
generic-lens/src/Data/Generics/Sum/Any.hs
90 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 -- $example
28 AsAny (..)
29 ) where
31import Data.Generics.Internal.Lens
32import Data.Generics.Sum.Constructors
33import Data.Generics.Sum.Typed
35-- $example
36-- @
37-- module Example where
38--
39-- import Data.Generics.Sum
40-- import GHC.Generics
41--
42-- data Animal
43-- = Dog Dog
44-- | Cat Name Age
45-- | Duck Age
46-- deriving (Generic, Show)
47--
48-- data Dog = MkDog
49-- { name :: Name
50-- , age :: Age
51-- }
52-- deriving (Generic, Show)
53--
54-- type Name = String
55-- type Age = Int
56--
57-- dog, cat, duck :: Animal
58--
59-- dog = Dog (MkDog "Shep" 3)
60-- cat = Cat "Mog" 5
61-- duck = Duck 2
62-- @
64-- |Sums that have generic prisms.
65class AsAny (sel :: k) a s | s sel k -> a where
66 -- |A prism that projects a sum as identified by some selector. Currently
67 -- supported selectors are constructor names and unique types. Compatible
68 -- with the lens package's 'Control.Lens.Prism' type.
69 --
70 -- >>> dog ^? _As @"Dog"
71 -- Just (MkDog {name = "Shep", age = 3})
72 -- >>> dog ^? _As @Dog
73 -- Just (MkDog {name = "Shep", age = 3})
74 -- >>> dog ^? _As @"Cat"
75 -- Nothing
76 -- >>> cat ^? _As @(Name, Age)
77 -- Just ("Mog",5)
78 -- >>> cat ^? _As @"Cat"
79 -- Just ("Mog",5)
80 -- >>> _As @"Cat" # ("Garfield", 6) :: Animal
81 -- Cat ("Garfield",6)
82 -- >>> duck ^? _As @Age
83 -- Just 2
84 _As :: Prism' s a
86instance AsConstructor ctor a s => AsAny ctor a s where
87 _As = _Ctor @ctor
89instance AsType a s => AsAny a a s where
90 _As = _Typed @a