{-# LANGUAGE RankNTypes #-}

-- |
-- Module      :  Text.MMark.Parser.Internal
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- An internal module that builds a framework that the "Text.MMark.Parser"
-- module uses.
module Text.MMark.Parser.Internal
  ( -- * Block-level parser monad
    BParser,
    runBParser,
    isNakedAllowed,
    refLevel,
    subEnv,
    registerReference,

    -- * Inline-level parser monad
    IParser,
    runIParser,
    disallowEmpty,
    isEmptyAllowed,
    disallowLinks,
    isLinksAllowed,
    disallowImages,
    isImagesAllowed,
    getLastChar,
    lastChar,
    lookupReference,
    Isp (..),
    CharType (..),

    -- * Reference and footnote definitions
    Defs,

    -- * Other
    MMarkErr (..),
  )
where

import Control.Monad.State.Strict
import Data.Bifunctor
import Data.Function ((&))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import qualified Data.List.NonEmpty as NE
import Data.Ratio ((%))
import Data.Text (Text)
import Data.Text.Metrics (damerauLevenshteinNorm)
import Lens.Micro (Lens', over, set, (.~), (^.))
import Lens.Micro.Extras (view)
import Text.MMark.Parser.Internal.Type
import Text.Megaparsec hiding (State)
import qualified Text.Megaparsec as M
import Text.URI (URI)

----------------------------------------------------------------------------
-- Block-level parser monad

-- | Block-level parser type.
type BParser a = ParsecT MMarkErr Text (State BlockState) a

-- | Run a computation in the 'BParser' monad.
runBParser ::
  -- | The parser to run
  BParser a ->
  -- | File name (only to be used in error messages), may be empty
  FilePath ->
  -- | Input to parse
  Text ->
  -- | Result of parsing
  Either (ParseErrorBundle Text MMarkErr) (a, Defs)
runBParser :: BParser a
-> FilePath
-> Text
-> Either (ParseErrorBundle Text MMarkErr) (a, Defs)
runBParser BParser a
p FilePath
file Text
input =
  case State BlockState (Either (ParseErrorBundle Text MMarkErr) a)
-> BlockState
-> (Either (ParseErrorBundle Text MMarkErr) a, BlockState)
forall s a. State s a -> s -> (a, s)
runState ((State Text MMarkErr, Either (ParseErrorBundle Text MMarkErr) a)
-> Either (ParseErrorBundle Text MMarkErr) a
forall a b. (a, b) -> b
snd ((State Text MMarkErr, Either (ParseErrorBundle Text MMarkErr) a)
 -> Either (ParseErrorBundle Text MMarkErr) a)
-> State
     BlockState
     (State Text MMarkErr, Either (ParseErrorBundle Text MMarkErr) a)
-> State BlockState (Either (ParseErrorBundle Text MMarkErr) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BParser a
-> State Text MMarkErr
-> State
     BlockState
     (State Text MMarkErr, Either (ParseErrorBundle Text MMarkErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> State s e -> m (State s e, Either (ParseErrorBundle s e) a)
runParserT' BParser a
p State Text MMarkErr
forall e. State Text e
st) BlockState
initialBlockState of
    (Left ParseErrorBundle Text MMarkErr
bundle, BlockState
_) -> ParseErrorBundle Text MMarkErr
-> Either (ParseErrorBundle Text MMarkErr) (a, Defs)
forall a b. a -> Either a b
Left ParseErrorBundle Text MMarkErr
bundle
    (Right a
x, BlockState
st') -> (a, Defs) -> Either (ParseErrorBundle Text MMarkErr) (a, Defs)
forall a b. b -> Either a b
Right (a
x, BlockState
st' BlockState -> Getting Defs BlockState Defs -> Defs
forall s a. s -> Getting a s a -> a
^. Getting Defs BlockState Defs
Lens' BlockState Defs
bstDefs)
  where
    st :: State Text e
st = FilePath -> Text -> Int -> State Text e
forall e. FilePath -> Text -> Int -> State Text e
mkInitialState FilePath
file Text
input Int
0

-- | Ask whether naked paragraphs are allowed in this context.
isNakedAllowed :: BParser Bool
isNakedAllowed :: BParser Bool
isNakedAllowed = (BlockState -> Bool) -> BParser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BlockState -> Getting Bool BlockState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool BlockState Bool
Lens' BlockState Bool
bstAllowNaked)

-- | Lookup current reference indentation level.
refLevel :: BParser Pos
refLevel :: BParser Pos
refLevel = (BlockState -> Pos) -> BParser Pos
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BlockState -> Getting Pos BlockState Pos -> Pos
forall s a. s -> Getting a s a -> a
^. Getting Pos BlockState Pos
Lens' BlockState Pos
bstRefLevel)

-- | Execute 'BParser' computation with modified environment.
subEnv ::
  -- | Whether naked paragraphs should be allowed
  Bool ->
  -- | Reference indentation level
  Pos ->
  -- | The parser we want to set the environment for
  BParser a ->
  -- | The resulting parser
  BParser a
subEnv :: Bool -> Pos -> BParser a -> BParser a
subEnv Bool
allowNaked Pos
rlevel =
  Lens' BlockState Bool -> Bool -> BParser a -> BParser a
forall s (m :: * -> *) a b.
MonadState s m =>
Lens' s a -> a -> m b -> m b
locally Lens' BlockState Bool
bstAllowNaked Bool
allowNaked
    (BParser a -> BParser a)
-> (BParser a -> BParser a) -> BParser a -> BParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BlockState Pos -> Pos -> BParser a -> BParser a
forall s (m :: * -> *) a b.
MonadState s m =>
Lens' s a -> a -> m b -> m b
locally Lens' BlockState Pos
bstRefLevel Pos
rlevel

-- | Register a reference (link\/image) definition.
registerReference ::
  -- | Reference name
  Text ->
  -- | Reference 'URI' and optional title
  (URI, Maybe Text) ->
  -- | 'True' if there is a conflicting definition
  BParser Bool
registerReference :: Text -> (URI, Maybe Text) -> BParser Bool
registerReference = Lens' Defs (HashMap DefLabel (URI, Maybe Text))
-> Text -> (URI, Maybe Text) -> BParser Bool
forall a.
Lens' Defs (HashMap DefLabel a) -> Text -> a -> BParser Bool
registerGeneric Lens' Defs (HashMap DefLabel (URI, Maybe Text))
referenceDefs

-- | A generic function for registering definitions in 'BParser'.
registerGeneric ::
  -- | How to access the definition map
  Lens' Defs (HashMap DefLabel a) ->
  -- | Definition name
  Text ->
  -- | Data
  a ->
  -- | 'True' if there is a conflicting definition
  BParser Bool
registerGeneric :: Lens' Defs (HashMap DefLabel a) -> Text -> a -> BParser Bool
registerGeneric Lens' Defs (HashMap DefLabel a)
l Text
name a
a = do
  let dlabel :: DefLabel
dlabel = Text -> DefLabel
mkDefLabel Text
name
  HashMap DefLabel a
defs <- (BlockState -> HashMap DefLabel a)
-> ParsecT MMarkErr Text (State BlockState) (HashMap DefLabel a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BlockState
-> Getting (HashMap DefLabel a) BlockState (HashMap DefLabel a)
-> HashMap DefLabel a
forall s a. s -> Getting a s a -> a
^. (Defs -> Const (HashMap DefLabel a) Defs)
-> BlockState -> Const (HashMap DefLabel a) BlockState
Lens' BlockState Defs
bstDefs ((Defs -> Const (HashMap DefLabel a) Defs)
 -> BlockState -> Const (HashMap DefLabel a) BlockState)
-> ((HashMap DefLabel a
     -> Const (HashMap DefLabel a) (HashMap DefLabel a))
    -> Defs -> Const (HashMap DefLabel a) Defs)
-> Getting (HashMap DefLabel a) BlockState (HashMap DefLabel a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap DefLabel a
 -> Const (HashMap DefLabel a) (HashMap DefLabel a))
-> Defs -> Const (HashMap DefLabel a) Defs
Lens' Defs (HashMap DefLabel a)
l)
  if DefLabel -> HashMap DefLabel a -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member DefLabel
dlabel HashMap DefLabel a
defs
    then Bool -> BParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else do
      (BlockState -> BlockState)
-> ParsecT MMarkErr Text (State BlockState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((BlockState -> BlockState)
 -> ParsecT MMarkErr Text (State BlockState) ())
-> (BlockState -> BlockState)
-> ParsecT MMarkErr Text (State BlockState) ()
forall a b. (a -> b) -> a -> b
$ ASetter
  BlockState BlockState (HashMap DefLabel a) (HashMap DefLabel a)
-> (HashMap DefLabel a -> HashMap DefLabel a)
-> BlockState
-> BlockState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Defs -> Identity Defs) -> BlockState -> Identity BlockState
Lens' BlockState Defs
bstDefs ((Defs -> Identity Defs) -> BlockState -> Identity BlockState)
-> ((HashMap DefLabel a -> Identity (HashMap DefLabel a))
    -> Defs -> Identity Defs)
-> ASetter
     BlockState BlockState (HashMap DefLabel a) (HashMap DefLabel a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap DefLabel a -> Identity (HashMap DefLabel a))
-> Defs -> Identity Defs
Lens' Defs (HashMap DefLabel a)
l) (DefLabel -> a -> HashMap DefLabel a -> HashMap DefLabel a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert DefLabel
dlabel a
a)
      Bool -> BParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

----------------------------------------------------------------------------
-- Inline-level parser monad

-- | Inline-level parser type.
type IParser a = StateT InlineState (Parsec MMarkErr Text) a

-- | Run a computation in the 'IParser' monad.
runIParser ::
  -- | Reference and footnote definitions obtained as a result of
  -- block-level parsing
  Defs ->
  -- | The parser to run
  IParser a ->
  -- | Input for the parser
  Isp ->
  -- | Result of parsing
  Either (ParseError Text MMarkErr) a
runIParser :: Defs -> IParser a -> Isp -> Either (ParseError Text MMarkErr) a
runIParser Defs
_ IParser a
_ (IspError ParseError Text MMarkErr
err) = ParseError Text MMarkErr -> Either (ParseError Text MMarkErr) a
forall a b. a -> Either a b
Left ParseError Text MMarkErr
err
runIParser Defs
defs IParser a
p (IspSpan Int
offset Text
input) =
  (ParseErrorBundle Text MMarkErr -> ParseError Text MMarkErr)
-> Either (ParseErrorBundle Text MMarkErr) a
-> Either (ParseError Text MMarkErr) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (NonEmpty (ParseError Text MMarkErr) -> ParseError Text MMarkErr
forall a. NonEmpty a -> a
NE.head (NonEmpty (ParseError Text MMarkErr) -> ParseError Text MMarkErr)
-> (ParseErrorBundle Text MMarkErr
    -> NonEmpty (ParseError Text MMarkErr))
-> ParseErrorBundle Text MMarkErr
-> ParseError Text MMarkErr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text MMarkErr
-> NonEmpty (ParseError Text MMarkErr)
forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
bundleErrors) ((State Text MMarkErr, Either (ParseErrorBundle Text MMarkErr) a)
-> Either (ParseErrorBundle Text MMarkErr) a
forall a b. (a, b) -> b
snd (Parsec MMarkErr Text a
-> State Text MMarkErr
-> (State Text MMarkErr, Either (ParseErrorBundle Text MMarkErr) a)
forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
runParser' (IParser a -> InlineState -> Parsec MMarkErr Text a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT IParser a
p InlineState
ist) State Text MMarkErr
forall e. State Text e
pst))
  where
    ist :: InlineState
ist = InlineState
initialInlineState InlineState -> (InlineState -> InlineState) -> InlineState
forall a b. a -> (a -> b) -> b
& (Defs -> Identity Defs) -> InlineState -> Identity InlineState
Lens' InlineState Defs
istDefs ((Defs -> Identity Defs) -> InlineState -> Identity InlineState)
-> Defs -> InlineState -> InlineState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Defs
defs
    pst :: State Text e
pst = FilePath -> Text -> Int -> State Text e
forall e. FilePath -> Text -> Int -> State Text e
mkInitialState FilePath
"" Text
input Int
offset

-- | Disallow parsing of empty inlines.
disallowEmpty :: IParser a -> IParser a
disallowEmpty :: IParser a -> IParser a
disallowEmpty = Lens' InlineState Bool -> Bool -> IParser a -> IParser a
forall s (m :: * -> *) a b.
MonadState s m =>
Lens' s a -> a -> m b -> m b
locally Lens' InlineState Bool
istAllowEmpty Bool
False

-- | Ask whether parsing of empty inlines is allowed.
isEmptyAllowed :: IParser Bool
isEmptyAllowed :: IParser Bool
isEmptyAllowed = (InlineState -> Bool) -> IParser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting Bool InlineState Bool -> InlineState -> Bool
forall a s. Getting a s a -> s -> a
view Getting Bool InlineState Bool
Lens' InlineState Bool
istAllowEmpty)

-- | Disallow parsing of links.
disallowLinks :: IParser a -> IParser a
disallowLinks :: IParser a -> IParser a
disallowLinks = Lens' InlineState Bool -> Bool -> IParser a -> IParser a
forall s (m :: * -> *) a b.
MonadState s m =>
Lens' s a -> a -> m b -> m b
locally Lens' InlineState Bool
istAllowLinks Bool
False

-- | Ask whether parsing of links is allowed.
isLinksAllowed :: IParser Bool
isLinksAllowed :: IParser Bool
isLinksAllowed = (InlineState -> Bool) -> IParser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting Bool InlineState Bool -> InlineState -> Bool
forall a s. Getting a s a -> s -> a
view Getting Bool InlineState Bool
Lens' InlineState Bool
istAllowLinks)

