diff --git a/lib/Text/TEIWA/Annotation.hs b/lib/Text/TEIWA/Annotation.hs index 39f7b3957d8e8c478d63a1b6f8f5c894cb938798..12e3aec9e8f9ff41eb68f449c5159afa58ba4a28 100644 --- a/lib/Text/TEIWA/Annotation.hs +++ b/lib/Text/TEIWA/Annotation.hs @@ -10,9 +10,9 @@ module Text.TEIWA.Annotation ( ) where import Control.Monad.Except (MonadError(..)) -import Control.Monad.RWS (RWST, evalRWST, get, put, tell) -import Data.Text.Lazy as Text (Text, breakOn, concat, drop, length, unpack) -import Text.TEIWA.Config (Config) +import Control.Monad.RWS (RWST, evalRWST, get, put, reader, tell) +import Data.Text.Lazy as Text (Text, breakOn, concat, drop, head, length, unpack) +import Text.TEIWA.Config (Config(..)) import Text.TEIWA.Error (Error(..)) type Attributes = [(Text, Text)] @@ -50,11 +50,15 @@ w = token "w" check :: MonadError Error m => Maybe Text -> TokenAnnotation -> (Text, Text) -> Editor m check openingTag expected@(TokenAnnotation {form}) (before, focused) = - let expectedLength = Text.length form in if Text.length focused >= expectedLength - then put (Text.drop expectedLength focused) - *> mapM_ tell [before, maybe "" id openingTag, w expected] + then do + tagged <- reader (handle . punctuation) + put (Text.drop expectedLength focused) + mapM_ tell [before, maybe "" id openingTag, tagged] else throwError (TermNotFound $ Text.unpack form) + where + expectedLength = Text.length form + handle f = (if expectedLength == 1 && f (Text.head form) then pc else w) expected tokenLevel :: MonadError Error m => Maybe Text -> [TokenAnnotation] -> Editor m tokenLevel Nothing [] = pure ()