packages feed

optics-operators (empty) → 0.1.0.0

raw patch · 6 files changed

+269/−0 lines, 6 filesdep +basedep +mtldep +optics-core

Dependencies added: base, mtl, optics-core, tasty, tasty-quickcheck

Files

+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Changelog++## [0.1.0.0] - 6/24/2023++- First release of optics-operators.+- Provides only (+=), (-=), (*=), (//=) operators for now.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2023 qwbarch++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.
+ README.lhs view
@@ -0,0 +1,54 @@+# optics-operators++[![build](https://github.com/qwbarch/optics-operators/actions/workflows/build.yml/badge.svg)](https://github.com/qwbarch/optics-operators/actions/workflows/build.yml) [![License: MIT](https://img.shields.io/badge/License-MIT-green.svg)](https://opensource.org/licenses/MIT)++A tiny package containing operators missing from the official package.++## Why does this package exist?++The [optics](https://hackage.haskell.org/package/optics) library is missing convenient operators that the [lens](https://hackage.haskell.org/package/lens-5.2.2/docs/Control-Lens-Operators.html)+library provides.  +I've only added the operators I need for now. Feel free to open an issue or pull request to add new ones.++## Quick start++This is a literate haskell file. You can run this example via the following:+```+nix develop --command cabal run+```++Necessary language extensions and imports for the example:+```haskell+{-# LANGUAGE DeriveGeneric, OverloadedLabels #-}+import GHC.Generics (Generic)+import Control.Monad.State (StateT, execStateT)+import Data.Optics.Operators ((+=), (-=), (*=))+import Control.Monad ((<=<))+```++Basic example using state operators:+```haskell+newtype Person = Person+  { age :: Int+  } deriving (Show, Generic)++addAge :: Int -> StateT Person IO ()+addAge age = #age += age++subtractAge :: Int -> StateT Person IO ()+subtractAge age = #age -= age+```++Running the example:+```haskell+person :: Person+person = Person 50++main :: IO ()+main = print <=< flip execStateT person $ do+  addAge 10+  subtractAge 20+  #age *= 2++-- Output: Person {age = 80}+```
+ optics-operators.cabal view
@@ -0,0 +1,76 @@+cabal-version: 1.18++-- This file has been generated from package.yaml by hpack version 0.34.7.+--+-- see: https://github.com/sol/hpack++name:           optics-operators+version:        0.1.0.0+synopsis:       A tiny package containing operators missing from the official package.+description:    A tiny package containing operators missing from the official package.+                Basic example using state operators:+                .+                > newtype Person = Person { age :: Int } deriving (Show, Generic)+                > +                > main :: IO ()+                > main = print <=< flip execStateT (Person 0) $ do+                >   #age += 50+                >   #age -= 20+                >+                > -- Output: Person {age = 30}+category:       Data, Optics, Lenses+homepage:       https://github.com/qwbarch/optics-operators+bug-reports:    https://github.com/qwbarch/optics-operators/issues+author:         qwbarch+maintainer:     qwbarch <qwbarch@gmail.com>+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-doc-files:+    CHANGELOG.md++library+  exposed-modules:+      Data.Optics.Operators+  other-modules:+      Paths_optics_operators+  hs-source-dirs:+      src+  build-depends:+      base >=4.10 && <5+    , mtl ==2.*+    , optics-core >=0.4 && <1+  default-language: Haskell2010++executable readme+  main-is: README.lhs+  other-modules:+      Data.Optics.Operators+      Paths_optics_operators+  hs-source-dirs:+      ./+      src+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -flate-specialise -fspecialise-aggressively -Wall -Wno-name-shadowing -pgmL markdown-unlit+  build-depends:+      base >=4.10 && <5+    , mtl ==2.*+    , optics-core >=0.4 && <1+  default-language: Haskell2010++test-suite unit-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Data.Optics.Operators+      Paths_optics_operators+  hs-source-dirs:+      src+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -flate-specialise -fspecialise-aggressively -Wall -Wno-name-shadowing+  build-depends:+      base >=4.10 && <5+    , mtl ==2.*+    , optics-core >=0.4 && <1+    , tasty >=1.4.3 && <1.5+    , tasty-quickcheck >=0.10.2 && <0.11+  default-language: Haskell2010
+ src/Data/Optics/Operators.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleContexts #-}++module Data.Optics.Operators where++import Control.Monad.State (MonadState, modify)+import Optics.Core (A_Setter, Is, Optic', (%~))++{- |+Modify the target of the optic by adding a value.++@+data Person = Person { age :: 'Int' } deriving ('GHC.Generics.Generic')++f :: 'MonadState' Person m => m ()+f = #age += 1+@+-}+(+=) :: (Is k A_Setter, MonadState s m, Num a) => Optic' k is s a -> a -> m ()+o += a = modify $ o %~ (+ a)++infixr 4 +=+{-# INLINE (+=) #-}++{- |+Modify the target of the optic by subtracting a value.++@+data Person = Person { age :: 'Int' } deriving ('GHC.Generics.Generic')++f :: 'MonadState' Person m => m ()+f = #age -= 1+@+-}+(-=) :: (Is k A_Setter, MonadState s m, Num a) => Optic' k is s a -> a -> m ()+o -= a = modify $ o %~ subtract a++infixr 4 -=+{-# INLINE (-=) #-}++{- |+Modify the target of the optic by multiplying a value.++@+data Person = Person { age :: 'Int' } deriving ('GHC.Generics.Generic')++f :: 'MonadState' Person m => m ()+f = #age *= 1+@+-}+(*=) :: (Is k A_Setter, MonadState s m, Num a) => Optic' k is s a -> a -> m ()+o *= a = modify $ o %~ (* a)++infixr 4 *=+{-# INLINE (*=) #-}++{- |+Modify the target of the optic by dividing a value.++@+data Person = Person { age :: 'Int' } deriving ('GHC.Generics.Generic')++f :: 'MonadState' Person m => m ()+f = #age //= 1+@+-}+(//=) :: (Is k A_Setter, MonadState s m, Fractional a) => Optic' k is s a -> a -> m ()+o //= a = modify $ o %~ (/ a)+{-# INLINE (//=) #-}++infixr 4 //=
+ test/Main.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE ScopedTypeVariables #-}++import Control.Monad.State (execState)+import Data.Optics.Operators ((*=), (+=), (-=), (//=))+import GHC.Generics (Generic)+import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.QuickCheck (testProperty)++newtype Foo = Foo {bar :: Float}+  deriving+    ( Floating+    , Fractional+    , Ord+    , Num+    , Real+    , RealFrac+    , RealFloat+    , Eq+    , Generic+    )++-- (+=) :: (Is k A_Setter, MonadState s m, Num a) => Optic' k is s a -> a -> m ()++main :: IO ()+main = defaultMain $ testGroup "Data.Optic.Operators" testTree+ where+  -- A test case for simple operators e.g. +=, -=, etc.+  testBasic name f g =+    testProperty name $ \(x :: Float, y :: Float) ->+      let a = Foo (x `f` y)+          b = execState (#bar `g` y) (Foo x)+       in a == b || isNaN a && isNaN b+  testTree =+    [ testBasic "(+=)" (+) (+=)+    , testBasic "(-=)" (-) (-=)+    , testBasic "(*=)" (*) (*=)+    , testBasic "(//=)" (/) (//=)+    ]