strict-optics (empty) → 0.4

raw patch · 5 files changed

+262/−0 lines, 5 filesdep +basedep +optics-coredep +strictsetup-changed

Dependencies added: base, optics-core, strict

Files

CHANGES.md +3/−0
LICENSE +28/−0
Setup.lhs +3/−0
src/Data/Strict/Optics.hs +180/−0
strict-optics.cabal +48/−0

+ CHANGES.md view

@@ -0,0 +1,3 @@+## 0.4++- Initial release, splitted of `strict-base-types`

+ LICENSE view

@@ -0,0 +1,28 @@+Copyright (c) 2020      Oleg Grenrus+              2013-2014 Simon Meier+              2006-2008 Roman Leshchinskiy++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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.

+ Setup.lhs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

+ src/Data/Strict/Optics.hs view

@@ -0,0 +1,180 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Strict.Optics (+    -- * Tuple+    -- | See instances, in particular for 'Field1' and 'Field2' type classes.+    -- * Either+    _Left, _Right,+    -- * Maybe+    _Just, _Nothing,+    -- * These+    here, there,+    _This, _That, _These,+    -- * Combinators+    strict, lazy,+    ) where+++import           Control.Applicative (pure, (<$>), (<*>))+import           Prelude             (Int, flip, ($), (.))++-- Lazy variants+import qualified Prelude             as L++import           Optics.Core         (Each (..), Field1 (..), Field2 (..),+                                      Index, Iso', Prism, Prism', Swapped (..),+                                      Traversal, iso, itraversalVL, lensVL,+                                      prism, prism', traversalVL, (<&>))++import           Data.Strict         (Either (..), Maybe (..), Pair (..),+                                      Strict (..), These (..), either, maybe,+                                      swap, these)++-------------------------------------------------------------------------------+-- Tuple+-------------------------------------------------------------------------------++instance Field1 (Pair a b) (Pair a' b) a a' where+  _1 = lensVL $ \k (a :!: b) -> k a <&> \a' -> (a' :!: b)++instance Field2 (Pair a b) (Pair a b') b b' where+  _2 = lensVL $ \k (a :!: b) -> k b <&> \b' -> (a :!: b')++instance Swapped Pair where+  swapped = iso swap swap++type instance Index (Pair a b) = Int+instance (a~a', b~b') => Each Int (Pair a a') (Pair b b') a b where+  each = itraversalVL $ \f ~(a :!: b) -> (:!:) <$> f 0 a <*> f 1 b+  {-# INLINE each #-}++-------------------------------------------------------------------------------+-- Either+-------------------------------------------------------------------------------++instance Swapped Either where+  swapped = either Right Left `iso` either Right Left++instance (a ~ a', b ~ b') => Each (Either () ()) (Either a a') (Either b b') a b where+  each = itraversalVL aux where+    aux f (Left x)  = Left <$> f (Left ()) x+    aux f (Right x) = Right <$> f (Right ()) x++-- | Analogous to 'Control.Lens.Prism._Left' in "Control.Lens.Prism".+_Left :: Prism (Either a c) (Either b c) a b+_Left = prism Left $ either L.Right (L.Left . Right)++-- | Analogous to 'Control.Lens.Prism._Right' in "Control.Lens.Prism".+_Right :: Prism (Either c a) (Either c b) a b+_Right = prism Right $ either (L.Left . Left) L.Right++-------------------------------------------------------------------------------+-- Maybe+-------------------------------------------------------------------------------++instance Each () (Maybe a) (Maybe b) a b where+    each = itraversalVL aux where+        aux _ Nothing  = pure Nothing+        aux f (Just x) = Just <$> f () x++-- | Analogous to 'Control.Lens.Prism._Just' in "Control.Lens.Prism"+_Just :: Prism (Maybe a) (Maybe b) a b+_Just = prism Just $ maybe (L.Left Nothing) L.Right++-- | Analogous to 'Control.Lens.Prism._Nothing' in "Control.Lens.Prism"+_Nothing :: Prism' (Maybe a) ()+_Nothing = prism' (L.const Nothing) $ maybe (L.Just ()) (L.const L.Nothing)++-------------------------------------------------------------------------------+-- These+-------------------------------------------------------------------------------++instance Swapped These where+    swapped = iso swapThese swapThese++instance (a ~ a', b ~ b') => Each (Either () ()) (These a a') (These b b') a b where+    each = itraversalVL aux where+        aux f (This a)    = This <$> f (Left ()) a+        aux f (That b)    = This <$> f (Right ()) b+        aux f (These a b) = These <$> f (Left ()) a <*> f (Right ()) b++-- | A 'Control.Lens.Traversal' of the first half of a 'These', suitable for use with "Control.Lens".+--+-- >>> over here show (That 1)+-- That 1+--+-- >>> over here show (These 'a' 2)+-- These "'a'" 2+--+here :: Traversal (These a c) (These b c) a b+here = traversalVL aux where+    aux f (This x)    = This <$> f x+    aux f (These x y) = flip These y <$> f x+    aux _ (That x)    = pure (That x)++-- | A 'Control.Lens.Traversal' of the second half of a 'These', suitable for use with "Control.Lens".+--+-- @+-- 'there' :: 'Control.Lens.Traversal' ('These' t b) ('These' t b) a b+-- @+--+-- >>> over there show (That 1)+-- That "1"+--+-- >>> over there show (These 'a' 2)+-- These 'a' "2"+--+there :: Traversal (These c a) (These c b) a b+there = traversalVL aux where+    aux _ (This x)    = pure (This x)+    aux f (These x y) = These x <$> f y+    aux f (That x)    = That <$> f x++-- | A 'Control.Lens.Prism'' selecting the 'This' constructor.+--+-- /Note:/ cannot change type.+_This :: Prism' (These a b) a+_This = prism This (these L.Right (L.Left . That) (\x y -> L.Left $ These x y))++-- | A 'Control.Lens.Prism'' selecting the 'That' constructor.+--+-- /Note:/ cannot change type.+_That :: Prism' (These a b) b+_That = prism That (these (L.Left . This) L.Right (\x y -> L.Left $ These x y))++-- | A 'Control.Lens.Prism'' selecting the 'These' constructor. 'These' names are ridiculous!+--+-- /Note:/ cannot change type.+_These :: Prism' (These a b) (a, b)+_These = prism (\(a,b) -> These a b) (these (L.Left . This) (L.Left . That) (\x y -> L.Right (x, y)))++swapThese :: These a b -> These b a+swapThese (This a)    = That a+swapThese (That b)    = This b+swapThese (These a b) = These b a++-------------------------------------------------------------------------------+-- Combinators+-------------------------------------------------------------------------------++-- | Ad hoc conversion between "strict" and "lazy" versions of a structure,+-- using 'Strict' class.+strict :: Strict lazy strict => Iso' lazy strict+strict = iso toStrict toLazy++-- | An 'Iso'' between the strict variant of a structure and its lazy counterpart.+--+-- @+-- lazy = re strict+-- @+--+lazy :: Strict lazy strict => Iso' strict lazy+lazy = iso toLazy toStrict

+ strict-optics.cabal view

@@ -0,0 +1,48 @@+name:               strict-optics+version:            0.4+synopsis:           Optics for types in strict package+category:           Data, Optics+description:        Optics for types in strict package.+license:            BSD3+license-file:       LICENSE+author:+  Oleg Grenrus <oleg.grenrus>+  Roman Leshchinskiy <rl@cse.unsw.edu.au>,+  Simon Meier <iridcode@gmail.com>++maintainer:         Oleg Grenrus <oleg.grenrus@iki.fi>+copyright:+  (c) 2006-2008 by Roman Leshchinskiy+  (c) 2013-2014 by Simon Meier++homepage:           https://github.com/haskell-strict/strict+cabal-version:      >=1.10+build-type:         Simple+tested-with:+  GHC ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.3+   || ==8.10.1++extra-source-files: CHANGES.md++source-repository head+  type:     git+  location: https://github.com/haskell-strict/strict.git+  subdir:   strict-optics++library+  default-language: Haskell2010+  ghc-options:+    -Wall -fwarn-incomplete-uni-patterns -Wcompat+    -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances++  build-depends:+      base         >=4.9 && <5+    , optics-core  >=0.3 && <0.4+    , strict       >=0.4 && <0.4.1++  hs-source-dirs:   src+  exposed-modules:  Data.Strict.Optics