diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +0.2.2 +===== + +* Add Lens `piOptionParserAndDefaultConfiguration` that gives simultaneous + accesses to `piOptionParser` and `piDefaultConfiguration` which allows + changing the type parameter of `ProgramInfo a`. + +* Introduce function `setProperty`. It is used as the `..:` operator + but allows to specify a custom parser for the property value instead + of the default `parseJSON` from the `FromJSON` instance. + +* Introduce operators `(<*<)`, `(>*>)`, `(<$<)`, `(>$>)` and deprecate + `(⊙)` and `(<.>)`. + 0.2.1 ===== diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -12,10 +12,25 @@ The main features are 1. configuration management through integration of command line option - parsing and configuration files and + parsing and configuration files, 2. a `Setup.hs` file that generates a `PkgInfo` module for each component - of a package that provide information about the package and the build. + of a package that provide information about the package and the build, and +3. a set of types for configuration of HTTP services and clients along + with aeson instances and command line option parsers. +The ultimate goal for this package is a general framework for +compositional configuration management for software components. +Instead of designing such a framework from scratch the approach of this +package is to first explore design and implementation patterns based +on practical examples and by gluing together existing technology. + +Therefor at the current state this package mostly provides operators and +coding patterns for writing stylish boilerplate code. + +Once we feel that the developed patterns cover a sufficient portion of +real world requirements we plan to rewrite this package such that +the boilerplate is hidden behind a clean and simple DSL. + Configuration Management ======================== @@ -119,16 +134,16 @@ Now we define an [aeson](https://hackage.haskell.org/package/aeson) `FromJSON` instance that yields a function that updates a given `Auth` value with the -values from the parsed JSON value. The `<.>` operator is functional composition +values from the parsed JSON value. The `<*<` operator is functional composition lifted for applicative functors and `%` is a version of `$` with a different precedence that helps to reduce the use of paranthesis in applicative style code. ~~~{.haskell} instance FromJSON (Auth -> Auth) where - parseJSON = withObject "Auth" $ \o -> pure id - <.> user ..: "user" % o - <.> pwd ..: "pwd" % o + parseJSON = withObject "Auth" $ \o -> id + <$< user ..: "user" % o + <*< pwd ..: "pwd" % o ~~~ The `ToJSON` instance is needed to print the configuration (as YAML document) @@ -150,11 +165,11 @@ ~~~{.haskell} pAuth :: MParser Auth -pAuth = pure id - <.> user .:: strOption +pAuth = id + <$< user .:: strOption % long "user" <> help "user name" - <.> pwd .:: strOption + <*< pwd .:: strOption % long "pwd" <> help "password for user" ~~~ @@ -192,10 +207,10 @@ } instance FromJSON (HttpURL -> HttpURL) where - parseJSON = withObject "HttpURL" $ \o -> pure id - <.> auth %.: "auth" % o - <.> domain ..: "domain" % o - <.> path ..: "path" % o + parseJSON = withObject "HttpURL" $ \o -> id + <$< auth %.: "auth" % o + <*< domain ..: "domain" % o + <*< path ..: "path" % o instance ToJSON HttpURL where toJSON a = object @@ -205,15 +220,14 @@ ] pHttpURL :: MParser HttpURL -pHttpURL = pure id - <.> auth %:: pAuth - <.> domain .:: strOption +pHttpURL = id + <$< auth %:: pAuth + <*< domain .:: strOption % long "domain" <> short 'd' <> help "HTTP domain" - <.> path .:: strOption + <*< path .:: strOption % long "path" - <> short 'p' <> help "HTTP URL path" ~~~ diff --git a/configuration-tools.cabal b/configuration-tools.cabal --- a/configuration-tools.cabal +++ b/configuration-tools.cabal @@ -3,7 +3,7 @@ -- ------------------------------------------------------ -- Name: configuration-tools -Version: 0.2.1 +Version: 0.2.2 Synopsis: Tools for specifying and parsing configurations description: Tools for specifying and parsing configurations @@ -53,7 +53,7 @@ source-repository this type: git location: https://github.com/alephcloud/hs-configuration-tools.git - tag: 0.2.1 + tag: 0.2.2 Library hs-source-dirs: src diff --git a/constraints b/constraints --- a/constraints +++ b/constraints @@ -1,36 +1,39 @@ -constraints: Cabal ==1.21.0.0, +constraints: Cabal ==1.20.0.1, MonadRandom ==0.1.13, aeson ==0.7.0.6, ansi-terminal ==0.6.1.1, ansi-wl-pprint ==0.6.7.1, array ==0.5.0.0, - attoparsec ==0.11.3.4, - base ==4.7.0.0, + attoparsec ==0.12.1.0, + base ==4.7.0.1, base-unicode-symbols ==0.2.2.4, + bifunctors ==4.1.1.1, bytestring ==0.10.4.0, comonad ==4.2, - conduit ==1.1.2.1, - configuration-tools ==0.2, + conduit ==1.1.6, + configuration-tools ==0.2.2, containers ==0.5.5.1, - contravariant ==0.5.1, + contravariant ==0.6, deepseq ==1.3.0.2, directory ==1.2.1.0, - distributive ==0.4.3.2, - dlist ==0.7.0.1, - either ==4.1.2, + distributive ==0.4.4, + dlist ==0.7.1, + either ==4.3.0.1, errors ==1.4.7, exceptions ==0.6.1, filepath ==1.3.0.2, + free ==4.9, ghc-prim ==0.3.1.0, hashable ==1.2.2.0, integer-gmp ==0.5.1.0, - lifted-base ==0.2.2.2, + lifted-base ==0.2.3.0, mmorph ==1.0.3, monad-control ==0.3.3.0, mtl ==2.1.3.1, nats ==0.2, old-locale ==1.0.0.6, - optparse-applicative ==0.8.1, + optparse-applicative ==0.9.0, + prelude-extras ==0.4, pretty ==1.1.1.1, primitive ==0.5.3.0, process ==1.2.0.0, @@ -38,20 +41,20 @@ random ==1.0.1.1, resourcet ==1.1.2.2, rts ==1.0, - safe ==0.3.4, - scientific ==0.3.2.0, - semigroupoids ==4.0.2, - semigroups ==0.14, - syb ==0.4.1, + safe ==0.3.6, + scientific ==0.3.3.0, + semigroupoids ==4.0.2.1, + semigroups ==0.15.1, + syb ==0.4.2, tagged ==0.7.2, template-haskell ==2.9.0.0, - text ==1.1.1.2, + text ==1.1.1.3, time ==1.4.2, transformers ==0.3.0.0, transformers-base ==0.4.2, - transformers-compat ==0.1.1.1, + transformers-compat ==0.3.3.4, unix ==2.7.0.1, - unordered-containers ==0.2.4.0, - vector ==0.10.9.1, + unordered-containers ==0.2.5.0, + vector ==0.10.11.0, void ==0.6.1, - yaml ==0.8.8.3 + yaml ==0.8.8.4 diff --git a/examples/Example.hs b/examples/Example.hs --- a/examples/Example.hs +++ b/examples/Example.hs @@ -43,9 +43,9 @@ } instance FromJSON (Auth → Auth) where - parseJSON = withObject "Auth" $ \o → pure id - ⊙ user ..: "user" × o - ⊙ pwd ..: "pwd" × o + parseJSON = withObject "Auth" $ \o → id + <$< user ..: "user" × o + <*< pwd ..: "pwd" × o instance ToJSON Auth where toJSON a = object @@ -54,11 +54,11 @@ ] pAuth ∷ MParser Auth -pAuth = pure id - ⊙ user .:: strOption +pAuth = id + <$< user .:: strOption × long "user" ⊕ help "user name" - ⊙ pwd .:: strOption + <*< pwd .:: strOption × long "pwd" ⊕ help "password for user" @@ -87,10 +87,10 @@ } instance FromJSON (HttpURL → HttpURL) where - parseJSON = withObject "HttpURL" $ \o → pure id - ⊙ auth %.: "auth" × o - ⊙ domain ..: "domain" × o - ⊙ path ..: "path" × o + parseJSON = withObject "HttpURL" $ \o → id + <$< auth %.: "auth" × o + <*< domain ..: "domain" × o + <*< path ..: "path" × o instance ToJSON HttpURL where toJSON a = object @@ -100,15 +100,14 @@ ] pHttpURL ∷ MParser HttpURL -pHttpURL = pure id - ⊙ auth %:: pAuth - ⊙ domain .:: strOption +pHttpURL = id + <$< auth %:: pAuth + <*< domain .:: strOption × long "domain" ⊕ short 'd' ⊕ help "HTTP domain" - ⊙ path .:: strOption + <*< path .:: strOption × long "path" - ⊕ short 'p' ⊕ help "HTTP URL path" -- | Information about the main Application diff --git a/src/Configuration/Utils.hs b/src/Configuration/Utils.hs --- a/src/Configuration/Utils.hs +++ b/src/Configuration/Utils.hs @@ -55,6 +55,7 @@ , piHelpFooter , piOptionParser , piDefaultConfiguration +, piOptionParserAndDefaultConfiguration -- * Running an Configured Application , runWithConfiguration @@ -67,16 +68,22 @@ , (%::) -- * Parsing of Configuration Files with Default Values +, setProperty , (..:) , (%.:) -- * Misc Utils , (%) , (×) +, (<*<) +, (>*>) +, (<$<) +, (>$>) , (<.>) , (⊙) , dropAndUncaml , Lens' +, Lens -- * Configuration of Optional Values -- $maybe @@ -140,13 +147,45 @@ -- | Functional composition for applicative functors. -- +(<*<) ∷ Applicative φ ⇒ φ (β → γ) → φ (α → β) → φ (α → γ) +(<*<) a b = pure (.) <*> a <*> b +infixr 4 <*< +{-# INLINE (<*<) #-} + +-- | Functional composition for applicative functors with its arguments +-- flipped. +-- +(>*>) ∷ Applicative φ ⇒ φ (α → β) → φ (β → γ) → φ (α → γ) +(>*>) = flip (<*<) +infixr 4 >*> +{-# INLINE (>*>) #-} + +-- | Applicative functional composition between a pure function +-- and an applicative function. +-- +(<$<) ∷ Functor φ ⇒ (β → γ) → φ (α → β) → φ (α → γ) +(<$<) a b = (a .) <$> b +infixr 4 <$< +{-# INLINE (<$<) #-} + +-- | Applicative functional composition between a pure function +-- and an applicative function with its arguments flipped. +-- +(>$>) ∷ Functor φ ⇒ φ (α → β) → (β → γ) → φ (α → γ) +(>$>) = flip (<$<) +infixr 4 >$> +{-# INLINE (>$>) #-} + +-- | Functional composition for applicative functors. +-- -- This is a rather popular operator. Due to conflicts (for instance with the -- lens package) it may have to be imported qualified. -- (<.>) ∷ Applicative φ ⇒ φ (β → γ) → φ (α → β) → φ (α → γ) -(<.>) a b = pure (.) <*> a <*> b +(<.>) = (<*<) infixr 4 <.> {-# INLINE (<.>) #-} +{-# DEPRECATED (<.>) "use '<*<' instead" #-} -- | For people who like nicely aligned code and do not mind messing with -- editor key-maps: here a version of '<.>' that uses a unicode symbol @@ -161,6 +200,7 @@ (⊙) = (<.>) infixr 4 ⊙ {-# INLINE (⊙) #-} +{-# DEPRECATED (⊙) "use '<*<' instead" #-} -- -------------------------------------------------------------------------- -- -- Applicative Option Parsing with Default Values @@ -184,14 +224,13 @@ -- > -- $(makeLenses ''Auth) -- > -- > pAuth ∷ MParser Auth --- > pAuth = pure id --- > ⊙ user .:: strOption +-- > pAuth = id +-- > <$< user .:: strOption -- > × long "user" -- > ⊕ short 'u' -- > ⊕ help "user name" --- > ⊙ pwd .:: strOption +-- > <*< pwd .:: strOption -- > × long "pwd" --- > ⊕ short 'p' -- > ⊕ help "password for user" -- (.::) ∷ (Alternative φ, Applicative φ) ⇒ Lens' α β → φ β → φ (α → α) @@ -222,9 +261,9 @@ -- > -- $(makeLenses ''HttpURL) -- > -- > pHttpURL ∷ MParser HttpURL --- > pHttpURL = pure id --- > ⊙ auth %:: pAuth --- > ⊙ domain .:: strOption +-- > pHttpURL = id +-- > <$< auth %:: pAuth +-- > <*< domain .:: strOption -- > × long "domain" -- > ⊕ short 'd' -- > ⊕ help "HTTP domain" @@ -247,10 +286,48 @@ | otherwise = let (h:t) = drop i l in toLower h : concatMap (\x → if isUpper x then "-" ⊕ [toLower x] else [x]) t --- | A variant of the aeson operator '.:' that creates a parser --- that updates a setter with the parsed value. +-- | A JSON 'Value' parser for a property of a given +-- 'Object' that updates a setter with the parsed value. -- -- > data Auth = Auth +-- > { _userId ∷ !Int +-- > , _pwd ∷ !String +-- > } +-- > +-- > userId ∷ Functor φ ⇒ (Int → φ Int) → Auth → φ Auth +-- > userId f s = (\u → s { _userId = u }) <$> f (_userId s) +-- > +-- > pwd ∷ Functor φ ⇒ (String → φ String) → Auth → φ Auth +-- > pwd f s = (\p → s { _pwd = p }) <$> f (_pwd s) +-- > +-- > -- or with lenses and TemplateHaskell just: +-- > -- $(makeLenses ''Auth) +-- > +-- > instance FromJSON (Auth → Auth) where +-- > parseJSON = withObject "Auth" $ \o → id +-- > <$< setProperty user "user" p o +-- > <*< setProperty pwd "pwd" parseJSON o +-- > where +-- > p = withText "user" $ \case +-- > "alice" → pure (0 ∷ Int) +-- > "bob" → pure 1 +-- > e → faile $ "unrecognized user " ⊕ e +-- +setProperty + ∷ Lens' α β -- ^ Lens that into the target that is updated by the parser + → T.Text -- ^ the JSON property name + → (Value → Parser β) -- ^ the JSON 'Value' parser that is used to parse the value of the property + → Object -- ^ the parsed JSON 'Value' 'Object' + → Parser (α → α) +setProperty s k p o = case H.lookup k o of + Nothing → pure id + Just v → set s <$> p v + +-- | A variant of the 'setProperty' that uses the default 'parseJSON' method from the +-- 'FromJSON' instance to parse the value of the property. Its usage pattern mimics the +-- usage pattern of the '.:' operator from the aeson library. +-- +-- > data Auth = Auth -- > { _user ∷ !String -- > , _pwd ∷ !String -- > } @@ -265,14 +342,12 @@ -- > -- $(makeLenses ''Auth) -- > -- > instance FromJSON (Auth → Auth) where --- > parseJSON = withObject "Auth" $ \o → pure id --- > ⊙ user ..: "user" × o --- > ⊙ pwd ..: "pwd" × o +-- > parseJSON = withObject "Auth" $ \o → id +-- > <$< user ..: "user" × o +-- > <*< pwd ..: "pwd" × o -- (..:) ∷ FromJSON β ⇒ Lens' α β → T.Text → Object → Parser (α → α) -(..:) s k o = case H.lookup k o of - Nothing → pure id - Just v → set s <$> parseJSON v +(..:) s k = setProperty s k parseJSON infix 6 ..: {-# INLINE (..:) #-} @@ -297,9 +372,9 @@ -- > -- $(makeLenses ''HttpURL) -- > -- > instance FromJSON (HttpURL → HttpURL) where --- > parseJSON = withObject "HttpURL" $ \o → pure id --- > ⊙ auth %.: "auth" × o --- > ⊙ domain ..: "domain" × o +-- > parseJSON = withObject "HttpURL" $ \o → id +-- > <$< auth %.: "auth" × o +-- > <*< domain ..: "domain" × o -- (%.:) ∷ FromJSON (β → β) ⇒ Lens' α β → T.Text → Object → Parser (α → α) (%.:) s k o = case H.lookup k o of @@ -327,28 +402,49 @@ -- | Program Description -- piDescription ∷ Lens' (ProgramInfo α) String -piDescription = lens _piDescription $ \s a → s { _piDescription = a} +piDescription = lens _piDescription $ \s a → s { _piDescription = a } +{-# INLINE piDescription #-} -- | Help header -- piHelpHeader ∷ Lens' (ProgramInfo α) (Maybe String) -piHelpHeader = lens _piHelpHeader $ \s a → s { _piHelpHeader = a} +piHelpHeader = lens _piHelpHeader $ \s a → s { _piHelpHeader = a } +{-# INLINE piHelpHeader #-} -- | Help footer -- piHelpFooter ∷ Lens' (ProgramInfo α) (Maybe String) -piHelpFooter = lens _piHelpFooter $ \s a → s { _piHelpFooter = a} +piHelpFooter = lens _piHelpFooter $ \s a → s { _piHelpFooter = a } +{-# INLINE piHelpFooter #-} -- | options parser for configuration (TODO consider using a typeclass for this) -- piOptionParser ∷ Lens' (ProgramInfo α) (MParser α) -piOptionParser = lens _piOptionParser $ \s a → s { _piOptionParser = a} +piOptionParser = lens _piOptionParser $ \s a → s { _piOptionParser = a } +{-# INLINE piOptionParser #-} -- | default configuration -- piDefaultConfiguration ∷ Lens' (ProgramInfo α) α -piDefaultConfiguration = lens _piDefaultConfiguration $ \s a → s { _piDefaultConfiguration = a} +piDefaultConfiguration = lens _piDefaultConfiguration $ \s a → s { _piDefaultConfiguration = a } +{-# INLINE piDefaultConfiguration #-} +-- | 'Lens' for simultaneous query and update of 'piOptionParser' and +-- 'piDefaultConfiguration'. This supports to change the type of 'ProgramInfo' +-- with 'over' and 'set'. +-- +piOptionParserAndDefaultConfiguration ∷ Lens (ProgramInfo α) (ProgramInfo β) (MParser α, α) (MParser β, β) +piOptionParserAndDefaultConfiguration = lens g $ \s (a,b) → ProgramInfo + { _piDescription = _piDescription s + , _piHelpHeader = _piHelpHeader s + , _piHelpFooter = _piHelpFooter s + , _piOptionParser = a + , _piDefaultConfiguration = b + } + where + g s = (_piOptionParser s, _piDefaultConfiguration s) +{-# INLINE piOptionParserAndDefaultConfiguration #-} + -- | Smart constructor for 'ProgramInfo'. -- -- 'piHelpHeader' and 'piHelpFooter' are set to 'Nothing'. @@ -544,7 +640,7 @@ -- -- For this the following orphan 'FromJSON' instance is provided: -- --- > instance (FromJSON (a -> a), FromJSON a) => FromJSON (Maybe a -> Maybe a) +-- > instance (FromJSON (a → a), FromJSON a) ⇒ FromJSON (Maybe a → Maybe a) -- > parseJSON Null = pure (const Nothing) -- > parseJSON v = f <$> parseJSON v <*> parseJSON v -- > where @@ -580,7 +676,7 @@ -- default value that is given to the configuration parser is 'Nothing' and the -- parsed configuration is not 'Null'. -- -instance (FromJSON (a -> a), FromJSON a) => FromJSON (Maybe a -> Maybe a) where +instance (FromJSON (a → a), FromJSON a) ⇒ FromJSON (Maybe a → Maybe a) where -- | If the configuration explicitly requires 'Null' the result -- is 'Nothing'. diff --git a/src/Configuration/Utils/Http.hs b/src/Configuration/Utils/Http.hs --- a/src/Configuration/Utils/Http.hs +++ b/src/Configuration/Utils/Http.hs @@ -69,9 +69,9 @@ } instance FromJSON (HttpServiceTLSConfiguration → HttpServiceTLSConfiguration) where - parseJSON = withObject "HttpServiceTLSConfiguration" $ \o → pure id - ⊙ hstcCertFile ..: "cert-file" × o - ⊙ hstcKeyFile ..: "pem-file" × o + parseJSON = withObject "HttpServiceTLSConfiguration" $ \o → id + <$< hstcCertFile ..: "cert-file" × o + <*< hstcKeyFile ..: "pem-file" × o -- | This is used as default when wrapped into Maybe and -- @@ -96,11 +96,11 @@ -- provided even though TLS is turned off. -- pHttpServiceTLSConfiguration ∷ String → MParser HttpServiceTLSConfiguration -pHttpServiceTLSConfiguration prefix = pure id - ⊙ hstcCertFile .:: strOption +pHttpServiceTLSConfiguration prefix = id + <$< hstcCertFile .:: strOption × long (prefix ⊕ "cert-file") ⊕ help "File with PEM encoded TLS Certificate" - ⊙ hstcKeyFile .:: strOption + <*< hstcKeyFile .:: strOption × long (prefix ⊕ "key-file") ⊕ help "File with PEM encoded TLS key" @@ -145,11 +145,11 @@ } instance FromJSON (HttpServiceConfiguration → HttpServiceConfiguration) where - parseJSON = withObject "HttpServiceConfiguration" $ \o → pure id - ⊙ hscHost ∘ bs ..: "host" × o - ⊙ hscPort ..: "port" × o - ⊙ hscInterface ∘ bs ..: "interface" × o - ⊙ hscUseTLS %.: "use-tls" × o + parseJSON = withObject "HttpServiceConfiguration" $ \o → id + <$< hscHost ∘ bs ..: "host" × o + <*< hscPort ..: "port" × o + <*< hscInterface ∘ bs ..: "interface" × o + <*< hscUseTLS %.: "use-tls" × o where bs ∷ Iso' B8.ByteString String bs = iso B8.unpack B8.pack @@ -163,17 +163,17 @@ ] pHttpServiceConfiguration ∷ String → MParser HttpServiceConfiguration -pHttpServiceConfiguration prefix = pure id - ⊙ hscHost ∘ bs .:: strOption +pHttpServiceConfiguration prefix = id + <$< hscHost ∘ bs .:: strOption × long (prefix ⊕ "host") ⊕ help "Hostname of the service" - ⊙ hscPort .:: option + <*< hscPort .:: option × long (prefix ⊕ "port") ⊕ help "Port of the service" - ⊙ hscInterface ∘ bs .:: option + <*< hscInterface ∘ bs .:: option × long (prefix ⊕ "interface") ⊕ help "Interface of the service" - ⊙ (hscUseTLS %:: (fmap <$> pHttpServiceTLSConfiguration prefix)) + <*< (hscUseTLS %:: (fmap <$> pHttpServiceTLSConfiguration prefix)) where bs ∷ Iso' B8.ByteString String bs = iso B8.unpack B8.pack @@ -205,10 +205,10 @@ } instance FromJSON (HttpClientConfiguration → HttpClientConfiguration) where - parseJSON = withObject "HttpClientConfiguration" $ \o → pure id - ⊙ hccHost ∘ bs ..: "host" × o - ⊙ hccPort ..: "port" × o - ⊙ hccUseTLS ..: "use-tls" × o + parseJSON = withObject "HttpClientConfiguration" $ \o → id + <$< hccHost ∘ bs ..: "host" × o + <*< hccPort ..: "port" × o + <*< hccUseTLS ..: "use-tls" × o where bs ∷ Iso' B8.ByteString String bs = iso B8.unpack B8.pack @@ -221,14 +221,14 @@ ] pHttpClientConfiguration ∷ String → MParser HttpClientConfiguration -pHttpClientConfiguration serviceName = pure id - ⊙ hccHost ∘ bs .:: strOption +pHttpClientConfiguration serviceName = id + <$< hccHost ∘ bs .:: strOption × long (serviceName ⊕ "-host") ⊕ help ("Hostname of " ⊕ serviceName) - ⊙ hccPort .:: option + <*< hccPort .:: option × long (serviceName ⊕ "-port") ⊕ help ("Port of " ⊕ serviceName) - ⊙ hccUseTLS .:: switch + <*< hccUseTLS .:: switch × long (serviceName ⊕ "-use-tls") ⊕ help ("Connect to " ⊕ serviceName ⊕ " via TLS") where diff --git a/src/Configuration/Utils/Internal.hs b/src/Configuration/Utils/Internal.hs --- a/src/Configuration/Utils/Internal.hs +++ b/src/Configuration/Utils/Internal.hs @@ -11,6 +11,7 @@ , over , set , Lens' +, Lens , Iso' , iso ) where @@ -27,9 +28,13 @@ -- | This is the same type as the type from the lens library with the same name. -- -type Lens' β α = Functor φ ⇒ (α → φ α) → β → φ β +type Lens σ τ α β = Functor φ ⇒ (α → φ β) → σ → φ τ -lens ∷ Functor φ ⇒ (β → α) → (β → α → β) → (α → φ α) → β → φ β +-- | This is the same type as the type from the lens library with the same name. +-- +type Lens' σ α = Lens σ σ α α + +lens ∷ (σ → α) → (σ → β → τ) → Lens σ τ α β lens getter setter lGetter s = setter s `fmap` lGetter (getter s) over ∷ ((α → Identity α) → β → Identity β) → (α → α) → β → β @@ -42,5 +47,5 @@ -- type Iso' β α = (Profunctor π, Functor φ) ⇒ π α (φ α) → π β (φ β) -iso :: (β -> α) -> (α -> β) -> Iso' β α +iso ∷ (β → α) → (α → β) → Iso' β α iso f g = dimap f (fmap g)