-- | Disallow parsing of images.
disallowImages :: IParser a -> IParser a
disallowImages :: IParser a -> IParser a
disallowImages = Lens' InlineState Bool -> Bool -> IParser a -> IParser a
forall s (m :: * -> *) a b.
MonadState s m =>
Lens' s a -> a -> m b -> m b
locally Lens' InlineState Bool
istAllowImages Bool
False

-- | Ask whether parsing of images is allowed.
isImagesAllowed :: IParser Bool
isImagesAllowed :: IParser Bool
isImagesAllowed = (InlineState -> Bool) -> IParser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting Bool InlineState Bool -> InlineState -> Bool
forall a s. Getting a s a -> s -> a
view Getting Bool InlineState Bool
Lens' InlineState Bool
istAllowImages)

-- | Get type of the last parsed character.
getLastChar :: IParser CharType
getLastChar :: IParser CharType
getLastChar = (InlineState -> CharType) -> IParser CharType
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting CharType InlineState CharType -> InlineState -> CharType
forall a s. Getting a s a -> s -> a
view Getting CharType InlineState CharType
Lens' InlineState CharType
istLastChar)

-- | Register type of the last parsed character.
lastChar :: CharType -> IParser ()
lastChar :: CharType -> IParser ()
lastChar = (InlineState -> InlineState) -> IParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((InlineState -> InlineState) -> IParser ())
-> (CharType -> InlineState -> InlineState)
-> CharType
-> IParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter InlineState InlineState CharType CharType
-> CharType -> InlineState -> InlineState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter InlineState InlineState CharType CharType
Lens' InlineState CharType
istLastChar
{-# INLINE lastChar #-}

-- | Lookup a link\/image reference definition.
lookupReference ::
  -- | Reference name
  Text ->
  -- | A collection of suggested reference names in 'Left' (typo
  -- corrections) or the requested definition in 'Right'
  IParser (Either [Text] (URI, Maybe Text))
lookupReference :: Text -> IParser (Either [Text] (URI, Maybe Text))
lookupReference = Lens' Defs (HashMap DefLabel (URI, Maybe Text))
-> Text -> IParser (Either [Text] (URI, Maybe Text))
forall a.
Lens' Defs (HashMap DefLabel a)
-> Text -> IParser (Either [Text] a)
lookupGeneric Lens' Defs (HashMap DefLabel (URI, Maybe Text))
referenceDefs

-- | A generic function for looking up definition in 'IParser'.
lookupGeneric ::
  -- | How to access the definition map
  Lens' Defs (HashMap DefLabel a) ->
  -- | Definition name
  Text ->
  -- | A collection of suggested reference names in 'Left' (typo
  -- corrections) or the requested definition in 'Right'
  IParser (Either [Text] a)
lookupGeneric :: Lens' Defs (HashMap DefLabel a)
-> Text -> IParser (Either [Text] a)
lookupGeneric Lens' Defs (HashMap DefLabel a)
l Text
name = do
  let dlabel :: DefLabel
dlabel = Text -> DefLabel
mkDefLabel Text
name
  HashMap DefLabel a
defs <- (InlineState -> HashMap DefLabel a)
-> StateT InlineState (Parsec MMarkErr Text) (HashMap DefLabel a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getting (HashMap DefLabel a) InlineState (HashMap DefLabel a)
-> InlineState -> HashMap DefLabel a
forall a s. Getting a s a -> s -> a
view ((Defs -> Const (HashMap DefLabel a) Defs)
-> InlineState -> Const (HashMap DefLabel a) InlineState
Lens' InlineState Defs
istDefs ((Defs -> Const (HashMap DefLabel a) Defs)
 -> InlineState -> Const (HashMap DefLabel a) InlineState)
-> ((HashMap DefLabel a
     -> Const (HashMap DefLabel a) (HashMap DefLabel a))
    -> Defs -> Const (HashMap DefLabel a) Defs)
-> Getting (HashMap DefLabel a) InlineState (HashMap DefLabel a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap DefLabel a
 -> Const (HashMap DefLabel a) (HashMap DefLabel a))
-> Defs -> Const (HashMap DefLabel a) Defs
Lens' Defs (HashMap DefLabel a)
l))
  case DefLabel -> HashMap DefLabel a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup DefLabel
dlabel HashMap DefLabel a
defs of
    Maybe a
Nothing -> Either [Text] a -> IParser (Either [Text] a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] a -> IParser (Either [Text] a))
-> ([Text] -> Either [Text] a)
-> [Text]
-> IParser (Either [Text] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Either [Text] a
forall a b. a -> Either a b
Left ([Text] -> IParser (Either [Text] a))
-> [Text] -> IParser (Either [Text] a)
forall a b. (a -> b) -> a -> b
$ DefLabel -> [DefLabel] -> [Text]
closeNames DefLabel
dlabel (HashMap DefLabel a -> [DefLabel]
forall k v. HashMap k v -> [k]
HM.keys HashMap DefLabel a
defs)
    Just a
x -> Either [Text] a -> IParser (Either [Text] a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either [Text] a
forall a b. b -> Either a b
Right a
x)

-- | Select close enough (using the normalized Damerau-Levenshtein metric)
-- definition labels.
closeNames :: DefLabel -> [DefLabel] -> [Text]
closeNames :: DefLabel -> [DefLabel] -> [Text]
closeNames DefLabel
r' =
  (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
x -> Text -> Text -> Ratio Int
damerauLevenshteinNorm Text
r Text
x Ratio Int -> Ratio Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
2 Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% Int
3))
    ([Text] -> [Text])
