content: {-# LANGUAGE OverloadedStrings, Rank2Types #-}
  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
  