microlens-pro (empty) → 0.1.0
raw patch · 8 files changed
+1607/−0 lines, 8 filesdep +basedep +containersdep +contravariant
Dependencies added: base, containers, contravariant, microlens, microlens-contra, microlens-platform, microlens-th, mtl, profunctors, tagged, template-haskell, text, th-abstraction, unordered-containers, vector
Files
- CHANGELOG.md +3/−0
- LICENSE +32/−0
- microlens-pro.cabal +90/−0
- src/Lens/Micro/Pro.hs +730/−0
- src/Lens/Micro/Pro/Internal.hs +116/−0
- src/Lens/Micro/Pro/TH.hs +556/−0
- src/Lens/Micro/Pro/Type.hs +57/−0
- src/Lens/Micro/ProCompat.hs +23/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0.0++[#105](https://github.com/stevenfontanella/microlens/issues/105) microlens-pro initial release, with `Prism`s and `Iso`s.
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2013-2016 Edward Kmett,+ 2015-2016 Artyom Kazak,+ 2018 Monadfix++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 Monadfix 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.
+ microlens-pro.cabal view
@@ -0,0 +1,90 @@+name: microlens-pro+version: 0.1.0+synopsis: Prisms and isomorphisms for microlens+description:+ This package provides lens-compatible 'Prism' and 'Iso'. Consequently, it+ depends on the rather heavy @profunctors@.+ .+ Thank you to the <https://hackage.haskell.org/package/lens lens> contributors+ for the original code and some docs,+ Emily Pillmore (<https://cohomolo.gy link>) and+ Mario Román (<https://mroman42.github.io/cosmoi link>) for+ <https://golem.ph.utexas.edu/category/2020/01/profunctor_optics_the_categori.html this post>+ which inspired documentation, and Wikibooks contributors for+ <https://en.wikibooks.org/wiki/Haskell/Lenses_and_functional_references#Isos this article>.+ .+ This package is a part of the+ <https://hackage.haskell.org/package/microlens microlens> family; see the+ readme <https://github.com/stevenfontanella/microlens on Github>.+license: BSD3+license-file: LICENSE+author: Edward Kmett, Artyom Kazak, crumbtoo <lomiskiam@gmail.com>+maintainer: Steven Fontanella <steven.fontanella@gmail.com>+homepage: http://github.com/stevenfontanella/microlens+bug-reports: http://github.com/stevenfontanella/microlens/issues+category: Data, Lenses+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10++tested-with:+ GHC==9.8.1+ GHC==9.6.3+ GHC==9.4.7+ GHC==9.2.8+ GHC==9.0.2+ GHC==8.10.7+ GHC==8.8.4+ GHC==8.6.5+ GHC==8.4.4+ GHC==8.2.2+ GHC==8.0.2+ GHC==7.10.3++source-repository head+ type: git+ location: git://github.com/stevenfontanella/microlens.git++library+ exposed-modules: Lens.Micro.Pro+ Lens.Micro.ProCompat+ Lens.Micro.Pro.TH+ Lens.Micro.Pro.Internal+ Lens.Micro.Pro.Type++ -- other-modules:+ -- other-extensions:+ build-depends: base >=4.5 && <5+ , containers >=0.4.0 && <0.8+ , unordered-containers >=0.2.4 && <0.3+ , microlens >=0.4.11.3 && <0.5+ , microlens-th >=0.4.3.3 && <0.5+ , microlens-contra >=0.1.0 && <0.2+ , microlens-platform >=0.4.3 && <0.5+ , profunctors >=5.2.1 && <6+ , tagged >=0.4.4 && <1+ , template-haskell >=2.7 && <2.22+ , th-abstraction >=0.6.0 && <0.7+ , mtl >=2.2.2 && <2.4+ , text >=1.2 && <2.2+ , vector >=0.12.0 && <0.14+ default-extensions:+ RankNTypes+ PolyKinds+ KindSignatures+ FlexibleInstances++ if impl(ghc <= 8.6.5)+ build-depends: contravariant >=0.1.0 && <1.5.6++ ghc-options:+ -Wall -fwarn-tabs+ -O2 -fdicts-cheap -funbox-strict-fields+ -fmax-simplifier-iterations=10+ if impl(ghc >= 8.6.5)+ ghc-options:+ -Wno-orphans++ hs-source-dirs: src+ default-language: Haskell2010+
+ src/Lens/Micro/Pro.hs view
@@ -0,0 +1,730 @@+{-|+Module : Lens.Micro.Pro+Copyright : (C) 2013-2016 Edward Kmett, 2018 Monadfix+License : BSD-style (see the file LICENSE)++This module is home to lens definitions that require+[profunctors](https://hackage.haskell.org/package/profunctors), most notably+'Iso' and 'Prism'. Depending on 'profunctors' is quite the to bear — one+that includes all dependencies of @microlens-platform@. For this reason,+@microlens-pro@ ships with a compatiblity module "Lens.Micro.ProCompat" which+re-exports the entirety of "Lens.Micro.Platform", but with the profunctor-less+definitions hidden and overridden with profunctor'd definitions from this module.+-}++{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE CPP #-}++#ifndef MIN_VERSION_GLASGOW_HASKELL+# define MIN_VERSION_GLASGOW_HASKELL(x,y,z,z2) 1+#endif++module Lens.Micro.Pro+ (+ -- * Iso: Losslessly convert between types+ -- $isos-note+ Iso, Iso'+ -- ** Constructing Isos+ , iso+ -- ** Iso Combinators+ , from+ , under+ , non, non'+ -- ** Common Isos+ , _Show+ , strict, lazy+ , enum+ , coerced+ , mapping+ , packed, unpacked+ -- ** Miscellaneous+ , AnIso, AnIso'+ , cloneIso+ , withIso++ -- * Prism: A traversal with zero or one targets+ -- $prisms-note+ , Prism, Prism'+ -- ** Constructing Prisms+ , prism, prism'+ -- ** Prism Combinators+ , nearly+ , only+ -- ** Common Prisms+ , _Left, _Right+ , _Just, _Nothing+ , _Empty+ -- ** Miscellaneous+ , APrism, APrism'+ , clonePrism+ , withPrism++ -- * Review+ , AReview+ , SimpleReview+ , re+ , review+ , (#)+ , unto+ )+ where+--------------------------------------------------------------------------------+import Lens.Micro (has)+import Lens.Micro.Contra+import Lens.Micro.Pro.Type+import Lens.Micro.Pro.Internal+import Control.Monad (guard)+import Control.Monad.Reader.Class+import Data.Coerce+import Data.Maybe+import Data.Tagged+import Data.Functor.Contravariant+import Data.Functor.Identity+import Data.Bifunctor+import Data.Void+import Data.Profunctor+import Data.Profunctor.Unsafe++#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0)+import GHC.Exts (TYPE)+#endif++-- implement instances+import qualified Data.Text as Text+import qualified Data.Text.Lazy as Text.Lazy+import qualified Data.HashMap.Strict as HashMap.Strict+import qualified Data.Map as Map+import qualified Data.Vector as Vector+--------------------------------------------------------------------------------++{- | This type is used for efficient "deconstruction" of an 'Iso', reifying+the type into a concrete pair of inverse functions. From the user's perspective,+a function with an 'AnIso' as an argument is simply expecting a normal 'Iso'.+-}++type AnIso s t a b = Exchange a b a (Identity b)+ -> Exchange a b s (Identity t)++-- | Monomorphic 'AnIso'.++type AnIso' s a = AnIso s s a a++-- | This type is used for effecient "deconstruction" of a 'Prism'. From the+-- user's perspective, a function with an 'AnPrism' as an argument is simply+-- expecting a normal 'Prism'.++type APrism s t a b = Market a b a (Identity b) -> Market a b s (Identity t)++-- | Monomorphic 'APrism'.++type APrism' s a = Market a a a (Identity a) -> Market a a s (Identity s)++-- | Convert 'AnIso' to 'Iso'. This is useful when you need to store an+-- isomorphism as a data type inside a container and later reconstitute it as an+-- overloaded function.++cloneIso :: AnIso s t a b -> Iso s t a b+cloneIso k = withIso k $ \sa bt -> iso sa bt++{-# INLINE cloneIso #-}++{- $isos-note++Isos (or isomorphisms) are lenses that convert a value instead of targeting a+part of it; in other words, inside of every list lives a reversed list, inside+of every strict @Text@ lives a lazy @Text@, and inside of every @(a, b)@ lives a+@(b, a)@. Since an isomorphism doesn't lose any information, it's possible to+/reverse/ it and use it in the opposite direction by using @from@:++@+from :: Iso' s a -> Iso' a s+from :: Iso s t a b -> Iso t s b a+@++Isos are constructed from a pair of inverse functions. For example, assume+lawful instances of 'Show' and 'Read':++@+show . read = id+read . show = id+@++The isomorphisms defined in this module are true lens-compatible isos. Many of+them share names with the lens-__incompatible__ definitions from+[Lens.Micro](https://hackage.haskell.org/package/microlens-0.4.13.1/docs/Lens-Micro.html#g:5)+and+[Lens.Micro.Platform](https://hackage.haskell.org/package/microlens-platform-0.4.3.4/docs/Lens-Micro-Platform.html).+For convenience, we provide a module "Lens.Micro.ProCompat" which emulates+Lens.Micro.Platform, but uses the lens-compatible isos.++-}++-- | Construct an 'Iso' from two inverse functions.++iso :: (s -> a) -> (b -> t) -> Iso s t a b+iso sa bt = dimap sa (fmap bt)++{-# INLINE iso #-}++-- | Invert an 'Iso'. Should you define any 'Iso's, it's expected that they+-- abide by the following law, essentially saying that inverting an 'Iso' twice+-- yields the same 'Iso' you started with.+--+-- @+-- 'from' ('from' l) ≡ l+-- @++from :: AnIso s t a b -> Iso b a t s+from l = withIso l $ \sa bt -> iso bt sa++{-# INLINE from #-}++{- |+Shorthand for @'Lens.Micro.over' '.' 'from'@, e.g.++@+s & 'over' ('from' l) f ≡ s & 'under' l f+@+-}+under :: AnIso s t a b -> (t -> s) -> b -> a+under k = withIso k $ \ sa bt ts -> sa . ts . bt++{-# INLINE under #-}++-- | Extract the two functions, @s -> a@ and one @b -> t@ that characterize an+-- 'Iso'.++#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0)+withIso :: forall s t a b rep (r :: TYPE rep).+ AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r+#else+withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r+#endif+withIso ai k = case ai (Exchange id Identity) of+ Exchange sa bt -> k sa (runIdentity #. bt)++{-# INLINE withIso #-}++{- |+Lawful instances of 'Show' and 'Read' give rise to this isomorphism.++@+>>> 123 & from _Show %~ reverse+321+>>> "123" & _Show %~ (*2)+"246"+@+-}++_Show :: (Read a, Show a) => Iso' String a+_Show = iso read show++{-# INLINE _Show #-}++{- |+'enum' is a questionable inclusion, as many (most) 'Enum' instances throw+errors for out-of-bounds integers, but it is occasionally useful when used with+that information in mind. Handle with care!++>>> 97 ^. enum :: Char+'a'+>>> (-1) ^. enum :: Char+*** Exception: Prelude.chr: bad argument: (-1)+>>> [True,False] ^. mapping (from enum)+[1,0]+-}++enum :: (Enum a) => Iso' Int a+enum = iso toEnum fromEnum++{-# INLINE enum #-}++{- |+'non' lets you “relabel” a 'Maybe' by equating 'Nothing' to an arbitrary value+(which you can choose):++>>> Just 1 ^. non 0 1++>>> Nothing ^. non 0 0++The most useful thing about 'non' is that relabeling also works in other+direction. If you try to 'set' the “forbidden” value, it'll be turned to+'Nothing':++>>> Just 1 & non 0 .~ 0 Nothing++Setting anything else works just fine:++>>> Just 1 & non 0 .~ 5 Just 5++Same happens if you try to modify a value:++>>> Just 1 & non 0 %~ subtract 1 Nothing++>>> Just 1 & non 0 %~ (+ 1) Just 2++'non' is often useful when combined with 'at'. For instance, if you have a map+of songs and their playcounts, it makes sense not to store songs with 0 plays in+the map; 'non' can act as a filter that wouldn't pass such entries.++Decrease playcount of a song to 0, and it'll be gone:++>>> fromList [("Soon",1),("Yesterday",3)] & at "Soon" . non 0 %~ subtract 1+fromList [("Yesterday",3)]++Try to add a song with 0 plays, and it won't be added:++>>> fromList [("Yesterday",3)] & at "Soon" . non 0 .~ 0+fromList [("Yesterday",3)]++But it will be added if you set any other number:++>>> fromList [("Yesterday",3)] & at "Soon" . non 0 .~ 1+fromList [("Soon",1),("Yesterday",3)]++'non' is also useful when working with nested maps. Here a nested map is created+when it's missing:++>>> Map.empty & at "Dez Mona" . non Map.empty . at "Soon" .~ Just 1+fromList [("Dez Mona",fromList [("Soon",1)])]++and here it is deleted when its last entry is deleted (notice that 'non' is used+twice here):++>>> fromList [("Dez Mona",fromList [("Soon",1)])] & at "Dez Mona" . non Map.empty . at "Soon" . non 0 %~ subtract 1+fromList []++To understand the last example better, observe the flow of values in it:++* the map goes into @at \"Dez Mona\"@ * the nested map (wrapped into @Just@)+goes into @non Map.empty@ * @Just@ is unwrapped and the nested map goes into @at+\"Soon\"@ * @Just 1@ is unwrapped by @non 0@++Then the final value – i.e. 1 – is modified by @subtract 1@ and the result+(which is 0) starts flowing backwards:++* @non 0@ sees the 0 and produces a @Nothing@++* @at \"Soon\"@ sees @Nothing@ and deletes the corresponding value from the map++* the resulting empty map is passed to @non Map.empty@, which sees that it's+empty and thus produces @Nothing@++* @at \"Dez Mona\"@ sees @Nothing@ and removes the key from the map+-}++non :: (Eq a) => a -> Iso' (Maybe a) a+non a = non' $ only a++{-# INLINE non #-}++{- |+'non', but instead of equality with a value, 'non'' equates 'Nothing' to+anything a 'Prism' of your choice doesn't match.++>>> Just [] & non' _Empty .~ [1,2,3]+Just [1,2,3]+>>> Just [] & non' _Empty .~ []+Nothing++See 'non' for cases this may be useful.+-}++non' :: APrism' a () -> Iso' (Maybe a) a+non' p = iso (fromMaybe def) go where+ def = review (clonePrism p) ()+ go b | has (clonePrism p) b = Nothing+ | otherwise = Just b++{-# INLINE non' #-}++{- |+Coercible types have the same runtime representation, i.e. they are isomorphic.++>>> (Sum 123 :: Sum Int) ^. coerced :: Int+123+-}++coerced :: forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b+coerced l = rmap (fmap coerce) l .# coerce++{-# INLINE coerced #-}++{- |+An isomorphism holds when lifted into a functor. For example, if a list contains+a bunch of @a@'s which are each isomorphic to a @b@, the whole list of @a@'s is+isomorphic to a list of @b@'s.++>>> ["1","2","3"] ^. mapping _Show :: [Int]+[1,2,3]+>>> ([1,2,3] :: [Int]) ^. from (mapping _Show)+["1","2","3"]++This also hold across different functors:++>>> let l = mapping @[] @Maybe _Show+>>> :t l+l :: (Read b, Show b) => Iso [String] (Maybe String) [b] (Maybe b)+>>> ["1","2","3"] & l %~ Just . sum+Just "6"+-}++mapping :: (Functor f, Functor g) => AnIso s t a b -> Iso (f s) (g t) (f a) (g b)+mapping k = withIso k $ \ sa bt -> iso (fmap sa) (fmap bt)++{-# INLINE mapping #-}++--------------------------------------------------------------------------------+++{- $prisms-note++If a 'Lens' views and updates individual components of /product/ types, a+'Prism' views and updates individual components of /sum/ types. For example, you+may want to update the 'Left' field of an 'Either':++>>> Left "salmon" & _Left .~ "orb"+Left "orb"+>>> Right "pudding" & _Left .~ "orb"+Right "pudding"++Also similarly to a 'Lens', you might want to view the 'Left' field. However, it+might not always be there, so we treat it as a traversal with either one or zero+results.++>>> Right "bass" ^? _Left+Nothing+>>> Left "bubbles" ^? _Left+Just "bubbles"++A unique feature of 'Prism's is that they may be flipped around using 're' to+construct the larger structure. Maintaining our example of 'Either', remember+that you can construct the entire 'Either' via the constructor 'Left'.++>>> :t re _Left+re _Left :: Getter b (Either b c)+>>> view (re _Left) "bungo"+Left "bungo"++This @'view' ('re' l)@ idiom isn't the prettiest, so we define @'review' =+'view' . 're'@ as shorthand. 'review' also has an infix synonym, '(#)'.++>>> :t _Just+_Just :: Prism (Maybe a) (Maybe b) a b+>>> review _Just "bilbo"+Just "bilbo"+>>> _Just # "bilbo"+Just "bilbo"++As is the whole point of optics, prisms may of course be composed with other+optics:++@+type Thing = Either (Maybe String) (Maybe (Either [Bool] Int))+thing :: Thing+thing = Right (Just (Left [True,False]))+@+>>> thing & _Right . _Just . _Left . each %~ not+Right (Just (Left [False,True]))++-}++{- |+Generate a 'Prism' out of a constructor and a selector. You may wonder+why the selector function returns an 'Either t a' rather than the more obvious+choice of 'Maybe a'; This is to allow @s@ and @t@ to differ — see 'prism''.++@+_Left = prism Left $ either Right (Left . Right)+@+-}++prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b+prism bt seta = dimap seta (either pure (fmap bt)) . right'++{-# INLINE prism #-}++{- |+Generate a 'Prism' out of a constructor and a selector.++@+_Nothing = prism Left $ either Right (Left . Right)+@+-}++prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b+prism' bs sma = prism bs (\s -> maybe (Left s) Right (sma s))++{-# INLINE prism' #-}++{- |+Clone a Prism so that you can reuse the same monomorphically typed Prism for+different purposes.++Cloning a 'Prism' is one way to make sure you aren't given something weaker,+such as a 'Traversal' and can be used as a way to pass around lenses that have+to be monomorphic in @f@.+-}++clonePrism :: APrism s t a b -> Prism s t a b+clonePrism k = withPrism k $ \bt sta -> prism bt sta++{-# INLINE clonePrism #-}++{- |+Convert a 'Prism' into the constructor and selector that characterise it. See:+'prism'.+-}++withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r+withPrism k f = case coerce (k (Market Identity Right)) of+ Market bt seta -> f bt seta++{-# INLINE withPrism #-}++{- |+Focus the 'Just' of a 'Maybe'. This might seem redundant, as:++>>> Just "pikyben" ^? _Just+Just "pikyben"++but '_Just' proves useful when composing with other optics.+-}++_Just :: Prism (Maybe a) (Maybe b) a b+_Just = prism Just $ maybe (Left Nothing) Right++{-# INLINE _Just #-}++{- |+'_Nothing' focuses the 'Nothing' in a 'Maybe'.++>>> Nothing ^? _Nothing +Just ()+>>> Just "wassa" ^? _Nothing +Nothing+>>> 'has' _Nothing (Just "something")+False+-}+_Nothing :: Prism' (Maybe a) ()+_Nothing = prism' (const Nothing) $ maybe (Just ()) (const Nothing)++{-# INLINE _Nothing #-}++{- |+Focus the 'Left' component of an 'Either'++>>> Left "doge" ^? _Left+Just "doge"+>>> Right "soge" ^? _Left+Nothing+>>> review _Left "quoge"+Left "quoge"+-}++_Left :: Prism (Either a c) (Either b c) a b+_Left = prism Left $ either Right (Left . Right)++{-# INLINE _Left #-}++{- |+Focus the 'Right' component of an 'Either'++>>> Left "doge" ^? _Right+Nothing+>>> Right "soge" ^? _Right+Just "soge"+>>> review _Right "quoge"+Right "quoge"+-}++_Right :: Prism (Either c a) (Either c b) a b+_Right = prism Right $ either (Left . Left) Right++{-# INLINE _Right #-}++class AsEmpty a where+ {- |+ A prism that matches the empty structure.++ >>> has _Empty []+ True+ -}+ _Empty :: Prism' a ()+ default _Empty :: (Monoid a, Eq a) => Prism' a ()+ _Empty = only mempty+ {-# INLINE _Empty #-}++instance AsEmpty [a] where+ _Empty = nearly [] null+ {-# INLINE _Empty #-}++instance AsEmpty (Map.Map k v) where+ _Empty = nearly Map.empty Map.null+ {-# INLINE _Empty #-}++instance AsEmpty (Maybe a) where+ _Empty = _Nothing+ {-# INLINE _Empty #-}++instance AsEmpty (HashMap.Strict.HashMap k v) where+ _Empty = nearly HashMap.Strict.empty HashMap.Strict.null+ {-# INLINE _Empty #-}++instance AsEmpty (Vector.Vector a) where+ _Empty = nearly Vector.empty Vector.null+ {-# INLINE _Empty #-}++instance AsEmpty Text.Text where+ _Empty = nearly Text.empty Text.null+ {-# INLINE _Empty #-}++instance AsEmpty Text.Lazy.Text where+ _Empty = nearly Text.Lazy.empty Text.Lazy.null+ {-# INLINE _Empty #-}++{- |+A prism that matches equality with a value:++>>> 1 ^? only 2+Nothing+>>> 1 ^? only 1+Just 1+-}++only :: Eq a => a -> Prism' a ()+only a = prism' (\() -> a) $ guard . (a ==)++{-# INLINE only #-}++{- |+@'nearly' a p@ is a prism that matches "loose equality" with @a@ by assuming @p+x@ is true iff @x ≡ a@.++>>> nearly [] null # ()+[]+>>> [1,2,3,4] ^? nearly [] null+Nothing+-}++nearly :: a -> (a -> Bool) -> Prism' a ()+nearly a p = prism' (\() -> a) $ guard . p++{-# INLINE nearly #-}++{- |+If you see this in a signature for a function, the function is expecting a+Review. This usually means a 'Prism' or an 'Iso'.+-}+type AReview t b = Tagged b (Identity b) -> Tagged t (Identity t)++{- |+[@Review@](https://hackage.haskell.org/package/lens-5.2.3/docs/Control-Lens-Type.html#t:Review),+from lens, is limited form of 'Prism' that can only be used for 're' operations.++Similarly to 'SimpleGetter' from microlens, microlens-pro does not define 'Review' and opts for+a less general 'SimpleReview' in order to avoid a+[distributive](https://hackage.haskell.org/package/distributive-0.6.2.1)+dependency.+-}++type SimpleReview t b = forall p. (Choice p, Bifunctor p)+ => p b (Identity b) -> p t (Identity t)++{-|+Reverse a 'Prism' or 'Iso' and 'view' it++@+review ≡ view . re+@++@+>>> review _Just "sploink"+Just "sploink"+@++'review' is often used with the function monad, @((->)r)@:++@+review :: AReview t b -> b -> t+@+-}++review :: MonadReader b m => AReview t b -> m t+review p = asks (runIdentity #. unTagged #. p .# Tagged .# Identity)++{-# INLINE review #-}++{-|+Reverse a 'Prism' or 'Iso' turning it into a getter. 're' is a weaker version of+'from', in that you can't flip it back around after reversing it the first time.++>>> "hello worms" ^. re _Just+Just "hello worms"+-}++re :: AReview t b -> Getter b t+re p = to (runIdentity #. unTagged #. p .# Tagged .# Identity)++{-# INLINE re #-}++-- | An infix synonym of 'review'+(#) :: AReview t b -> b -> t+(#) p = runIdentity #. unTagged #. p .# Tagged .# Identity++infixr 8 #+{-# INLINE (#) #-}++-- TODO: `to` is temporarily defined here. This should be in microlens-contra,+-- or better yet, microlens as Contravariant has been in base since at least ghc+-- 8.6.5. This definition isn't perfect either -- the version from lens is:+--+-- to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a++to :: (s -> a) -> Getter s a+to k = dimap k (contramap k)++{-# INLINE to #-}++{- |+Construct a 'Review' out of a constructor. Consider this more pleasant type+signature:++@+unto :: (b -> t) -> Review' t b+@++Pardon the actual type signature — microlens defines neither @Optic@ (used in+lens'+[@unto@](https://hackage.haskell.org/package/lens-5.2.3/docs/Control-Lens-Combinators.html#v:unto)) nor @Review'@. Here we simply expand the definition of @Optic@.+-}+unto :: (Profunctor p, Bifunctor p, Functor f)+ => (b -> t)+ -> p a (f b) -> p s (f t)+unto f = first absurd . lmap absurd . rmap (fmap f)++{-# INLINE unto #-}++--------------------------------------------------------------------------------++instance IsText [Char] where+ packed = id+ unpacked = id++ {-# INLINE packed #-}+ {-# INLINE unpacked #-}++instance IsText Text.Text where+ packed = iso Text.pack Text.unpack+ unpacked = iso Text.unpack Text.pack++ {-# INLINE packed #-}+ {-# INLINE unpacked #-}++instance IsText Text.Lazy.Text where+ packed = iso Text.Lazy.pack Text.Lazy.unpack+ unpacked = iso Text.Lazy.unpack Text.Lazy.pack++ {-# INLINE packed #-}+ {-# INLINE unpacked #-}+
+ src/Lens/Micro/Pro/Internal.hs view
@@ -0,0 +1,116 @@+{-|+Module : Lens.Micro.Pro.Internal+Copyright : (C) 2013-2016 Edward Kmett, 2018 Monadfix+License : BSD-style (see the file LICENSE)++Definitions used internally by microlens. If you're going to use these, only+define instances for your own types, and don't export an API using these!+-}+{-# LANGUAGE FunctionalDependencies #-}+module Lens.Micro.Pro.Internal+ ( Strict(strict, lazy)++ , IsText(packed, unpacked)++ , Exchange(..), Exchange'+ , Market(..), Market'++ , Iso, Iso'+ , Prism, Prism'+ )+ where+--------------------------------------------------------------------------------+import Lens.Micro.Pro.Type+import Data.Coerce+import Data.Profunctor+import Data.Profunctor.Unsafe+--------------------------------------------------------------------------------++class Strict lazy strict | lazy -> strict, strict -> lazy where+ strict :: Iso' lazy strict+ lazy :: Iso' strict lazy++{- | This type is used internally to provide efficient access+to the two inverse functions behind an 'Iso'.+-}++data Exchange a b s t = Exchange (s -> a) (b -> t)++type Exchange' a s = Exchange a a s s++instance Functor (Exchange a b s) where+ fmap f (Exchange sa bt) = Exchange sa (f . bt)+ {-# INLINE fmap #-}++instance Profunctor (Exchange a b) where+ dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt)+ lmap f (Exchange sa bt) = Exchange (sa . f) bt+ rmap f (Exchange sa bt) = Exchange sa (f . bt)++ {-# INLINE dimap #-}+ {-# INLINE lmap #-}+ {-# INLINE rmap #-}++ (#.) _ = coerce+ (.#) p _ = coerce p++ {-# INLINE (#.) #-}+ {-# INLINE (.#) #-}++{- | This type is used internally by the Prism code to provide efficient access+to the two parts of a Prism, i.e. a constructor and a selector — see:+'Lens.Micro.Pro.prism'.+-}+data Market a b s t = Market (b -> t) (s -> Either t a)++instance Functor (Market a b s) where+ fmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta)+ {-# INLINE fmap #-}++instance Profunctor (Market a b) where+ dimap f g (Market bt seta) =+ Market (g . bt) (either (Left . g) Right . seta . f)++ lmap f (Market bt seta) = Market bt (seta . f)+ rmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta)++ {-# INLINE rmap #-}+ {-# INLINE lmap #-}+ {-# INLINE dimap #-}++ (#.) _ = coerce+ (.#) p _ = coerce p++ {-# INLINE (#.) #-}+ {-# INLINE (.#) #-}++instance Choice (Market a b) where+ left' (Market bt seta) = Market (Left . bt) $ \sc -> case sc of+ Left s -> case seta s of+ Left t -> Left (Left t)+ Right a -> Right a+ Right c -> Left (Right c)++ right' (Market bt seta) = Market (Right . bt) $ \cs -> case cs of+ Left c -> Left (Left c)+ Right s -> case seta s of+ Left t -> Left (Right t)+ Right a -> Right a++ {-# INLINE right' #-}+ {-# INLINE left' #-}++type Market' a s = Market a a s s++class IsText t where++ -- | 'packed' lets you convert between 'String' and @Text@ (strict or lazy).+ -- It can be used as a replacement for @pack@ or as a way to modify some+ -- 'String' if you have a function like @Text -> Text@.++ packed :: Iso' String t++ -- | 'unpacked' is like 'packed' but works in the opposite direction.++ unpacked :: Iso' t String+
+ src/Lens/Micro/Pro/TH.hs view
@@ -0,0 +1,556 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-}++#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-trustworthy-safe #-}+#endif++#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TemplateHaskellQuotes #-}+#else+{-# LANGUAGE TemplateHaskell #-}+#endif++{- |+Module : Lens.Micro.Pro.TH+Copyright : (C) 2014-2016 Eric Mertens, Edward Kmett; 2018 Monadfix+License : BSD-style (see the file LICENSE)++Template Haskell functions to automatically define prisms.+-}+module Lens.Micro.Pro.TH+(+ makePrisms,+ makeClassyPrisms,+)+where++import Lens.Micro+import Lens.Micro.Extras+import Lens.Micro.Pro+import Lens.Micro.TH.Internal+ (HasTypeVars(..), typeVars, substTypeVars, newNames, conAppsT, inlinePragma)++import Data.Char (isUpper)+import Data.List+import Data.Monoid+import qualified Data.Set as Set+import Data.Set (Set)+import Data.Traversable+import Language.Haskell.TH+import Language.Haskell.TH.Datatype.TyVarBndr+import qualified Language.Haskell.TH.Datatype as D+import qualified Data.Map as Map++-- | Generate a 'Prism' for each constructor of a data type.+-- Isos generated when possible.+-- Reviews are created for constructors with existentially+-- quantified constructors and GADTs.+--+-- /e.g./+--+-- @+-- data FooBarBaz a+-- = Foo Int+-- | Bar a+-- | Baz Int Char+-- makePrisms ''FooBarBaz+-- @+--+-- will create+--+-- @+-- _Foo :: Prism' (FooBarBaz a) Int+-- _Bar :: Prism (FooBarBaz a) (FooBarBaz b) a b+-- _Baz :: Prism' (FooBarBaz a) (Int, Char)+-- @+makePrisms :: Name {- ^ Type constructor name -} -> DecsQ+makePrisms = makePrisms' True++-- | Generate a 'Prism' for each constructor of a data type+-- and combine them into a single class. No Isos are created.+-- Reviews are created for constructors with existentially+-- quantified constructors and GADTs.+--+-- /e.g./+--+-- @+-- data FooBarBaz a+-- = Foo Int+-- | Bar a+-- | Baz Int Char+-- makeClassyPrisms ''FooBarBaz+-- @+--+-- will create+--+-- @+-- class AsFooBarBaz s a | s -> a where+-- _FooBarBaz :: Prism' s (FooBarBaz a)+-- _Foo :: Prism' s Int+-- _Bar :: Prism' s a+-- _Baz :: Prism' s (Int,Char)+--+-- _Foo = _FooBarBaz . _Foo+-- _Bar = _FooBarBaz . _Bar+-- _Baz = _FooBarBaz . _Baz+--+-- instance AsFooBarBaz (FooBarBaz a) a+-- @+--+-- Generate an "As" class of prisms. Names are selected by prefixing the constructor+-- name with an underscore. Constructors with multiple fields will+-- construct Prisms to tuples of those fields.+--+-- In the event that the name of a data type is also the name of one of its+-- constructors, the name of the 'Prism' generated for the data type will be+-- prefixed with an extra @_@ (if the data type name is prefix) or @.@ (if the+-- name is infix) to disambiguate it from the 'Prism' for the corresponding+-- constructor. For example, this code:+--+-- @+-- data Quux = Quux Int | Fred Bool+-- makeClassyPrisms ''Quux+-- @+--+-- will create:+--+-- @+-- class AsQuux s where+-- __Quux :: Prism' s Quux -- Data type prism+-- _Quux :: Prism' s Int -- Constructor prism+-- _Fred :: Prism' s Bool+--+-- _Quux = __Quux . _Quux+-- _Fred = __Quux . _Fred+--+-- instance AsQuux Quux+-- @+makeClassyPrisms :: Name {- ^ Type constructor name -} -> DecsQ+makeClassyPrisms = makePrisms' False++-- | Main entry point into Prism generation for a given type constructor name.+makePrisms' :: Bool -> Name -> DecsQ+makePrisms' normal typeName =+ do info <- D.reifyDatatype typeName+ let cls | normal = Nothing+ | otherwise = Just (D.datatypeName info)+ cons = D.datatypeCons info+ makeConsPrisms (D.datatypeType info) (map normalizeCon cons) cls+++-- | Generate prisms for the given type, normalized constructors, and+-- an optional name to be used for generating a prism class.+-- This function dispatches between Iso generation, normal top-level+-- prisms, and classy prisms.+makeConsPrisms :: Type -> [NCon] -> Maybe Name -> DecsQ++-- special case: single constructor, not classy -> make iso+makeConsPrisms t [con@(NCon _ [] [] _)] Nothing = makeConIso t con++-- top-level definitions+makeConsPrisms t cons Nothing =+ fmap concat $ for cons $ \con ->+ do let conName = view nconName con+ stab <- computeOpticType t cons con+ let n = prismName conName+ sequenceA+ ( [ sigD n (close (stabToType stab))+ , valD (varP n) (normalB (makeConOpticExp stab cons con)) []+ ]+ ++ inlinePragma n+ )+++-- classy prism class and instance+makeConsPrisms t cons (Just typeName) =+ sequenceA+ [ makeClassyPrismClass t className methodName cons+ , makeClassyPrismInstance t className methodName cons+ ]+ where+ typeNameBase = nameBase typeName+ className = mkName ("As" ++ typeNameBase)+ sameNameAsCon = any (\con -> nameBase (view nconName con) == typeNameBase) cons+ methodName = prismName' sameNameAsCon typeName+++data OpticType = PrismType | ReviewType+data Stab = Stab Cxt OpticType Type Type Type Type++simplifyStab :: Stab -> Stab+simplifyStab (Stab cx ty _ t _ b) = Stab cx ty t t b b+ -- simplification uses t and b because those types+ -- are interesting in the Review case++stabSimple :: Stab -> Bool+stabSimple (Stab _ _ s t a b) = s == t && a == b++stabToType :: Stab -> Type+stabToType stab@(Stab cx ty s t a b) = ForallT vs cx $+ case ty of+ PrismType | stabSimple stab -> ''Prism' `conAppsT` [t,b]+ | otherwise -> ''Prism `conAppsT` [s,t,a,b]+ ReviewType -> ''AReview `conAppsT` [t,b]++ where+ vs = map plainTVInferred+ $ nub -- stable order+ $ toListOf typeVars cx++stabType :: Stab -> OpticType+stabType (Stab _ o _ _ _ _) = o++computeOpticType :: Type -> [NCon] -> NCon -> Q Stab+computeOpticType t cons con =+ do let cons' = delete con cons+ if null (_nconVars con)+ then computePrismType t (view nconCxt con) cons' con+ else computeReviewType t (view nconCxt con) (view nconTypes con)+++computeReviewType :: Type -> Cxt -> [Type] -> Q Stab+computeReviewType s' cx tys =+ do let t = s'+ s <- fmap VarT (newName "s")+ a <- fmap VarT (newName "a")+ b <- toTupleT (map return tys)+ return (Stab cx ReviewType s t a b)+++-- | Compute the full type-changing Prism type given an outer type,+-- list of constructors, and target constructor name. Additionally+-- return 'True' if the resulting type is a "simple" prism.+computePrismType :: Type -> Cxt -> [NCon] -> NCon -> Q Stab+computePrismType t cx cons con =+ do let ts = view nconTypes con+ unbound = setOf typeVars t Set.\\ setOf typeVars cons+ sub <- sequenceA (fromSet (newName . nameBase) unbound)+ b <- toTupleT (map return ts)+ a <- toTupleT (map return (substTypeVars sub ts))+ let s = substTypeVars sub t+ return (Stab cx PrismType s t a b)+++computeIsoType :: Type -> [Type] -> TypeQ+computeIsoType t' fields =+ do sub <- sequenceA (fromSet (newName . nameBase) (setOf typeVars t'))+ let t = return t'+ s = return (substTypeVars sub t')+ b = toTupleT (map return fields)+ a = toTupleT (map return (substTypeVars sub fields))+ ty | Map.null sub = appsT (conT ''Iso') [t,b]+ | otherwise = appsT (conT ''Iso) [s,t,a,b]++ close =<< ty++++-- | Construct either a Review or Prism as appropriate+makeConOpticExp :: Stab -> [NCon] -> NCon -> ExpQ+makeConOpticExp stab cons con =+ case stabType stab of+ PrismType -> makeConPrismExp stab cons con+ ReviewType -> makeConReviewExp con+++-- | Construct an iso declaration+makeConIso :: Type -> NCon -> DecsQ+makeConIso s con =+ do let ty = computeIsoType s (view nconTypes con)+ defName = prismName (view nconName con)+ sequenceA+ ( [ sigD defName ty+ , valD (varP defName) (normalB (makeConIsoExp con)) []+ ] +++ inlinePragma defName+ )+++-- | Construct prism expression+--+-- prism <<reviewer>> <<remitter>>+makeConPrismExp ::+ Stab ->+ [NCon] {- ^ constructors -} ->+ NCon {- ^ target constructor -} ->+ ExpQ+makeConPrismExp stab cons con = appsE [varE 'prism, reviewer, remitter]+ where+ ts = view nconTypes con+ fields = length ts+ conName = view nconName con++ reviewer = makeReviewer conName fields+ remitter | stabSimple stab = makeSimpleRemitter conName fields+ | otherwise = makeFullRemitter cons conName+++-- | Construct an Iso expression+--+-- iso <<reviewer>> <<remitter>>+makeConIsoExp :: NCon -> ExpQ+makeConIsoExp con = appsE [varE 'iso, remitter, reviewer]+ where+ conName = view nconName con+ fields = length (view nconTypes con)++ reviewer = makeReviewer conName fields+ remitter = makeIsoRemitter conName fields+++-- | Construct a Review expression+--+-- unto (\(x,y,z) -> Con x y z)+makeConReviewExp :: NCon -> ExpQ+makeConReviewExp con = appE (varE 'unto) reviewer+ where+ conName = view nconName con+ fields = length (view nconTypes con)++ reviewer = makeReviewer conName fields+++------------------------------------------------------------------------+-- Prism and Iso component builders+------------------------------------------------------------------------+++-- | Construct the review portion of a prism.+--+-- (\(x,y,z) -> Con x y z) :: b -> t+makeReviewer :: Name -> Int -> ExpQ+makeReviewer conName fields =+ do xs <- newNames "x" fields+ lam1E (toTupleP (map varP xs))+ (conE conName `appsE1` map varE xs)+++-- | Construct the remit portion of a prism.+-- Pattern match only target constructor, no type changing+--+-- (\x -> case s of+-- Con x y z -> Right (x,y,z)+-- _ -> Left x+-- ) :: s -> Either s a+makeSimpleRemitter :: Name -> Int -> ExpQ+makeSimpleRemitter conName fields =+ do x <- newName "x"+ xs <- newNames "y" fields+ let matches =+ [ match (conP conName (map varP xs))+ (normalB (appE (conE 'Right) (toTupleE (map varE xs))))+ []+ , match wildP (normalB (appE (conE 'Left) (varE x))) []+ ]+ lam1E (varP x) (caseE (varE x) matches)+++-- | Pattern match all constructors to enable type-changing+--+-- (\x -> case s of+-- Con x y z -> Right (x,y,z)+-- Other_n w -> Left (Other_n w)+-- ) :: s -> Either t a+makeFullRemitter :: [NCon] -> Name -> ExpQ+makeFullRemitter cons target =+ do x <- newName "x"+ lam1E (varP x) (caseE (varE x) (map mkMatch cons))+ where+ mkMatch (NCon conName _ _ n) =+ do xs <- newNames "y" (length n)+ match (conP conName (map varP xs))+ (normalB+ (if conName == target+ then appE (conE 'Right) (toTupleE (map varE xs))+ else appE (conE 'Left) (conE conName `appsE1` map varE xs)))+ []+++-- | Construct the remitter suitable for use in an 'Iso'+--+-- (\(Con x y z) -> (x,y,z)) :: s -> a+makeIsoRemitter :: Name -> Int -> ExpQ+makeIsoRemitter conName fields =+ do xs <- newNames "x" fields+ lam1E (conP conName (map varP xs))+ (toTupleE (map varE xs))+++------------------------------------------------------------------------+-- Classy prisms+------------------------------------------------------------------------+++-- | Construct the classy prisms class for a given type and constructors.+--+-- class ClassName r <<vars in type>> | r -> <<vars in Type>> where+-- topMethodName :: Prism' r Type+-- conMethodName_n :: Prism' r conTypes_n+-- conMethodName_n = topMethodName . conMethodName_n+makeClassyPrismClass ::+ Type {- Outer type -} ->+ Name {- Class name -} ->+ Name {- Top method name -} ->+ [NCon] {- Constructors -} ->+ DecQ+makeClassyPrismClass t className methodName cons =+ do r <- newName "r"+ let methodType = appsT (conT ''Prism') [varT r,return t]+ methodss <- traverse (mkMethod (VarT r)) cons'+ classD (cxt[]) className (map plainTV (r : vs)) (fds r)+ ( sigD methodName methodType+ : map return (concat methodss)+ )++ where+ mkMethod r con =+ do Stab cx o _ _ _ b <- computeOpticType t cons con+ let stab' = Stab cx o r r b b+ defName = view nconName con+ body = appsE [varE '(.), varE methodName, varE defName]+ sequenceA+ [ sigD defName (return (stabToType stab'))+ , valD (varP defName) (normalB body) []+ ]++ cons' = map (over nconName prismName) cons+ vs = Set.toList (setOf typeVars t)+ fds r+ | null vs = []+ | otherwise = [FunDep [r] vs]++++-- | Construct the classy prisms instance for a given type and constructors.+--+-- instance Classname OuterType where+-- topMethodName = id+-- conMethodName_n = <<prism>>+makeClassyPrismInstance ::+ Type ->+ Name {- Class name -} ->+ Name {- Top method name -} ->+ [NCon] {- Constructors -} ->+ DecQ+makeClassyPrismInstance s className methodName cons =+ do let vs = Set.toList (setOf typeVars s)+ cls = className `conAppsT` (s : map VarT vs)++ instanceD (cxt[]) (return cls)+ ( valD (varP methodName)+ (normalB (varE 'id)) []+ : [ do stab <- computeOpticType s cons con+ let stab' = simplifyStab stab+ valD (varP (prismName conName))+ (normalB (makeConOpticExp stab' cons con)) []+ | con <- cons+ , let conName = view nconName con+ ]+ )+++------------------------------------------------------------------------+-- Utilities+------------------------------------------------------------------------+++-- | Normalized constructor+data NCon = NCon+ { _nconName :: Name+ , _nconVars :: [Name]+ , _nconCxt :: Cxt+ , _nconTypes :: [Type]+ }+ deriving (Eq)++nconName :: Lens' NCon Name+nconName f x = fmap (\y -> x {_nconName = y}) (f (_nconName x))++nconCxt :: Lens' NCon Cxt+nconCxt f x = fmap (\y -> x {_nconCxt = y}) (f (_nconCxt x))++nconTypes :: Lens' NCon [Type]+nconTypes f x = fmap (\y -> x {_nconTypes = y}) (f (_nconTypes x))++instance HasTypeVars NCon where+ typeVarsEx s f (NCon x vars y z) = NCon x vars <$> typeVarsEx s' f y <*> typeVarsEx s' f z+ where s' = foldl' (flip Set.insert) s vars++-- | Normalize a single 'Con' to its constructor name and field types.+normalizeCon :: D.ConstructorInfo -> NCon+normalizeCon info = NCon (D.constructorName info)+ (D.tvName <$> D.constructorVars info)+ (D.constructorContext info)+ (D.constructorFields info)+++-- | Compute a prism's name by prefixing an underscore for normal+-- constructors and period for operators.+prismName :: Name -> Name+prismName = prismName' False++prismName' :: Bool -- ^ This is 'True' in the event that:+ --+ -- 1. We are generating the name of a classy prism for a+ -- data type, and+ -- 2. The data type shares a name with one of its+ -- constructors (e.g., @data A = A@).+ --+ -- In such a scenario, we take care not to generate the same+ -- prism name that the constructor receives (e.g., @_A@).+ -- For prefix names, we accomplish this by adding an extra+ -- underscore; for infix names, an extra dot.+ -> Name -> Name+prismName' sameNameAsCon n =+ case nameBase n of+ [] -> error "prismName: empty name base?"+ nb@(x:_) | isUpper x -> mkName (prefix '_' nb)+ | otherwise -> mkName (prefix '.' nb) -- operator+ where+ prefix :: Char -> String -> String+ prefix char str | sameNameAsCon = char:char:str+ | otherwise = char:str+++-- | Quantify all the free variables in a type.+close :: Type -> TypeQ+close t = forallT (map plainTVInferred (Set.toList vs)) (cxt[]) (return t)+ where+ vs = setOf typeVars t++setOf :: Ord a => Getting (Endo [a]) s a -> s -> Set a+setOf l s = Set.fromList (s ^.. l)++-- @fromSet@ wasn't always there, and we need compatibility with+-- containers-0.4 to compile on GHC 7.4.+fromSet :: (k -> v) -> Set.Set k -> Map.Map k v+#if MIN_VERSION_containers(0,5,0)+fromSet = Map.fromSet+#else+fromSet f x = Map.fromDistinctAscList [ (k,f k) | k <- Set.toAscList x ]+#endif++-- | Apply arguments to a type constructor+appsT :: TypeQ -> [TypeQ] -> TypeQ+appsT = foldl appT++-- | Apply arguments to a function+appsE1 :: ExpQ -> [ExpQ] -> ExpQ+appsE1 = foldl appE++-- | Construct a tuple type given a list of types.+toTupleT :: [TypeQ] -> TypeQ+toTupleT [x] = x+toTupleT xs = appsT (tupleT (length xs)) xs++-- | Construct a tuple value given a list of expressions.+toTupleE :: [ExpQ] -> ExpQ+toTupleE [x] = x+toTupleE xs = tupE xs++-- | Construct a tuple pattern given a list of patterns.+toTupleP :: [PatQ] -> PatQ+toTupleP [x] = x+toTupleP xs = tupP xs+
+ src/Lens/Micro/Pro/Type.hs view
@@ -0,0 +1,57 @@+{-|+Module : Lens.Micro.Pro.Type+Copyright : (C) 2013-2016 Edward Kmett, 2018 Monadfix+License : BSD-style (see the file LICENSE)++This module defines just the 'Iso' and 'Prism' types, in order to break a+dependency cycle. You'll find the interesting stuff in 'Lens.Micro.Pro' and+'Lens.Micro.Pro.Internal'.+-}+module Lens.Micro.Pro.Type+ ( Iso, Iso'+ , Prism, Prism'+ )+ where+--------------------------------------------------------------------------------+import Data.Profunctor+--------------------------------------------------------------------------------++{- |+The type signature of 'Lens.Micro.Pro.iso' provides a nice interpretation of+'Iso'. If you want to apply a function @a -> b@ to a type @s@, you'd have to+convert with @s -> a@, apply your function @a -> b@, and convert back with+@b -> t@.++@+'Lens.Micro.Pro.iso' :: (s -> a) -> (b -> t) -> Iso s t a b+-- or, put monomorphically+'Lens.Micro.Pro.iso' :: (s -> a) -> (a -> s) -> Iso' s a+@+-}++type Iso s t a b = forall p f. (Profunctor p, Functor f)+ => p a (f b) -> p s (f t)++{- |+The type of monomorphic isomorphisms, i.e. isos that change neither the outer type+@s@ nor the inner type @a@.+-}++type Iso' s a = Iso s s a a++{- |+* @s@ is the type of the whole structure+* @t@ is the type of the reconstructed structure+* @a@ is the type of the target+* @b@ is the type of the value used for reconstruction+-}+type Prism s t a b = forall p f. (Choice p, Applicative f)+ => p a (f b) -> p s (f t) ++{- |+The type of monomorphic prisms, i.e. prisms that change neither the outer type+@s@ nor the inner type @a@.+-}++type Prism' s a = Prism s s a a+
+ src/Lens/Micro/ProCompat.hs view
@@ -0,0 +1,23 @@+{- |+Module : Lens.Micro.ProCompat+Copyright : (C) 2013-2016 Edward Kmett, 2018 Monadfix+License : BSD-style (see the file LICENSE)++This module re-exports "Lens.Micro.Platform", overriding definitions where+necesarry.+-}+module Lens.Micro.ProCompat+ ( module Lens.Micro.Platform+ , module Lens.Micro.Pro+ )+ where+--------------------------------------------------------------------------------++-- everything hidden here is redefined in 'Lens.Micro.Pro'+import Lens.Micro.Platform hiding+ ( _Left, _Right, _Just, _Nothing, _Show+ , strict, lazy, packed, unpacked+ , non+ )+import Lens.Micro.Pro+