module Control.Lens.Text where
import Control.Lens
import qualified Data.Text as T
import Data.Monoid
import Data.List.Extra (takeEnd, dropEnd)
before :: Int -> Lens' T.Text T.Text
before n = lens getter setter
where getter = T.take n
setter old new = new <> T.drop n old
after :: Int -> Lens' T.Text T.Text
after n = lens getter setter
where getter = T.drop n
setter old new = T.take n old <> new
nWords :: Int -> Lens' T.Text T.Text
nWords n = lens getter setter
where getter = T.unwords . take n . T.words
setter old new = T.unwords . (T.words new ++) . drop n . T.words $ old
intillNextN :: Int -> T.Text -> Lens' T.Text T.Text
intillNextN n pat = lens getter setter
where focus :: Traversal' T.Text T.Text
focus = splittingByInc pat . moreThanOne . lTake n . joiningByInc pat
getter = view focus
setter old new = old & focus .~ new
intillPrevN :: Int -> T.Text -> Lens' T.Text T.Text
intillPrevN n pat = lens getter setter
where getter = view $ splittingByInc pat .
moreThanOne .
lTakeEnd n .
to (pat :) .
joiningByInc pat
setter old new = old
& splittingBy pat . moreThanOne
.~ (T.dropEnd
(getter old ^. to T.length)
old <> new)
^. splittingBy pat
tillNextN :: Int -> T.Text -> Lens' T.Text T.Text
tillNextN n pat = lens getter setter
where focus :: Traversal' T.Text T.Text
focus = splittingBy pat . moreThanOne . lTake n . joiningBy pat
getter = view focus
setter old new = old & focus .~ new
tillPrevN :: Int -> T.Text -> Lens' T.Text T.Text
tillPrevN n pat = lens getter setter
where focus :: Traversal' T.Text T.Text
focus =
splittingBy pat .
moreThanOne .
lTakeEnd n .
joiningBy pat
getter = view focus
setter old new = old & focus .~ new
tillNext :: T.Text -> Lens' T.Text T.Text
tillNext = tillNextN 1
intillNext :: T.Text -> Lens' T.Text T.Text
intillNext = intillNextN 1
tillPrev :: T.Text -> Lens' T.Text T.Text
tillPrev = tillPrevN 1
intillPrev :: T.Text -> Lens' T.Text T.Text
intillPrev = intillPrevN 1
range :: Int -> Int -> Lens' T.Text T.Text
range start end = lens getter setter
where getter = T.take (end start) . T.drop start
setter old new
| start > end = old
| otherwise = T.take start old <> new <> T.drop end old
matching :: T.Text -> Lens' T.Text T.Text
matching pat = lens getter setter
where getter = (`T.replicate` pat) . T.count pat
setter old new = T.replace pat new old
split' :: T.Text -> T.Text -> [T.Text]
split' pat t = case T.splitOn pat t of
[_] -> []
xs -> xs
moreThanOne :: Prism' [a] [a]
moreThanOne = prism' review' getter
where review' = id
getter :: [a] -> Maybe [a]
getter [] = Nothing
getter [_] = Nothing
getter xs = Just xs
splittingBy :: T.Text -> Lens' T.Text [T.Text]
splittingBy pat = lens getter setter
where getter = T.splitOn pat
setter _ = T.intercalate pat
splittingByInc :: T.Text -> Lens' T.Text [T.Text]
splittingByInc pat = lens getter setter
where getter txt = let lst = T.splitOn pat txt
in lst & reversed . dropping 1 traverse %~ (<> pat)
setter _ = T.concat
joiningByInc :: T.Text -> Lens' [T.Text] T.Text
joiningByInc pat = lens getter setter
where getter = T.concat
setter _ new = T.splitOn pat new & reversed . dropping 1 traversed %~ (<> pat)
joiningBy :: T.Text -> Lens' [T.Text] T.Text
joiningBy pat = lens getter setter
where getter = T.intercalate pat
setter _ = T.splitOn pat
lTake :: Int -> Lens' [a] [a]
lTake n = lens getter setter
where getter = take n
setter old new = new ++ drop n old
lTakeEnd :: Int -> Lens' [a] [a]
lTakeEnd n = lens getter setter
where getter = takeEnd n
setter old new = dropEnd n old ++ new
lDropEnd :: Int -> Lens' [a] [a]
lDropEnd n = lens getter setter
where getter = dropEnd n
setter old new = new ++ takeEnd n old
lDrop :: Int -> Lens' [a] [a]
lDrop n = lens getter setter
where getter = drop n
setter old new = take n old ++ new