-> ([DefLabel] -> [Text]) -> [DefLabel] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefLabel -> Text) -> [DefLabel] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DefLabel -> Text
unDefLabel
  where
    r :: Text
r = DefLabel -> Text
unDefLabel DefLabel
r'

----------------------------------------------------------------------------
-- Helpers

-- | Setup an initial parser state.
mkInitialState ::
  -- | File name to use
  FilePath ->
  -- | Input
  Text ->
  -- | Starting offset
  Int ->
  M.State Text e
mkInitialState :: FilePath -> Text -> Int -> State Text e
mkInitialState FilePath
file Text
input Int
offset =
  State :: forall s e. s -> Int -> PosState s -> [ParseError s e] -> State s e
M.State
    { stateInput :: Text
stateInput = Text
input,
      stateOffset :: Int
stateOffset = Int
offset,
      statePosState :: PosState Text
statePosState =
        PosState :: forall s. s -> Int -> SourcePos -> Pos -> FilePath -> PosState s
PosState
          { pstateInput :: Text
pstateInput = Text
input,
            pstateOffset :: Int
pstateOffset = Int
offset,
            pstateSourcePos :: SourcePos
pstateSourcePos = FilePath -> SourcePos
initialPos FilePath
file,
            pstateTabWidth :: Pos
pstateTabWidth = Int -> Pos
mkPos Int
4,
            pstateLinePrefix :: FilePath
pstateLinePrefix = FilePath
""
          },
      stateParseErrors :: [ParseError Text e]
stateParseErrors = []
    }

-- | Locally change state in a state monad and then restore it back.
locally :: MonadState s m => Lens' s a -> a -> m b -> m b
locally :: Lens' s a -> a -> m b -> m b
locally Lens' s a
l a
x m b
m = do
  a
y <- (s -> a) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
Lens' s a
l)
  (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (ASetter s s a a -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a a
Lens' s a
l a
x)
  b
r <- m b
m
  (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (ASetter s s a a -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s a a
Lens' s a
l a
y)
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r