packages feed

text-lens (empty) → 0.1.0.0

raw patch · 5 files changed

+370/−0 lines, 5 filesdep +basedep +extradep +hspecsetup-changed

Dependencies added: base, extra, hspec, lens, text, text-lens

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License++Copyright (c) 2016 Chris Penner++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Control/Lens/Text.hs view
@@ -0,0 +1,145 @@+{-# 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
+ test/Spec.hs view
@@ -0,0 +1,157 @@+import Test.Hspec+import Control.Lens.Text as TL+import Control.Lens++main :: IO ()+main = hspec $ describe "TextLens" $ do++  describe "before" $ do+    it "gets before the offset" $+      "hello" ^. TL.before 3 `shouldBe` "hel"+    it "gets full string if before end" $+      "hello" ^. TL.before 5 `shouldBe` "hello"+    it "gets \"\" if before 0" $+      "hello" ^. TL.before 0 `shouldBe` ""+    it "gets full string if out of bounds" $+      "hello" ^. TL.before 10 `shouldBe` "hello"++    it "sets before the offset" $+      ("hello" & TL.before 3 .~ "zz") `shouldBe` "zzlo"+    it "prepends if before 0" $+      ("hello" & TL.before 0 .~ "zz") `shouldBe` "zzhello"++  describe "after" $ do+    it "gets after the offset" $+      "hello" ^. TL.after 3 `shouldBe` "lo"+    it "gets full string if after 0" $+      "hello" ^. TL.after 0 `shouldBe` "hello"+    it "gets \"\" if at end" $+      "hello" ^. TL.after 5 `shouldBe` ""+    it "gets \"\" if out of bounds end" $+      "hello" ^. TL.after 10 `shouldBe` ""++    it "sets after the offset" $+      ("hello" & TL.after 3 .~ "zz") `shouldBe` "helzz"+    it "appends if before end" $+      ("hello" & TL.after 5 .~ "zz") `shouldBe` "hellozz"++  describe "nWords" $ do+    it "handles 0" $+      "hi there you" ^. nWords 0 `shouldBe` ""++    it "gets the first word" $+      "hi there you" ^. nWords 1 `shouldBe` "hi"++    it "gets the first n word" $+      "hi there you" ^. nWords 2 `shouldBe` "hi there"++    it "setting 0 words prepends" $+      ("hi there you" & nWords 0 .~ "new words")  `shouldBe` "new words hi there you"++    it "sets the first n words" $+      ("hi there you" & nWords 2 .~ "new words")  `shouldBe` "new words you"++  describe "splittingBy" $ do+    it "gets the split list" $+      "hi|there|you" ^. splittingBy "|" `shouldBe` ["hi", "there", "you"]++    it "sets splits" $+      ("hi|there|you" & splittingBy "|" .~ ["new", "stuff"]) `shouldBe` "new|stuff"++  describe "joiningBy" $ do+    it "gets the joined list" $+      ["hi", "there", "you"] ^. joiningBy "|" `shouldBe` "hi|there|you"+    it "gets the joined elem" $+      ["hi"] ^. joiningBy "|" `shouldBe` "hi"++    it "sets the joined list" $+      (["hi", "there"] & joiningBy "|" .~ "new|stuff") `shouldBe` ["new", "stuff"]++  describe "intillNextN" $ do+    it "gets text up to and including next pattern" $+      "my test str" ^. TL.intillNextN 1 "te" `shouldBe` "my te"+    it "gets text up to and including 2nd pattern" $+      "my test str test end" ^. TL.intillNextN 2 "test" `shouldBe` "my test str test"+    it "gets when pattern is first" $+      "my test" ^. TL.intillNextN 1 "my" `shouldBe` "my"+    it "gets \"\" when no match" $+      "my test" ^. TL.intillNextN 1 "nope" `shouldBe` ""++    it "sets text up to and including next pattern" $+      ("my test test str" & TL.intillNextN 2 "te" .~ "_") `shouldBe` "_st str"+    it "set is null op if no match found" $+      ("my test str" & TL.intillNextN 1 "xx" .~ "_") `shouldBe` "my test str"++  describe "tillNextN" $ do+    it "gets text up to but not including next pattern" $+      "my test str" ^. TL.tillNextN 1 "te" `shouldBe` "my "+    it "gets text up to but not including 2nd pattern" $+      "my test str test end" ^. TL.tillNextN 2 "test" `shouldBe` "my test str "+    it "gets \"\" when pattern is first" $+      "my test" ^. TL.tillNextN 1 "my" `shouldBe` ""+    it "gets \"\" when no match" $+      "my test" ^. TL.tillNextN 1 "nope" `shouldBe` ""++    it "sets text up to but not including next pattern" $+      ("my test test str" & TL.tillNextN 2 "te" .~ "_") `shouldBe` "_test str"+    it "set is null op if no match found" $+      ("my test str" & TL.tillNextN 1 "xx" .~ "_") `shouldBe` "my test str"+++  describe "intillPrevN" $ do+    it "gets text up to and including prev pattern" $+      "my test str" ^. TL.intillPrevN 1 "test" `shouldBe` "test str"+    it "gets text up to and including 2nd pattern" $+      "my test str test end" ^. TL.intillPrevN 2 "test" `shouldBe` "test str test end"+    it "gets when pattern is first" $+      "my test" ^. TL.intillPrevN 1 "st" `shouldBe` "st"+    it "gets \"\" when no match" $+      "my test" ^. TL.intillPrevN 1 "nope" `shouldBe` ""++    it "sets text up to and including prev pattern" $+      ("my test test str" & TL.intillPrevN 2 "te" .~ "_") `shouldBe` "my _"+    it "set is null op if no match found" $+      ("my test str" & TL.intillPrevN 1 "xx" .~ "_") `shouldBe` "my test str"+++  describe "tillPrevN" $ do+    it "gets text up to but not including prev pattern" $+      "my test str" ^. TL.tillPrevN 1 "test" `shouldBe` " str"+    it "gets text up to but not including 2nd pattern" $+      "my test str test end" ^. TL.tillPrevN 2 "test" `shouldBe` " str test end"+    it "gets \"\" when pattern is first" $+      "my test" ^. TL.tillPrevN 1 "test" `shouldBe` ""+    it "gets \"\" when no match" $+      "my test" ^. TL.tillPrevN 1 "nope" `shouldBe` ""+++    it "sets text up to but not including next pattern" $+      ("my test test str" & TL.tillPrevN 2 "te" .~ "_") `shouldBe` "my te_"+    it "set is null op if no match found" $+      ("my test str" & TL.tillPrevN 1 "xx" .~ "_") `shouldBe` "my test str"++  describe "range" $ do+    it "gets the proper range" $+      "hi hey hello" ^. TL.range 3 6 `shouldBe` "hey"+    it "gets \"\" if invalid range" $+      "hello" ^. TL.range 5 3 `shouldBe` ""+    it "gets full string" $+      "hello" ^. TL.range 0 5 `shouldBe` "hello"++    it "sets the range" $+      ("hi hey hello" & TL.range 3 6 .~ "__") `shouldBe` "hi __ hello"+    it "sets empty range" $+      ("hi hey hello" & TL.range 3 3 .~ "greetings ") `shouldBe` "hi greetings hey hello"+    it "set is null op if invalid range" $+      ("hi hey hello" & TL.range 7 3 .~ "__") `shouldBe` "hi hey hello"++  describe "matching" $ do+    it "gets matches" $+      "hi hey hello" ^. TL.matching "he" `shouldBe` "hehe"+    it "gets \"\" if no match" $+      "hello" ^. TL.matching "z" `shouldBe` ""++    it "sets matches" $+      ("hi hey hello" & TL.matching "he" .~ "__") `shouldBe` "hi __y __llo"+    it "set is null op if no match" $+      ("hi hey hello" & TL.matching "z" .~ "__") `shouldBe` "hi hey hello"
+ text-lens.cabal view
@@ -0,0 +1,45 @@+name:                text-lens+version:             0.1.0.0+synopsis:            Lenses for operating over text+description:         Lenses for operating over text+homepage:            https://github.com/ChrisPenner/rasa+license:             MIT+license-file:        LICENSE+author:              Chris Penner+maintainer:          christopher.penner@gmail.com+copyright:           2016 Chris Penner+category:            Lens+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library +  hs-source-dirs:      src+  exposed-modules:+                       Control.Lens.Text++  build-depends:       base >= 4.7 && < 5+                     , text+                     , lens+                     , extra+  default-language:    Haskell2010++  default-extensions:  OverloadedStrings++  ghc-options:         -Wall++test-suite text-lens-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , text-lens+                     , hspec+                     , lens+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings++source-repository head+  type:     git+  location: https://github.com/ChrisPenner/rasa