diff --git a/core/nyan-interpolation-core.cabal b/core/nyan-interpolation-core.cabal
index b4765ae..833a1d9 100644
--- a/core/nyan-interpolation-core.cabal
+++ b/core/nyan-interpolation-core.cabal
@@ -3,8 +3,6 @@ cabal-version: 2.0
-- This file has been generated from package.yaml by hpack version 0.35.0.
--
-- see: https://github.com/sol/hpack
---
--- hash: 454835beb066a76fcd19ff1540bc89d3e2f2732ac9d7164ec5903d0eb782bebd
name: nyan-interpolation-core
version: 0.9
@@ -34,6 +32,9 @@ library
Text.Interpolation.Nyan.Core.Internal.Processor
Text.Interpolation.Nyan.Core.Internal.RMode
Text.Interpolation.Nyan.Core.Internal.Splice
+ Text.Interpolation.Nyan.Lens
+ Text.Interpolation.Nyan.Lens.TH
+ Text.Interpolation.Nyan.Lens.Type
Text.Interpolation.Nyan.RModes.Buildable
Text.Interpolation.Nyan.RModes.CommonExtra
Text.Interpolation.Nyan.RModes.Show
@@ -91,6 +92,7 @@ test-suite nyan-interpolation-core-tests
other-modules:
Test.Customization
Test.Interpolator
+ Test.Lens
Test.Parser
Test.Processor
Test.Util
diff --git a/core/src/Text/Interpolation/Nyan/Core/Internal/Base.hs b/core/src/Text/Interpolation/Nyan/Core/Internal/Base.hs
index ecbcde2..a84ee47 100644
--- a/core/src/Text/Interpolation/Nyan/Core/Internal/Base.hs
+++ b/core/src/Text/Interpolation/Nyan/Core/Internal/Base.hs
@@ -10,6 +10,8 @@ import Data.Monoid (Endo (..))
import Data.Text (Text)
import Language.Haskell.TH (ExpQ)
+import Text.Interpolation.Nyan.Lens (makeLenses)
+
{- $setup
> import Data.Text
@@ -93,6 +95,8 @@ data SwitchesOptions = SwitchesOptions
, previewLevel :: PreviewLevel
} deriving stock (Show, Eq)
+makeLenses ''SwitchesOptions
+
-- | Default switches options set in the interpolator, those that are used
-- in @[int||...|]@.
--
@@ -108,6 +112,8 @@ data DefaultSwitchesOptions = DefaultSwitchesOptions
, defMonadic :: Maybe Bool
} deriving stock (Show)
+makeLenses ''DefaultSwitchesOptions
+
-- | Default 'DefaultSwitchesOptions'.
--
-- This set of switches tries to leave the text as much unmodified as possible.
@@ -175,3 +181,5 @@ data InterpolatorOptions = InterpolatorOptions
-- with invisibles being marked specially (@!!@), how to update the pieces
-- of text.
}
+
+makeLenses ''InterpolatorOptions
diff --git a/core/src/Text/Interpolation/Nyan/Lens.hs b/core/src/Text/Interpolation/Nyan/Lens.hs
new file mode 100644
index 0000000..f0c8b8a
--- /dev/null
+++ b/core/src/Text/Interpolation/Nyan/Lens.hs
@@ -0,0 +1,52 @@
+-- SPDX-FileCopyrightText: 2022 Serokell
+--
+-- SPDX-License-Identifier: MPL-2.0
+
+module Text.Interpolation.Nyan.Lens
+ ( module Text.Interpolation.Nyan.Lens.TH
+ , module Text.Interpolation.Nyan.Lens.Type
+ , (^.)
+
+ , (%~)
+ , (%=)
+
+ , (.~)
+ , (.=)
+
+ , (?~)
+ , (?=)
+
+ , (&~)
+ )
+ where
+
+import Control.Monad.State (MonadState, State, execState, modify)
+import Control.Applicative (Const(..))
+import Data.Functor.Identity (Identity(..))
+
+import Text.Interpolation.Nyan.Lens.TH
+import Text.Interpolation.Nyan.Lens.Type
+
+(^.) :: s -> Getting a s a -> a
+s ^. l = getConst $ l Const s
+
+(%~) :: ASetter s t a b -> (a -> b) -> s -> t
+l %~ f = runIdentity . l (Identity . f)
+
+(%=) :: MonadState s m => ASetter s s a b -> (a -> b) -> m ()
+l %= f = modify (l %~ f)
+
+(.~) :: ASetter s t a b -> b -> s -> t
+l .~ b = runIdentity . l (const $ Identity b)
+
+(.=) :: MonadState s m => ASetter s s a b -> b -> m ()
+l .= b = modify (l .~ b)
+
+(?~) :: ASetter s t a (Maybe b) -> b -> s -> t
+l ?~ b = l .~ (Just b)
+
+(?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m ()
+l ?= b = modify (l ?~ b)
+
+(&~) :: s -> State s a -> s
+s &~ l = execState l s
diff --git a/core/src/Text/Interpolation/Nyan/Lens/TH.hs b/core/src/Text/Interpolation/Nyan/Lens/TH.hs
new file mode 100644
index 0000000..b361a43
--- /dev/null
+++ b/core/src/Text/Interpolation/Nyan/Lens/TH.hs
@@ -0,0 +1,53 @@
+-- SPDX-FileCopyrightText: 2022 Serokell
+--
+-- SPDX-License-Identifier: MPL-2.0
+
+module Text.Interpolation.Nyan.Lens.TH
+ ( makeLenses
+ )
+ where
+
+import Control.Monad ((<=<))
+import Language.Haskell.TH
+
+-- | Information about the record field the lenses will operate on.
+type RecordFieldInfo = (Name, Strict, Type)
+
+-- | Given a record datatype, derives lenses for all of its fields.
+makeLenses :: Name -> Q [Dec]
+makeLenses = mapM deriveLens <=< extractRecordFields
+
+extractRecordFields :: Name -> Q [RecordFieldInfo]
+extractRecordFields datatype = do
+ let datatypeStr = nameBase datatype
+ info <- reify datatype
+ return $ case info of
+ TyConI (DataD _ _ _ _ [RecC _ fs] _) -> fs
+ TyConI (NewtypeD _ _ _ _ (RecC _ fs) _) -> fs
+ TyConI (DataD _ _ _ _ [_] _) ->
+ error $ "Can't derive lenses without record selectors: " ++ datatypeStr
+ TyConI NewtypeD{} ->
+ error $ "Can't derive lenses without record selectors: " ++ datatypeStr
+ TyConI TySynD{} ->
+ error $ "Can't derive lenses for type synonym: " ++ datatypeStr
+ TyConI DataD{} ->
+ error $ "Can't derive lenses for a sum type: " ++ datatypeStr
+ _ ->
+ error $ "Can't derive lenses for: " ++ datatypeStr
+ ++ ", type name required."
+
+-- | Given a record field name,
+-- produces a single function declaration:
+-- @lensName f a = (\x -> a { field = x }) `fmap` f (field a)@
+deriveLens :: RecordFieldInfo -> Q Dec
+deriveLens (fieldName, _, _) = funD lensName [defLine]
+ where
+ lensName = mkName $ (nameBase fieldName) <> "L"
+ a = mkName "a"
+ f = mkName "f"
+ defLine = clause pats (normalB body) []
+ pats = [varP f, varP a]
+ body = [| (\x -> $(record a fieldName [|x|]))
+ `fmap` $(appE (varE f) (appE (varE fieldName) (varE a)))
+ |]
+ record rec fld val = val >>= \v -> recUpdE (varE rec) [return (fld, v)]
diff --git a/core/src/Text/Interpolation/Nyan/Lens/Type.hs b/core/src/Text/Interpolation/Nyan/Lens/Type.hs
new file mode 100644
index 0000000..d5c28f9
--- /dev/null
+++ b/core/src/Text/Interpolation/Nyan/Lens/Type.hs
@@ -0,0 +1,17 @@
+-- SPDX-FileCopyrightText: 2022 Serokell
+--
+-- SPDX-License-Identifier: MPL-2.0
+
+module Text.Interpolation.Nyan.Lens.Type where
+
+import Control.Applicative (Const)
+import Data.Functor.Identity (Identity)
+
+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
+type Lens' s a = Lens s s a a
+
+type ASetter s t a b = (a -> Identity b) -> s -> Identity t
+type ASetter' s a = ASetter s s a a
+
+type Getting r s a = (a -> Const r a) -> s -> Const r s
+type SimpleGetter s a = forall r. Getting r s a
diff --git a/core/tests/Test/Lens.hs b/core/tests/Test/Lens.hs
new file mode 100644
index 0000000..c54286d
--- /dev/null
+++ b/core/tests/Test/Lens.hs
@@ -0,0 +1,59 @@
+-- SPDX-FileCopyrightText: 2022 Serokell
+--
+-- SPDX-License-Identifier: MPL-2.0
+
+module Test.Lens where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
+
+import Text.Interpolation.Nyan.Lens
+
+data Pair = Pair { first :: Int, second :: String }
+ deriving stock (Show, Eq)
+
+$(makeLenses ''Pair)
+
+newtype Single = Single { value :: Maybe String }
+ deriving stock (Show, Eq)
+
+$(makeLenses ''Single)
+
+test_makeLenses :: TestTree
+test_makeLenses = testGroup "Lenses produced by 'makeLenses' work as expected"
+ [ testGroup "Basic lenses operators work as expected"
+ [ testCase "(^.) operator works" do
+ (pair ^. firstL, pair ^. secondL)
+ @?= (100, "Hundred")
+
+ , testCase "(%~) operator works" do
+ pair & (firstL %~ (+ 1)) & (secondL %~ (<> " and one"))
+ @?= Pair 101 "Hundred and one"
+
+ , testCase "(.~) operator works" do
+ pair & (firstL .~ 102) & (secondL .~ "Hundred and two")
+ @?= Pair 102 "Hundred and two"
+
+ , testCase "(?~) operator works" do
+ single & (valueL ?~ "Some value")
+ @?= Single (Just "Some value")
+ ]
+
+ , testGroup "Operators leveraging 'MonadState', 'State' work as expected"
+ [ testCase "(&~) and (.=) work" do
+ (pair &~ do firstL .= 102)
+ @?= Pair 102 "Hundred"
+
+ , testCase "(&~) and (?=) work" do
+ (single &~ do valueL ?= "Some value")
+ @?= Single (Just "Some value")
+
+ , testCase "(&~) and (%=) work" do
+ (single &~ do valueL %= (const $ Just "Some value"))
+ @?= Single (Just "Some value")
+ ]
+ ]
+ where
+ a & f = f a
+ pair = Pair 100 "Hundred"
+ single = Single Nothing