diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,8 @@ +# Changelog for composite-lens-extra + +## v0.0.1.0 + +* Add `(:!:)` pattern for contravariant base functors. +* Add `rlens''` for contravariant contravariant lenses. +* Add `rlensS`, `rlensS'` and `rlensS''` for type changing + lenses with different functor types. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2020-2021 Daniel Firth + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# composite-lens-extra + +Extra lens functions for +[composite](https://hackage.haskell.org/package/composite-base) records. diff --git a/composite-lens-extra.cabal b/composite-lens-extra.cabal new file mode 100644 --- /dev/null +++ b/composite-lens-extra.cabal @@ -0,0 +1,39 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: composite-lens-extra +version: 0.0.1.0 +synopsis: Extra lens functions for composite. +description: Extra lens functions for composite. +category: Composite, Data, Lens +author: Daniel Firth +maintainer: dan.firth@homotopic.tech +copyright: 2021 Daniel Firth +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://gitlab.homotopic.tech/haskell/composite-lens-extra + +library + exposed-modules: + Composite.Lens.Extra + other-modules: + Paths_composite_lens_extra + hs-source-dirs: + src + ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-missing-import-lists -Wno-implicit-prelude -Wno-monomorphism-restriction -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe + build-depends: + base >=4.7 && <5 + , composite-base >=0.7.0.0 && <0.8 + , lens >=4.0 && <5.1 + , vinyl >=0.13.0 && <0.14 + default-language: Haskell2010 diff --git a/src/Composite/Lens/Extra.hs b/src/Composite/Lens/Extra.hs new file mode 100644 --- /dev/null +++ b/src/Composite/Lens/Extra.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} + +module Composite.Lens.Extra + ( pattern (:!:), + rlens'', + rlensS, + rlensS', + rlensS'', + ) +where + +import Composite.Record +import qualified Control.Lens as L +import Data.Functor.Contravariant +import qualified Data.Vinyl as Vinyl +import Data.Vinyl.TypeLevel + +-- | Bidirectional pattern matching the first field of a record using ':->' values and any contavariant functor. +-- +-- This pattern is bidirectional meaning you can use it either as a pattern or a constructor, e.g. +-- +-- @ +-- let rec = Predicate even :!: Predicate (even . length) :!: RNil +-- Predicate foo :!: Predicate bar :!: RNil = rec +-- @ +-- +-- @since 0.0.1.0 +pattern (:!:) :: forall s f rs a. Contravariant f => () => f a -> Rec f rs -> Rec f (s :-> a ': rs) +pattern (:!:) fa rs <- + (contramap Val -> fa) :& rs + where + (:!:) fa rs = contramap getVal fa :& rs + +infixr 5 :!: + +-- | Lens to a particular field of a record using a contravariant functor. +-- +-- For example, given: +-- +-- @ +-- type FFoo = "foo" :-> Int +-- type FBar = "bar" :-> String +-- fBar_ :: Proxy FBar +-- fBar_ = Proxy +-- +-- rec :: 'Rec' 'Predicate' '[FFoo, FBar] +-- rec = Predicate even :!: Predicate (even . length) :!: Nil +-- @ +-- +-- Then: +-- +-- @ +-- view (rlens'' fBar_) rec == Predicate even +-- set (rlens'' fBar_) Predicate (odd . length) rec == Predicate even :!: Predicate (odd . length) :!: Nil +-- over (rlens'' fBar_) (contramap show) rec == Predicate even :!: Predicate (odd . length . show) :!: Nil +-- @ +-- +-- @since 0.0.1.0 +rlens'' :: (Contravariant f, Functor g, RElem (s :-> a) rs) => proxy (s :-> a) -> (f a -> g (f a)) -> Rec f rs -> g (Rec f rs) +rlens'' proxy f = + Vinyl.rlens $ \(contramap (reifyVal proxy . Val) -> fa) -> + contramap getVal <$> f fa +{-# INLINE rlens'' #-} + +-- | Type changing lens over a `Record` field. +-- +-- @since 0.0.1.0 +rlensS :: + forall p p' s s' a b g rs rs'. + ( (p ~ (s :-> a)), + (p' ~ (s' :-> b)), + Vinyl.RecElem + Rec + (s :-> a) + (s' :-> b) + rs + rs' + (RIndex (s :-> a) rs), + Functor g + ) => + (a -> g b) -> + Record rs -> + g (Record rs') +rlensS f = Vinyl.rlens' @p @p' $ \(L.Identity (getVal -> a)) -> L.Identity . Val <$> f a + +-- | Type changing lens over a `Rec f` (Covariant). +-- +-- @since 0.0.1.0 +rlensS' :: + forall p p' s s' a b f g rs rs'. + ( (p ~ (s :-> a)), + (p' ~ (s' :-> b)), + Vinyl.RecElem + Rec + (s :-> a) + (s' :-> b) + rs + rs' + (Data.Vinyl.TypeLevel.RIndex (s :-> a) rs), + Functor f, + Functor g + ) => + (f a -> g (f b)) -> + Rec f rs -> + g (Rec f rs') +rlensS' f = Vinyl.rlens' @p @p' $ \(fmap getVal -> a) -> fmap Val <$> f a + +-- | Type changing lens over a `Rec f` (Contravariant). +-- +-- @since 0.0.1.0 +rlensS'' :: + forall p p' s s' a b f g rs rs'. + ( (p ~ (s :-> a)), + (p' ~ (s' :-> b)), + Vinyl.RecElem + Rec + (s :-> a) + (s' :-> b) + rs + rs' + (Data.Vinyl.TypeLevel.RIndex (s :-> a) rs), + Contravariant f, + Functor g + ) => + (f a -> g (f b)) -> + Rec f rs -> + g (Rec f rs') +rlensS'' f = Vinyl.rlens' @p @p' $ \(contramap Val -> a) -> contramap getVal <$> f a