-----------------------------------------------------------------------------
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE RankNTypes          #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Lens
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- This modules exposes a very simple t'Miso.Lens.Lens' formulation that is compatible with other lens libraries.
--
-- For state management of miso applications, this module should meet all of your needs. It also
-- ensures a smaller payload size during compilation.
--
-- @
-- data Lens record field
--  = Lens
--  { _get :: record -> field
--  , _set :: record -> field -> record
--  }
-- @
--
-- The goal is to provide users with an out-of-the box lens experience without the large
-- dependency footprint and cognitive load. This module also aims to preserve semantics of
-- existing lens combinators using a simple formulation (not the van Laarhoven). It must be imported
-- separately (@import Miso.Lens@) and can be used with the @Effect@ Monad inside of a miso
-- application (as described below).
--
-- This module is at fixity and interface parity with @lens@ and @microlens@ and can therefore
-- be used interchangeably with them. Simply replace the @Miso.Lens@ import with @Control.Lens@.
-- For convenience we re-export the t'Miso.Lens.Lens'' synonym to ease the transition into [lens](https://hackage.haskell.org/package/lens) or [microlens](https://hackage.haskell.org/package/microlens)
--
-- For the curious reader, if you'd like more information on 'lens' and the van Laarhoven
-- formulation, we recommend the [lens](https://hackage.haskell.org/package/lens) library.
--
-- @
-- -- Person type
-- data Person = Person
--   { _name :: String
--   , _address :: Address
--   , _age  :: Int
--   } deriving (Show, Eq, Generic)
--
-- -- Address type
-- newtype Address
--   = Address
--   { _zipCode :: Zip
--   } deriving (Show, Eq)
--
-- -- | Zip code type synonym
-- type Zip = String
--
-- -- | Name Lens
-- name :: Lens Person String
-- name = 'lens' _name $ \\record x -> record { _name = x }
--
-- -- | Address Lens
-- address :: Lens Person Address
-- address = 'lens' _address $ \\record x -> record { _address = x }
--
-- -- | Zip Code Lens
-- zipCode :: Lens Address Zip
-- zipCode = 'lens' _zipCode $ \\record x -> record { _zipCode = x }
--
-- -- | Lens Composition example
-- personZip :: Lens Person Zip
-- personZip = zipCode . address
--
-- -- | Person example
-- person :: Person
-- person = Person "john" (Address "90210") 33
--
-- main :: IO ()
-- main = print $ john '&' address '.~' Address "10012"
--
-- -- Person
-- --  { _name = "john"
-- --  , _age = 33
-- --  , _address = Address {_zipCode = "10012"}
-- --  }
-- @
--
-- Example usage with miso's @Effect@ @Monad@
--
-- @
-- newtype Model = Model { _value :: Int }
--
-- value :: Lens Model Int
-- value = 'lens' _value $ \\model v -> model { _value = v }
--
-- data Action = AddOne | SubtractOne
--
-- updateModel :: Action -> Transition Model Action
-- updateModel = \\case 
--   AddOne -> value '+=' 1
--   SubtractOne -> value '-=' 1
-- @
----------------------------------------------------------------------------
module Miso.Lens
  ( -- ** Types
    Lens
  , LensCore (..)
  , Prism (..)
    -- ** Smart constructor
  , lens
  , prism
    -- ** Re-exports
  , (&)
  , (<&>)
    -- ** Lens Combinators
  , (.~)
  , (?~)
  , set
  , (%~)
  , over
  , (^.)
  , (+~)
  , (*~)
  , (//~)
  , (-~)
  , (%=)
  , (%?=)
  , modifying
  , (+=)
  , (*=)
  , (//=)
  , (-=)
  , (.=)
  , (<~)
  , (<%=)
  , (<.=)
  , (<?=)
  , (<<.=)
  , (<<%=)
  , assign
  , use
  , view
  , (?=)
  , (<>~)
  , _1
  , _2
  , _id
  , this
    -- ** Prism Combinators
  , preview
  , preuse
  , review
  , _Nothing
  , _Just
  , _Left
  , _Right
  , (^?)
  -- *** Containers
  , At (..)
  -- *** Re-exports
  , compose
  -- *** Conversion
  , Lens'
  , toVL
  , fromVL
  ) where
----------------------------------------------------------------------------
import Control.Monad.Reader (MonadReader, asks)
import Control.Monad.State (MonadState, modify, gets)
import Control.Monad.Identity (Identity(..))
import Control.Category (Category (..))
import Control.Arrow ((>>>))
import Data.Functor.Const (Const(..))
import Data.Function ((&))
import Data.Functor((<&>))
import Data.Kind (Type)
import qualified Data.Map.Strict as M
import Data.Map.Strict (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntMap.Strict as IM
import Data.IntMap.Strict (IntMap)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import Prelude hiding ((.))
----------------------------------------------------------------------------
import Miso.Util (compose)
----------------------------------------------------------------------------
-- | A t'Lens' is a generalized getter and setter.
--
-- Lenses allow both the retrieval of values from fields in a record and the
-- assignment of values to fields in a record. The power of a t'Lens' comes
-- from its ability to be composed with other lenses.
--
-- In the context of building applications with miso, the @model@ is
-- often a deeply nested product type. This makes it highly conducive
-- to t'Lens' operations (as defined below).
--
type Lens s a = LensCore a s
----------------------------------------------------------------------------
-- | t'LensCore' is an internal type used to reverse composition like
-- VL libraries do.
data LensCore field record
  = Lens
  { forall field record. LensCore field record -> record -> field
_get :: record -> field
    -- ^ Retrieves a field from a record
  , forall field record.
LensCore field record -> field -> record -> record
_set :: field -> record -> record
    -- ^ Sets a field on a record
  }
----------------------------------------------------------------------------
-- | van Laarhoven formulation, used for conversion w/ 'Miso.miso' t'Lens'.
type Lens' s a = forall (f :: Type -> Type). Functor f => (a -> f a) -> s -> f s
----------------------------------------------------------------------------
-- | Convert from 'Miso.miso' t'Lens' to van Laarhoven t'Lens''
toVL :: Lens record field -> Lens' record field
toVL :: forall record field. Lens record field -> Lens' record field
toVL Lens {record -> field
field -> record -> record
_get :: forall field record. LensCore field record -> record -> field
_set :: forall field record.
LensCore field record -> field -> record -> record
_get :: record -> field
_set :: field -> record -> record
..} = \field -> f field
f record
record -> (field -> record -> record) -> record -> field -> record
forall a b c. (a -> b -> c) -> b -> a -> c
flip field -> record -> record
_set record
record (field -> record) -> f field -> f record
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> field -> f field
f (record -> field
_get record
record)
----------------------------------------------------------------------------
-- | Convert from 'Miso.miso' t'Lens' to van Laarhoven t'Lens''
fromVL
  :: Lens' record field
  -> Lens record field
fromVL :: forall record field. Lens' record field -> Lens record field
fromVL Lens' record field
lens_ = Lens {record -> field
field -> record -> record
_get :: record -> field
_set :: field -> record -> record
_get :: record -> field
_set :: field -> record -> record
..}
  where
    _get :: record -> field
_get record
record = Const field record -> field
forall {k} a (b :: k). Const a b -> a
getConst ((field -> Const field field) -> record -> Const field record
Lens' record field
lens_ field -> Const field field
forall {k} a (b :: k). a -> Const a b
Const record
record)
    _set :: field -> record -> record
_set field
field = Identity record -> record
forall a. Identity a -> a
runIdentity (Identity record -> record)
-> (record -> Identity record) -> record -> record
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (field -> Identity field) -> record -> Identity record
Lens' record field
lens_ (\field
_ -> field -> Identity field
forall a. a -> Identity a
Identity field
field)
----------------------------------------------------------------------------
-- | t'Lens' form a 'Category', and can therefore be composed.
instance Category LensCore where
  id :: forall a. LensCore a a
id = (a -> a) -> (a -> a -> a) -> LensCore a a
forall field record.
(record -> field)
-> (field -> record -> record) -> LensCore field record
Lens a -> a
forall a. a -> a
Prelude.id a -> a -> a
forall a b. a -> b -> a
const
  Lens c -> b
g1 b -> c -> c
s1 . :: forall b c a. LensCore b c -> LensCore a b -> LensCore a c
. Lens b -> a
g2 a -> b -> b
s2 = Lens
    { _get :: c -> a
_get = c -> b
g1 (c -> b) -> (b -> a) -> c -> a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> b -> a
g2
    , _set :: a -> c -> c
_set = \a
f c
r -> b -> c -> c
s1 (a -> b -> b
s2 a
f (c -> b
g1 c
r)) c
r
    }
----------------------------------------------------------------------------
-- | Set a field on a record
--
-- @
-- newtype Person = Person { _name :: String }
--
-- name :: Lens Person String
-- name = lens _name $ \\person n -> person { _name = n }
--
-- setName :: Person -> String -> Person
-- setName person newName = person & name .~ newName
-- @
infixr 4 .~
(.~) :: Lens record field -> field -> record -> record
.~ :: forall record field. Lens record field -> field -> record -> record
(.~) Lens record field
_lens = Lens record field -> field -> record -> record
forall field record.
LensCore field record -> field -> record -> record
_set Lens record field
_lens
----------------------------------------------------------------------------
-- | Synonym for '(.~)'
--
set :: Lens record field -> field -> record -> record
set :: forall record field. Lens record field -> field -> record -> record
set = Lens record field -> field -> record -> record
forall record field. Lens record field -> field -> record -> record
(.~)
----------------------------------------------------------------------------
-- | Set an options field on a record
--
-- @
-- newtype Person = Person { _name :: Maybe String }
--
-- name :: Lens Person (Maybe String)
-- name = lens _name $ \\person n -> person { _name = n }
--
-- setName :: Person -> String -> Person
-- setName person newName = person & name ?~ newName
-- @
infixr 4 ?~
(?~) :: Lens record (Maybe field) -> field -> record -> record
?~ :: forall record field.
Lens record (Maybe field) -> field -> record -> record
(?~) Lens record (Maybe field)
_lens field
f record
r = record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record (Maybe field)
_lens Lens record (Maybe field) -> Maybe field -> record -> record
forall record field. Lens record field -> field -> record -> record
.~ field -> Maybe field
forall a. a -> Maybe a
Just field
f
----------------------------------------------------------------------------
-- | Modify a field on a record by applying a function to it.
--
-- @
-- newtype Counter = Counter { _value :: Int }
--
-- value :: Lens Counter Int
-- value = lens _value $ \\counter v -> counter { _value = v }
--
-- increment :: Counter -> Counter
-- increment counter = counter & value %~ (+1)
-- @
infixr 4 %~
(%~) :: Lens record field -> (field -> field) -> record -> record
%~ :: forall record field.
Lens record field -> (field -> field) -> record -> record
(%~) Lens record field
_lens field -> field
f record
record = Lens record field -> field -> record -> record
forall field record.
LensCore field record -> field -> record -> record
_set Lens record field
_lens (field -> field
f (record
record record -> Lens record field -> field
forall record field. record -> Lens record field -> field
^. Lens record field
_lens)) record
record
----------------------------------------------------------------------------
-- | Synonym for '(%~)'
over :: Lens record field -> (field -> field) -> record -> record
over :: forall record field.
Lens record field -> (field -> field) -> record -> record
over = Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
(%~)
----------------------------------------------------------------------------
-- | Read a field from a record using a t'Lens'
--
-- @
-- newtype Person = Person { _name :: String }
--   deriving (Show, Eq)
--
-- name :: Lens Person String
-- name = lens _name $ \\person n -> person { _name = n }
--
-- getName :: Person -> String
-- getName = person ^. name
-- @
infixl 8 ^.
(^.) :: record -> Lens record field -> field
^. :: forall record field. record -> Lens record field -> field
(^.) = (Lens record field -> record -> field)
-> record -> Lens record field -> field
forall a b c. (a -> b -> c) -> b -> a -> c
flip Lens record field -> record -> field
forall field record. LensCore field record -> record -> field
_get
----------------------------------------------------------------------------
-- | Increment a @Num field => field@ on a record using a t'Lens'
--
-- @
-- newtype Person = Person { _age :: Int }
--
-- age :: Lens Person Int
-- age = lens _age $ \\person a -> person { _age = a }
--
-- birthday :: Person -> Person
-- birthday person = person & age +~ 1
-- @
infixr 4 +~
(+~) :: Num field => Lens record field -> field -> record -> record
+~ :: forall field record.
Num field =>
Lens record field -> field -> record -> record
(+~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Num a => a -> a -> a
+field
x)
----------------------------------------------------------------------------
-- | Multiply a @Num@eric field on a record using a t'Lens'
--
-- @
-- newtype Circle = Circle { _radius :: Int }
--
-- radius :: Lens Circle Int
-- radius = lens _radius $ \\circle r -> circle { _radius = r }
--
-- expand :: Circle -> Circle
-- expand circle = circle & radius *~ 10
-- @
infixr 4 *~
(*~) :: Num field => Lens record field -> field -> record -> record
*~ :: forall field record.
Num field =>
Lens record field -> field -> record -> record
(*~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Num a => a -> a -> a
*field
x)
----------------------------------------------------------------------------
-- | Divide a @Fractional@ field on a record using a t'Lens'
--
-- @
-- newtype Circle = Circle { _radius :: Int }
--
-- radius :: Lens Circle Int
-- radius = lens _radius $ \\circle r -> circle { _radius = r }
--
-- shrink :: Circle -> Circle
-- shrink circle = circle & radius //~ 10
-- @
infixr 4 //~
(//~) :: Fractional field => Lens record field -> field -> record -> record
//~ :: forall field record.
Fractional field =>
Lens record field -> field -> record -> record
(//~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Fractional a => a -> a -> a
/field
x)
----------------------------------------------------------------------------
-- | Increment a @Num@eric field on a record using a t'Lens'
--
-- @
-- newtype Person = Person { _age :: Int }
--
-- age :: Lens Person Int
-- age = lens _age $ \\person a -> person { _age = a }
--
-- timeTravel :: Person -> Person
-- timeTravel person = person & age -~ 1
-- @
infixr 4 -~
(-~) :: Num field => Lens record field -> field -> record -> record
-~ :: forall field record.
Num field =>
Lens record field -> field -> record -> record
(-~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ field -> field -> field
forall a. Num a => a -> a -> a
subtract field
x
----------------------------------------------------------------------------
-- | Monoidally append a field in a record using a t'Lens'
--
-- @
-- newtype List = List { _values :: [Int] }
--
-- values :: Lens List [Int]
-- values = lens _values $ \\l vs -> l { _values = vs }
--
-- addElement :: List -> List
-- addElement list = list & values <>~ [2]
--
-- addElement (List [])
-- -- List [2]
-- @
--
infixr 4 <>~
(<>~) :: Monoid field => Lens record field -> field -> record -> record
<>~ :: forall field record.
Monoid field =>
Lens record field -> field -> record -> record
(<>~) Lens record field
_lens field
x record
record = record
record record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Semigroup a => a -> a -> a
<> field
x)
----------------------------------------------------------------------------
-- | Execute a monadic action in @MonadState@ that returns a field. Sets the
-- return value equal to the field in the record.
--
-- As a reasonable mnemonic, this lets you store the result of a monadic action in a t'Lens' rather than
-- in a local variable.
--
-- @
-- do foo <- bar
--    ...
-- @
--
-- will store the result in a variable, while
--
-- @
-- do fooLens '<~' bar
--    ...
-- @
--
-- will store the result in field focused by the t'Lens'.
infixr 2 <~
(<~) :: MonadState record m => Lens record field -> m field -> m ()
Lens record field
l <~ :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field -> m ()
<~ m field
mb = do
  b <- m field
mb
  l .= b
----------------------------------------------------------------------------
-- | Modify a record in @MonadState@ monad at a field using a t'Lens'
--
-- @
-- newtype Model = Model { _value :: Int }
--
-- data Action = AddOne | SubtractOne
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update AddOne = do
--   value %= (+1)
-- @
infix 4 %=
(%=) :: MonadState record m => Lens record field -> (field -> field) -> m ()
%= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
(%=) Lens record field
_lens field -> field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ field -> field
f)
----------------------------------------------------------------------------
-- | Synonym for '(%=)'
modifying :: MonadState record m => Lens record field -> (field -> field) -> m ()
modifying :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
modifying = Lens record field -> (field -> field) -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
(%=)
----------------------------------------------------------------------------
-- | Modify the field of a record in @MonadState@ using a t'Lens', then
-- return the newly modified field from the updated record.
--
-- @
-- import Miso.String (ms)
--
-- newtype Model = Model { _value :: Int }
--   deriving (Show)
--
-- data Action = AddOne
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update AddOne = do
--   result <- value <%= (+1)
--   io_ $ consoleLog (ms result)
-- @
infix 4 <%=
(<%=) :: MonadState record m => Lens record field -> (field -> field) -> m field
Lens record field
l <%= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m field
<%= field -> field
f = do
  Lens record field
l Lens record field -> (field -> field) -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= field -> field
f
  Lens record field -> m field
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens record field
l
----------------------------------------------------------------------------
-- | Assign the field of a record in @MonadState@ to a value using a t'Lens'
-- Return the value after assignment.
--
-- @
-- import Miso.String (ms)
--
-- newtype Model = Model { _value :: Int }
--
-- data Action = Assign Int
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (Assign x) = do
--   result <- value <.= x
--   io_ $ consoleLog (ms result) -- x
-- @
infix 4 <.=
(<.=) :: MonadState record m => Lens record field -> field -> m field
Lens record field
l <.= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m field
<.= field
b = do
  Lens record field
l Lens record field -> field -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= field
b
  field -> m field
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return field
b
----------------------------------------------------------------------------
-- | Assign the field of a record in a @MonadState@ to a value (wrapped in a 'Just')
-- using a t'Lens'. Return the value after assignment.
--
-- @
-- import Miso.String (ms)
--
-- newtype Model = Model { _value :: Maybe Int }
--
-- data Action = SetValue Int
--
-- value :: Lens Model (Maybe Int)
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (SetValue x) = do
--   result <- value <?= x
--   io_ $ consoleLog (ms result) -- Just 1
-- @
infix 4 <?=
(<?=) :: MonadState record m => Lens record (Maybe field) -> field -> m field
Lens record (Maybe field)
l <?= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> field -> m field
<?= field
b = do
  Lens record (Maybe field)
l Lens record (Maybe field) -> field -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> field -> m ()
?= field
b
  field -> m field
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return field
b
----------------------------------------------------------------------------
-- | Assign the field of a record in a @MonadState@ to a value using a t'Lens'.
-- Returns the /previous/ value, before assignment.
--
-- @
-- import Miso.String (ms)
--
-- newtype Model = Model { _value :: Int }
--   deriving (Show, Eq)
--
-- data Action = Assign Int
--   deriving (Show, Eq)
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (Assign x) = do
--   value .= x
--   previousValue <- value <<.= 1
--   io_ $ consoleLog $ ms previousValue -- prints value at x
-- @
infix 4 <<.=
(<<.=) :: MonadState record m => Lens record field -> field -> m field
Lens record field
l <<.= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m field
<<.= field
b = do
  old <- Lens record field -> m field
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens record field
l
  l .= b
  return old
----------------------------------------------------------------------------
-- | Retrieves the field associated with a record in @MonadReader@ using a t'Lens'.
--
-- @
-- import Miso.String (ms)
--
-- newtype Model = Model { _value :: Int }
--   deriving (Show, Eq)
--
-- data Action = PrintInt
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update PrintInt = do
--   Model x <- view value
--   io_ $ consoleLog (ms x) -- prints model value
-- @
----------------------------------------------------------------------------
view :: MonadReader record m => Lens record field -> m field
view :: forall record (m :: * -> *) field.
MonadReader record m =>
Lens record field -> m field
view Lens record field
lens_ = (record -> field) -> m field
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (record -> Lens record field -> field
forall record field. record -> Lens record field -> field
^. Lens record field
lens_)
----------------------------------------------------------------------------
-- | Modifies the field of a record in @MonadState@ using a t'Lens'.
-- Returns the /previous/ value, before modification.
--
-- @
-- import Miso.String (ms)
--
-- newtype Model = Model { _value :: Int }
--   deriving (Show, Eq)
--
-- data Action = Modify (Int -> Int)
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (Modify f) = do
--   value .= 2
--   result <- value <<%= f
--   io_ $ consoleLog (ms result) -- prints previous value of 2
-- @
infix 4 <<%=
(<<%=) :: MonadState record m => Lens record field -> (field -> field) -> m field
Lens record field
l <<%= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m field
<<%= field -> field
f = do
  old <- Lens record field -> m field
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens record field
l
  l %= f
  return old
----------------------------------------------------------------------------
-- | Sets the value of a field in a record using @MonadState@ and a t'Lens'
--
-- @
-- newtype Model = Model { _value :: Int }
--   deriving (Show, Eq)
--
-- data Action = SetValue Int
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update' :: Action -> Transition Model Action
-- update' (SetValue v) = value .= v
-- @
infix 4 .=
(.=) :: MonadState record m => Lens record field -> field -> m ()
.= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
(.=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> field -> record -> record
forall record field. Lens record field -> field -> record -> record
.~ field
f)
----------------------------------------------------------------------------
-- | Synonym for '(.=)'
assign :: MonadState record m => Lens record field -> field -> m ()
assign :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
assign = Lens record field -> field -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
(.=)
----------------------------------------------------------------------------
-- | Retrieves the value of a field in a record using a t'Lens' inside @MonadState@
--
-- @
-- import Miso.String (ms)
--
-- newtype Model = Model { _value :: Int }
--   deriving (Show, Eq)
--
-- data Action = SetValue Int
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (SetValue x) = do
--   value .= x
--   result <- use value
--   io_ $ consoleLog (ms result) -- prints the value of x
-- @
use :: MonadState record m => Lens record field -> m field
use :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens record field
_lens = (record -> field) -> m field
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (record -> Lens record field -> field
forall record field. record -> Lens record field -> field
^. Lens record field
_lens)
----------------------------------------------------------------------------
-- | Sets the value of a field in a record using a t'Lens' inside a @MonadState@
-- The value is wrapped in a @Just@ before being assigned.
--
-- @
-- newtype Model = Model { _value :: Maybe Int }
--   deriving (Show, Eq)
--
-- data Action = AssignValue Int
--
-- value :: Lens Model (Maybe Int)
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (AssignValue x) = value ?= x
-- @
infix 4 ?=
(?=) :: MonadState record m => Lens record (Maybe field) -> field -> m ()
?= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> field -> m ()
(?=) Lens record (Maybe field)
_lens field
value = Lens record (Maybe field)
_lens Lens record (Maybe field) -> Maybe field -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= field -> Maybe field
forall a. a -> Maybe a
Just field
value
----------------------------------------------------------------------------
-- | Alters the @Just@ value of a field in a record using a t'Lens' inside a @MonadState@
--
-- @
-- newtype Model = Model { _value :: Maybe Int }
--   deriving (Show, Eq)
--
-- data Action = IncrementIfJust
--
-- value :: Lens Model (Maybe Int)
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update IncrementIfJust = value %?= (+1)
--
-- @
infix 4 %?=
(%?=) :: MonadState record m => Lens record (Maybe field) -> (field -> field) -> m ()
%?= :: forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> (field -> field) -> m ()
(%?=) Lens record (Maybe field)
_lens field -> field
f = Lens record (Maybe field)
_lens Lens record (Maybe field) -> (Maybe field -> Maybe field) -> m ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= \case
  Maybe field
Nothing -> Maybe field
forall a. Maybe a
Nothing
  Just field
x -> field -> Maybe field
forall a. a -> Maybe a
Just (field -> field
f field
x)
----------------------------------------------------------------------------
-- | Increments the value of a @Num@eric field of a record using a t'Lens'
-- inside a @State@ Monad.
--
-- @
-- newtype Model = Model { _value :: Int }
--   deriving (Show, Eq)
--
-- data Action = IncrementBy Int
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (IncrementBy x) = value += x
-- @
infix 4 +=
(+=) :: (MonadState record m, Num field)  => Lens record field -> field -> m ()
+= :: forall record (m :: * -> *) field.
(MonadState record m, Num field) =>
Lens record field -> field -> m ()
(+=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> field -> record -> record
forall field record.
Num field =>
Lens record field -> field -> record -> record
+~ field
f)
----------------------------------------------------------------------------
-- | Multiplies the value of a @Num@eric field of a record using a t'Lens'
-- inside a @State@ Monad.
--
-- @
-- newtype Model = Model { _value :: Int }
--   deriving (Show, Eq)
--
-- data Action = MultiplyBy Int
--
-- value :: Lens Model Int
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (MultiplyBy x) = value *= x
-- @
infix 4 *=
(*=) :: (MonadState record m, Num field)  => Lens record field -> field -> m ()
*= :: forall record (m :: * -> *) field.
(MonadState record m, Num field) =>
Lens record field -> field -> m ()
(*=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> field -> record -> record
forall field record.
Num field =>
Lens record field -> field -> record -> record
*~ field
f)
----------------------------------------------------------------------------
-- | Divides the value of a @Fractional@ field of a record using a t'Lens'
-- inside a @State@ Monad.
--
-- @
-- newtype Model = Model { _value :: Double }
--   deriving (Show, Eq)
--
-- data Action = DivideBy Double
--
-- value :: Lens Model Double
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (DivideBy x) = value //= x
-- @
infix 4 //=
(//=) :: (MonadState record m, Fractional field)  => Lens record field -> field -> m ()
//= :: forall record (m :: * -> *) field.
(MonadState record m, Fractional field) =>
Lens record field -> field -> m ()
(//=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> (field -> field) -> record -> record
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (field -> field -> field
forall a. Fractional a => a -> a -> a
/ field
f))
----------------------------------------------------------------------------
-- | Subtracts the value of a @Num@eric field of a record using a t'Lens'
-- inside of a @State@ Monad.
--
-- @
-- newtype Model = Model { _value :: Double }
--   deriving (Show, Eq)
--
-- data Action = SubtractBy Double
--
-- value :: Lens Model Double
-- value = lens _value $ \\p x -> p { _value = x }
--
-- update :: Action -> Transition Model Action
-- update (SubtractBy x) = value -= x
-- @
infix 4 -=
(-=) :: (MonadState record m, Num field) => Lens record field -> field -> m ()
-= :: forall record (m :: * -> *) field.
(MonadState record m, Num field) =>
Lens record field -> field -> m ()
(-=) Lens record field
_lens field
f = (record -> record) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\record
r -> record
r record -> (record -> record) -> record
forall a b. a -> (a -> b) -> b
& Lens record field
_lens Lens record field -> field -> record -> record
forall field record.
Num field =>
Lens record field -> field -> record -> record
-~ field
f)
---------------------------------------------------------------------------------
-- | t'Lens' that operates on the first element of a tuple
--
-- @
-- update AddOne = do
--   _1 += 1
-- @
_1 :: Lens (a,b) a
_1 :: forall a b. Lens (a, b) a
_1 = ((a, b) -> a) -> ((a, b) -> a -> (a, b)) -> Lens (a, b) a
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens (a, b) -> a
forall a b. (a, b) -> a
fst (((a, b) -> a -> (a, b)) -> Lens (a, b) a)
-> ((a, b) -> a -> (a, b)) -> Lens (a, b) a
forall a b. (a -> b) -> a -> b
$ \(a
_,b
b) a
x -> (a
x,b
b)
---------------------------------------------------------------------------------
-- | t'Lens' that operates on the second element of a tuple
--
-- @
-- update AddOne = do
--   _2 += 1
-- @
_2 :: Lens (a,b) b
_2 :: forall a b. Lens (a, b) b
_2 = ((a, b) -> b) -> ((a, b) -> b -> (a, b)) -> Lens (a, b) b
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens (a, b) -> b
forall a b. (a, b) -> b
snd (((a, b) -> b -> (a, b)) -> Lens (a, b) b)
-> ((a, b) -> b -> (a, b)) -> Lens (a, b) b
forall a b. (a -> b) -> a -> b
$ \(a
a,b
_) b
x -> (a
a,b
x)
---------------------------------------------------------------------------------
-- | t'Lens' that operates on itself
--
-- @
-- update AddOne = do
--   _id += 1
-- @
_id :: Lens a a
_id :: forall a. LensCore a a
_id = LensCore a a
forall a. LensCore a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Control.Category.id
---------------------------------------------------------------------------------
-- | t'Lens' that operates on itself
--
-- @
-- update AddOne = do
--   this += 1
-- @
this :: Lens a a
this :: forall a. LensCore a a
this = Lens a a
forall a. LensCore a a
_id
---------------------------------------------------------------------------------
-- | Smart constructor 'lens' function. Used to easily construct a t'Lens'
--
-- > name :: Lens Person String
-- > name = lens _name $ \p n -> p { _name = n }
--
lens
  :: (record -> field)
  -> (record -> field -> record)
  -> Lens record field
lens :: forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens record -> field
getter record -> field -> record
setter = (record -> field)
-> (field -> record -> record) -> LensCore field record
forall field record.
(record -> field)
-> (field -> record -> record) -> LensCore field record
Lens record -> field
getter ((record -> field -> record) -> field -> record -> record
forall a b c. (a -> b -> c) -> b -> a -> c
flip record -> field -> record
setter)
----------------------------------------------------------------------------
data Prism s a
  = Prism
  { forall s a. Prism s a -> a -> s
_up :: a -> s
  , forall s a. Prism s a -> s -> Maybe a
_down :: s -> Maybe a
  }
----------------------------------------------------------------------------
review :: Prism s a -> a -> s
review :: forall s a. Prism s a -> a -> s
review = Prism s a -> a -> s
forall s a. Prism s a -> a -> s
_up
----------------------------------------------------------------------------
preview :: MonadReader r m => Prism r a -> m (Maybe a)
preview :: forall r (m :: * -> *) a.
MonadReader r m =>
Prism r a -> m (Maybe a)
preview = (r -> Maybe a) -> m (Maybe a)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((r -> Maybe a) -> m (Maybe a))
-> (Prism r a -> r -> Maybe a) -> Prism r a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Prism r a -> r -> Maybe a
forall r (m :: * -> *) a.
MonadReader r m =>
Prism r a -> m (Maybe a)
preview
----------------------------------------------------------------------------
preuse :: MonadState s m => Prism s a -> m (Maybe a)
preuse :: forall s (m :: * -> *) a.
MonadState s m =>
Prism s a -> m (Maybe a)
preuse = (s -> Maybe a) -> m (Maybe a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((s -> Maybe a) -> m (Maybe a))
-> (Prism s a -> s -> Maybe a) -> Prism s a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Prism s a -> s -> Maybe a
forall r (m :: * -> *) a.
MonadReader r m =>
Prism r a -> m (Maybe a)
preview
----------------------------------------------------------------------------
_Left :: Prism (Either a b) a
_Left :: forall a b. Prism (Either a b) a
_Left = (a -> Either a b)
-> (Either a b -> Maybe a) -> Prism (Either a b) a
forall a s. (a -> s) -> (s -> Maybe a) -> Prism s a
prism a -> Either a b
forall a b. a -> Either a b
Left ((Either a b -> Maybe a) -> Prism (Either a b) a)
-> (Either a b -> Maybe a) -> Prism (Either a b) a
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a) -> (b -> Maybe a) -> Either a b -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)
----------------------------------------------------------------------------
_Right :: Prism (Either a b) b
_Right :: forall a b. Prism (Either a b) b
_Right = (b -> Either a b)
-> (Either a b -> Maybe b) -> Prism (Either a b) b
forall a s. (a -> s) -> (s -> Maybe a) -> Prism s a
prism b -> Either a b
forall a b. b -> Either a b
Right ((a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just)
----------------------------------------------------------------------------
_Just :: Prism (Maybe a) a
_Just :: forall a. Prism (Maybe a) a
_Just = (a -> Maybe a) -> (Maybe a -> Maybe a) -> Prism (Maybe a) a
forall a s. (a -> s) -> (s -> Maybe a) -> Prism s a
prism a -> Maybe a
forall a. a -> Maybe a
Just Maybe a -> Maybe a
forall a. a -> a
Prelude.id
----------------------------------------------------------------------------
_Nothing :: Prism (Maybe a) a
_Nothing :: forall a. Prism (Maybe a) a
_Nothing = (a -> Maybe a) -> (Maybe a -> Maybe a) -> Prism (Maybe a) a
forall a s. (a -> s) -> (s -> Maybe a) -> Prism s a
prism (Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) Maybe a -> Maybe a
forall a. a -> a
Prelude.id
----------------------------------------------------------------------------
infixl 8 ^?
(^?) :: s -> Prism s a -> Maybe a 
^? :: forall s a. s -> Prism s a -> Maybe a
(^?) = (Prism s a -> s -> Maybe a) -> s -> Prism s a -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Prism s a -> s -> Maybe a
forall r (m :: * -> *) a.
MonadReader r m =>
Prism r a -> m (Maybe a)
preview
----------------------------------------------------------------------------
prism :: (a -> s) -> (s -> Maybe a) -> Prism s a
prism :: forall a s. (a -> s) -> (s -> Maybe a) -> Prism s a
prism = (a -> s) -> (s -> Maybe a) -> Prism s a
forall s a. (a -> s) -> (s -> Maybe a) -> Prism s a
Prism
----------------------------------------------------------------------------
-- | Class for getting and setting values across various container types.
--
-- > M.singleton 'a' "foo" & at 'a' .~ Just "bar"
-- > -- fromList [('a',"bar")]
--
-- > update (SetValue value)
-- >   at 10 ?= value
--
-- @since 1.9.0.0
class At at where
  type family Index at :: Type
  -- ^ Index of the container
  type family IxValue at :: Type
  -- ^ Indexed value of the container
  at :: Index at -> Lens at (Maybe (IxValue at))
----------------------------------------------------------------------------
instance Ord k => At (Map k v) where
  type Index (Map k v) = k
  type IxValue (Map k v) = v
  at :: Index (Map k v) -> Lens (Map k v) (Maybe (IxValue (Map k v)))
at Index (Map k v)
key = (Map k v -> Maybe (IxValue (Map k v)))
-> (Map k v -> Maybe (IxValue (Map k v)) -> Map k v)
-> Lens (Map k v) (Maybe (IxValue (Map k v)))
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens (k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
Index (Map k v)
key) ((Map k v -> Maybe (IxValue (Map k v)) -> Map k v)
 -> Lens (Map k v) (Maybe (IxValue (Map k v))))
-> (Map k v -> Maybe (IxValue (Map k v)) -> Map k v)
-> Lens (Map k v) (Maybe (IxValue (Map k v)))
forall a b. (a -> b) -> a -> b
$ \Map k v
m Maybe (IxValue (Map k v))
value ->
    case Maybe (IxValue (Map k v))
value of
      Maybe (IxValue (Map k v))
Nothing -> k -> Map k v -> Map k v
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
Index (Map k v)
key Map k v
m
      Just IxValue (Map k v)
v -> k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
Index (Map k v)
key v
IxValue (Map k v)
v Map k v
m
----------------------------------------------------------------------------
instance At (IntMap v) where
  type Index (IntMap v) = Int
  type IxValue (IntMap v) = v
  at :: Index (IntMap v) -> Lens (IntMap v) (Maybe (IxValue (IntMap v)))
at Index (IntMap v)
key = (IntMap v -> Maybe (IxValue (IntMap v)))
-> (IntMap v -> Maybe (IxValue (IntMap v)) -> IntMap v)
-> Lens (IntMap v) (Maybe (IxValue (IntMap v)))
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens (Key -> IntMap v -> Maybe v
forall a. Key -> IntMap a -> Maybe a
IM.lookup Key
Index (IntMap v)
key) ((IntMap v -> Maybe (IxValue (IntMap v)) -> IntMap v)
 -> Lens (IntMap v) (Maybe (IxValue (IntMap v))))
-> (IntMap v -> Maybe (IxValue (IntMap v)) -> IntMap v)
-> Lens (IntMap v) (Maybe (IxValue (IntMap v)))
forall a b. (a -> b) -> a -> b
$ \IntMap v
m Maybe (IxValue (IntMap v))
value ->
    case Maybe (IxValue (IntMap v))
value of
      Maybe (IxValue (IntMap v))
Nothing -> Key -> IntMap v -> IntMap v
forall a. Key -> IntMap a -> IntMap a
IM.delete Key
Index (IntMap v)
key IntMap v
m
      Just IxValue (IntMap v)
v -> Key -> v -> IntMap v -> IntMap v
forall a. Key -> a -> IntMap a -> IntMap a
IM.insert Key
Index (IntMap v)
key v
IxValue (IntMap v)
v IntMap v
m
----------------------------------------------------------------------------
instance Ord k => At (Set k) where
  type Index (Set k) = k
  type IxValue (Set k) = ()
  at :: Index (Set k) -> Lens (Set k) (Maybe (IxValue (Set k)))
at Index (Set k)
key = Lens {Maybe () -> Set k -> Set k
Set k -> Maybe ()
_get :: Set k -> Maybe ()
_set :: Maybe () -> Set k -> Set k
_set :: Maybe () -> Set k -> Set k
_get :: Set k -> Maybe ()
..}
    where
      _set :: Maybe () -> Set k -> Set k
_set = \Maybe ()
v Set k
m ->
        case Maybe ()
v of
          Maybe ()
Nothing -> k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
S.delete k
Index (Set k)
key Set k
m
          Just () -> k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
S.insert k
Index (Set k)
key Set k
m
      _get :: Set k -> Maybe ()
_get Set k
m
        | k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member k
Index (Set k)
key Set k
m = () -> Maybe ()
forall a. a -> Maybe a
Just ()
        | Bool
otherwise = Maybe ()
forall a. Maybe a
Nothing
----------------------------------------------------------------------------
instance At IntSet where
  type Index IntSet = Int
  type IxValue IntSet = ()
  at :: Index IntSet -> Lens IntSet (Maybe (IxValue IntSet))
at Index IntSet
key = Lens {Maybe () -> IntSet -> IntSet
IntSet -> Maybe ()
_get :: IntSet -> Maybe ()
_set :: Maybe () -> IntSet -> IntSet
_set :: Maybe () -> IntSet -> IntSet
_get :: IntSet -> Maybe ()
..}
    where
      _set :: Maybe () -> IntSet -> IntSet
_set = \Maybe ()
v IntSet
m ->
        case Maybe ()
v of
          Maybe ()
Nothing -> Key -> IntSet -> IntSet
IS.delete Key
Index IntSet
key IntSet
m
          Just () -> Key -> IntSet -> IntSet
IS.insert Key
Index IntSet
key IntSet
m
      _get :: IntSet -> Maybe ()
_get IntSet
m
        | Key -> IntSet -> Bool
IS.member Key
Index IntSet
key IntSet
m = () -> Maybe ()
forall a. a -> Maybe a
Just ()
        | Bool
otherwise = Maybe ()
forall a. Maybe a
Nothing
----------------------------------------------------------------------------
instance At [a] where
  type Index [a] = Int
  type IxValue [a] = a
  at :: Index [a] -> Lens [a] (Maybe (IxValue [a]))
at Index [a]
key = Lens {[a] -> Maybe a
Maybe a -> [a] -> [a]
_get :: [a] -> Maybe a
_set :: Maybe a -> [a] -> [a]
_set :: Maybe a -> [a] -> [a]
_get :: [a] -> Maybe a
..}
    where
      _set :: Maybe a -> [a] -> [a]
_set Maybe a
Nothing [a]
m
        | Key
Index [a]
key Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0 = [a]
m
        | Bool
otherwise = Key -> [a] -> ([a], [a])
forall a. Key -> [a] -> ([a], [a])
splitAt Key
Index [a]
key [a]
m ([a], [a]) -> (([a], [a]) -> [a]) -> [a]
forall a b. a -> (a -> b) -> b
& \([a]
lhs, [a]
rhs) -> [a]
lhs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> Key -> [a] -> [a]
forall a. Key -> [a] -> [a]
drop Key
1 [a]
rhs
      _set (Just a
v) [a]
m
        | Key
Index [a]
key Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
0 = [a]
m
        | Bool
otherwise = Key -> [a] -> ([a], [a])
forall a. Key -> [a] -> ([a], [a])
splitAt Key
Index [a]
key [a]
m ([a], [a]) -> (([a], [a]) -> [a]) -> [a]
forall a b. a -> (a -> b) -> b
& \([a]
lhs, [a]
rhs) ->
            case [a]
rhs of
              [] -> [a]
lhs
              a
_ : [a]
xs -> [a]
lhs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> (a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
      _get :: [a] -> Maybe a
_get = Key -> [(Key, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Key
Index [a]
key ([(Key, a)] -> Maybe a) -> ([a] -> [(Key, a)]) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Key] -> [a] -> [(Key, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
0..]
----------------------------------------------------------------------------