packages feed

text-replace (empty) → 0.0.0.1

raw patch · 5 files changed

+549/−0 lines, 5 filesdep +basedep +containersdep +hedgehog

Dependencies added: base, containers, hedgehog, neat-interpolation, optparse-applicative, parsec, text, text-replace

Files

+ app/text-replace.hs view
@@ -0,0 +1,179 @@+import Text.Replace++-- base+import           Control.Applicative ((<|>))+import           Control.Arrow       ((>>>))+import           Data.Foldable       (asum)+import           Data.Function       ((&))+import           Data.Functor        (void)+import           Data.List.NonEmpty  (NonEmpty (..))+import           System.Exit         (die)+import qualified System.IO           as IO++-- optparse-applicative+import qualified Options.Applicative as Opt++-- parsec+import qualified Text.Parsec        as P+import           Text.Parsec.String as P (Parser)++(!) :: Monoid a => a -> a -> a+(!) = mappend+infixr 6 !++optsParserInfo :: Opt.ParserInfo Opts+optsParserInfo+  = Opt.info (Opt.helper <*> optsParser)+  $ Opt.header "Perform simple replacements in a text file, using a list \+               \of search/replace pairs."+  ! Opt.footer "The search for strings to replace is performed left-to-right, \+               \preferring longer matches to shorter ones. All streams are \+               \assumed to be UTF-8 encoded."++enc :: IO.TextEncoding+enc = IO.utf8++main :: IO ()+main = do+  opts <- Opt.execParser optsParserInfo+  IO.hSetEncoding IO.stdout enc+  IO.hSetEncoding IO.stderr enc++  let d = delimiterOpt opts++  argMapping <-+    let+      f arg = parseReplacementList' d "--mapping" arg+    in+      foldMap f (opt_mapping opts)++  fileMapping <-+    let+      f path = IO.withFile path IO.ReadMode $ \h -> do+        IO.hSetEncoding h enc+        x <- IO.hGetContents h+        parseReplacementList' d path x+     in+      foldMap f (opt_mapFile opts)++  withInputH (opt_inFile opts) $ \inH ->+    withOutputH (opt_outFile opts) $ \outH -> do+      input <- IO.hGetContents inH+      let output = replaceWithList (argMapping ++ fileMapping) input+      IO.hPutStr outH output++withInputH :: Maybe FilePath -> (IO.Handle -> IO a) -> IO a+withInputH Nothing f = f IO.stdin+withInputH (Just path) f = IO.withFile path IO.ReadMode f++withOutputH :: Maybe FilePath -> (IO.Handle -> IO a) -> IO a+withOutputH Nothing f = f IO.stdout+withOutputH (Just path) f = IO.withFile path IO.WriteMode f++data Opts =+  Opts+    { opt_inFile :: Maybe FilePath+    , opt_outFile :: Maybe FilePath+    , opt_mapping :: [String]+    , opt_mapFile :: [FilePath]+    , opt_delimiter :: [Delimiter]+    , opt_newlineDelimiter :: Bool+    }++optsParser :: Opt.Parser Opts+optsParser =+  Opts+    <$> inFileParser+    <*> outFileParser+    <*> mappingParser+    <*> mapFileParser+    <*> delimiterParser+    <*> newlineDelimiterParser++inFileParser :: Opt.Parser (Maybe FilePath)+inFileParser+  = Opt.optional+  $ Opt.strOption+  $ Opt.metavar "FILEPATH"+  ! Opt.long "in-file"+  ! Opt.short 'i'+  ! Opt.help "Input file to read (optional, defaults to stdin)"++outFileParser :: Opt.Parser (Maybe FilePath)+outFileParser+  = Opt.optional+  $ Opt.strOption+  $ Opt.metavar "FILEPATH"+  ! Opt.long "out-file"+  ! Opt.short 'o'+  ! Opt.help "Output file to write (optional, defaults to stdout)"++mappingParser :: Opt.Parser [String]+mappingParser+  = Opt.many+  $ Opt.strOption+  $ Opt.metavar "MAPPING"+  ! Opt.long "mapping"+  ! Opt.short 'm'+  ! Opt.help "A list of search/replace pairs, separated by any of the \+             \delimiters"++mapFileParser :: Opt.Parser [FilePath]+mapFileParser+  = Opt.many+  $ Opt.strOption+  $ Opt.metavar "FILEPATH"+  ! Opt.long "map-file"+  ! Opt.short 'f'+  ! Opt.help "A file containing a list of search/replace pairs, \+             \separated by any of the delimiters"++type Delimiter = String++delimiterParser :: Opt.Parser [Delimiter]+delimiterParser+  = Opt.many+  $ Opt.strOption+  $ Opt.metavar "DELIMITER"+  ! Opt.long "delimiter"+  ! Opt.short 'd'+  ! Opt.help "Add a delimiter that separates search/replace strings in \+             \--mapping and in the contents of --map-file"++newlineDelimiterParser :: Opt.Parser Bool+newlineDelimiterParser+  = Opt.switch+  $ Opt.long "newline-delimiter"+  ! Opt.short 'n'+  ! Opt.help "Add newline as a delimiter"++delimiterOpt :: Opts -> [Delimiter]+delimiterOpt opts =+  opt_delimiter opts+  & (if opt_newlineDelimiter opts then ("\n" :) else id)++parseReplacementList :: [Delimiter] -> P.SourceName -> String+                     -> Either P.ParseError [Replace]+parseReplacementList delims sourceName input =+  let+    delimP :: P.Parser ()+    delimP = delims & fmap (void . P.try . P.string) & asum++    strP :: P.Parser String+    strP = P.manyTill P.anyChar (delimP <|> P.eof)++    strP' :: P.Parser String'+    strP' = do+      x <- P.anyChar+      xs <- P.manyTill P.anyChar (delimP)+      pure $ String' (x :| xs)++    replaceP :: P.Parser Replace+    replaceP = Replace <$> strP' <*> strP++  in+    P.parse (P.many replaceP <* P.eof) sourceName input++parseReplacementList' :: [Delimiter] -> P.SourceName -> String -> IO [Replace]+parseReplacementList' delims sourceName input =+  parseReplacementList delims sourceName input & either (show >>> die) pure
+ license.txt view
@@ -0,0 +1,13 @@+Copyright 2017 Chris Martin++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ src/Text/Replace.hs view
@@ -0,0 +1,211 @@+module Text.Replace+  (+  -- * Performing replacement+    replaceWithList, replaceWithMap, replaceWithTrie++  -- * Specifying replacements+  , Replace (..), ReplaceMap, listToMap, mapToAscList++  -- * Replacements in trie structure+  , Trie, Trie' (..), listToTrie, ascListToTrie, mapToTrie, drawTrie++  -- * Non-empty string+  , String' (..), string'fromString, string'head, string'tail++  ) where++-- base+import           Control.Arrow      ((>>>))+import qualified Data.Foldable      as Foldable+import           Data.Function      (on)+import           Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NonEmpty+import           Data.String        (IsString (..))++-- containers+import           Data.Map        (Map)+import qualified Data.Map.Strict as Map+import           Data.Tree       (Tree)+import qualified Data.Tree       as Tree++{- | Apply a list of replacement rules to a string. The search for strings to replace is performed left-to-right, preferring longer matches to shorter ones.++Internally, the list will be converted to a 'ReplaceMap' using 'listToMap'. If the list contains more than one replacement for the same search string, the last mapping is used, and earlier mappings are ignored.++If you are going to be applying the same list of rules to multiple input strings, you should first convert the list to a 'Trie' using 'listToTrie' and then use 'replaceWithTrie' instead. -}+replaceWithList+  :: Foldable f+  => f Replace -- ^ List of replacement rules+  -> String    -- ^ Input string+  -> String    -- ^ Result after performing replacements on the input string+replaceWithList = listToTrie >>> replaceWithTrie++{- | Apply a map of replacement rules to a string. The search for strings to replace is performed left-to-right, preferring longer matches to shorter ones.++If you are going to be applying the same list of rules to multiple input strings, you should first convert the 'Map' to a 'Trie' using 'mapToTrie' and then use 'replaceWithTrie' instead. -}+replaceWithMap+  :: ReplaceMap -- ^ Map of replacement rules+  -> String     -- ^ Input string+  -> String     -- ^ Result after performing replacements on the input string+replaceWithMap = mapToTrie >>> replaceWithTrie++{- | Apply a trie of replacement rules to a string. The search for strings to replace is performed left-to-right, preferring longer matches to shorter ones.++To construct a 'Trie', you may use 'listToTrie' or 'mapToTrie'. -}+replaceWithTrie+  :: Trie   -- ^ Map of replacement rules, represented as a trie+  -> String -- ^ Input string+  -> String -- ^ Result after performing replacements on the input string+replaceWithTrie trie = go+  where+    go [] = []+    go xs@(x : xs') =+      case replaceWithTrie1 trie xs of+        Nothing -> x : go xs'+        Just (r, xs'') -> r ++ go xs''++replaceWithTrie1 :: Trie -> String -> Maybe (String, String)+replaceWithTrie1 _ [] = Nothing+replaceWithTrie1 trie (x : xs) =+  case Map.lookup x trie of+    Nothing                  -> Nothing+    Just (Trie' Nothing bs)  -> replaceWithTrie1 bs xs+    Just (Trie' (Just r) bs) -> case replaceWithTrie1 bs xs of+                                  Nothing -> Just (r, xs)+                                  longerMatch -> longerMatch++-- | Non-empty string.+newtype String' = String' (NonEmpty Char)+  deriving (Eq, Ord)++instance Show String'+  where+    showsPrec i (String' x) = showsPrec i (NonEmpty.toList x)++{- | @'fromString' = 'string'fromString'@++🌶️ Warning: @('fromString' "" :: 'String'') = ⊥@ -}+instance IsString String'+  where+    fromString = string'fromString++{- | Convert an ordinary 'String' to a non-empty 'String''.++🌶️ Warning: @string'fromString "" = ⊥@ -}+string'fromString :: String -> String'+string'fromString = NonEmpty.fromList >>> String'++{- | The first character of a non-empty string. -}+string'head :: String' -> Char+string'head (String' x) = NonEmpty.head x++{- | All characters of a non-empty string except the first. -}+string'tail :: String' -> String+string'tail (String' x) = NonEmpty.tail x++{- | A replacement rule.++> Replace "abc" "xyz"++means++/When you encounter the string __@abc@__ in the input text, replace it with __@xyz@__./++The first argument must be a non-empty string, because there is no sensible way+to interpret "replace all occurrences of the empty string." -}+data Replace =+  Replace+    { replaceFrom :: String' -- ^ A string we're looking for+    , replaceTo   :: String  -- ^ A string we're replacing it with+    }+    deriving (Eq, Show)++{- | A map where the keys are strings we're looking for, and the values are strings with which we're replacing a key that we find.++You may use 'listToMap' to construct a 'ReplaceMap' from a list of replacement rules, and you may use 'mapToAscList' to convert back to a list. -}+type ReplaceMap = Map String' String++{- | Construct a 'ReplaceMap' from a list of replacement rules.++If the list contains more than one replacement for the same search string, the last mapping is used, and earlier mappings are ignored. -}+listToMap :: Foldable f => f Replace -> ReplaceMap+listToMap = Foldable.toList >>> fmap toTuple >>> Map.fromList+  where+    toTuple x = (replaceFrom x, replaceTo x)++{- | Convert a replacement map to a list of replacement rules. The rules in the list will be sorted according to their 'replaceFrom' field in ascending order. -}+mapToAscList :: ReplaceMap -> [Replace]+mapToAscList = Map.toAscList >>> fmap (\(x, y) -> Replace x y)++{- | A representation of a 'ReplaceMap' designed for efficient lookups when we perform the replacements in 'replaceWithTrie'.++You may construct a 'Trie' using 'listToTrie' or 'mapToTrie'. -}+type Trie = Map Char Trie'++{- | A variant of 'Trie' which may contain a value at the root of the tree. -}+data Trie' =+  Trie'+    { trieRoot     :: Maybe String+    , trieBranches :: Trie+    }+  deriving (Eq, Show)++{- | Draws a text diagram of a trie; useful for debugging. -}+drawTrie :: Trie -> String+drawTrie = trieForest >>> Tree.drawForest++trieForest :: Trie -> Tree.Forest String+trieForest =+  Map.toAscList >>>+  fmap (\(c, t) -> trieTree [c] t)++trieTree :: String -> Trie' -> Tree String+trieTree c (Trie' r bs) =+  case (r, Map.toAscList bs) of+    (Nothing, [(c', t)]) -> trieTree (c ++ [c']) t+    _ -> Tree.Node (c ++ maybe "" (\rr -> " - " ++ show rr) r)+                   (trieForest bs)++{- | Convert a replacement map to a trie, which is used to efficiently implement 'replaceWithTrie'. -}+mapToTrie :: ReplaceMap -> Trie+mapToTrie = mapToAscList >>> ascListToTrie++{- | Convert a list of replacement rules to a trie, which is used to efficiently implement 'replaceWithTrie'.++If the list contains more than one replacement for the same search string, the last mapping is used, and earlier mappings are ignored. -}+listToTrie :: Foldable f => f Replace -> Trie+listToTrie = listToMap >>> mapToTrie++{- | Convert a list of replacement rules to a 'Trie', where the rules must be sorted in ascending order by the 'replaceFrom' field.++🌶️ Warning: this precondition is not checked. If you are not sure, it is safer to use 'listToTrie' instead. -}+ascListToTrie+  :: Foldable f+  => f Replace  -- ^ This list must be sorted according to the 'replaceFrom'+                --   field in ascending order+                --+                -- 🌶️ Warning: this precondition is not checked+  -> Trie+ascListToTrie =+  NonEmpty.groupBy ((==) `on` (replaceFrom >>> string'head)) >>>+  fmap (\xs -> (firstChar xs, subtrie xs)) >>>+  Map.fromAscList+  where+    firstChar = NonEmpty.head >>> replaceFrom >>> string'head+    subtrie = fmap (\(Replace x y) -> (string'tail x, y)) >>> ascListToTrie'++ascListToTrie'+  :: Foldable f+  => f (String, String)  -- ^ This list must be sorted according to the left+                         --   field of the tuple in ascending order+                         --+                         -- 🌶️ Warning: this precondition is not checked+  -> Trie'+ascListToTrie' = Foldable.toList >>> f+  where+    f :: [(String, String)] -> Trie'+    f (([], x) : xs) = Trie' (Just x) (g xs)+    f xs             = Trie' Nothing (g xs)++    g :: (Foldable f, Functor f) => f (String, String) -> Trie+    g = fmap (\(x, y) -> Replace (string'fromString x) y) >>> ascListToTrie
+ test/properties.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}++import Text.Replace++-- base+import           Control.Arrow  ((>>>))+import           Control.Monad  (unless)+import           Data.Foldable  (for_)+import           Data.Semigroup ((<>))+import qualified System.Exit    as Exit+import qualified System.IO      as IO++-- hedgehog+import           Hedgehog     (Property, forAll, property, withTests, (===))+import qualified Hedgehog+import qualified Hedgehog.Gen as Gen++-- neat-interpolation+import NeatInterpolation (text)++-- test+import           Data.Text (Text)+import qualified Data.Text as Text++main :: IO ()+main = do+  for_ [IO.stdout, IO.stderr] $ \h -> do+    IO.hSetEncoding h IO.utf8+    IO.hSetBuffering h IO.LineBuffering+  success <- Hedgehog.checkParallel $$(Hedgehog.discover)+  unless success Exit.exitFailure++prop_replace_1 :: Property+prop_replace_1 = withTests 1 $ property $+  let+    xs = [ Replace "a" "b" ]+  in+    replaceWithList xs "banana" === "bbnbnb"++prop_replace_swap :: Property+prop_replace_swap = withTests 1 $ property $+  let+    xs = [ Replace "a" "b"+         , Replace "b" "a" ]+  in+    replaceWithList xs "banana" === "abnbnb"++prop_replace_overlap :: Property+prop_replace_overlap = withTests 1 $ property $+  let+    xs = [ Replace "-" "1"+         , Replace "--" "2"+         , Replace "---" "3" ]+  in+    replaceWithList xs "-_--_---_----_-----" === "1_2_3_31_32"++drawReplacementsTrie :: [Replace] -> Text+drawReplacementsTrie =+  listToTrie >>> drawTrie >>> Text.pack++prop_drawTrie :: Property+prop_drawTrie = property $ do++  replacements <- forAll $ Gen.shuffle+    [ Replace "aft"   "1"+    , Replace "after" "2"+    , Replace "apply" "3"+    , Replace "brain" "4"+    , Replace "broke" "5"+    ]++  drawReplacementsTrie replacements === [text|++    a+    |+    +- ft - "1"+    |  |+    |  `- er - "2"+    |+    `- pply - "3"++    br+    |+    +- ain - "4"+    |+    `- oke - "5"++  |] <> "\n"
+ text-replace.cabal view
@@ -0,0 +1,56 @@+name: text-replace+version: 0.0.0.1+category: Text, Application+synopsis: Simple text replacements from a list of search/replace pairs++description: A library and a command-line application for simple string+             replacements in text files. The search for strings to replace is+             performed left-to-right, preferring longer matches to shorter+             ones.++homepage:    https://github.com/chris-martin/text-replace+bug-reports: https://github.com/chris-martin/text-replace/issues++author:     Chris Martin <ch.martin@gmail.com>+maintainer: Chris Martin <ch.martin@gmail.com>++license: Apache-2.0+license-file: license.txt++build-type: Simple+cabal-version: >= 1.10++source-repository head+  type: git+  location: https://github.com/chris-martin/text-replace++library+  default-language: Haskell2010+  hs-source-dirs: src+  ghc-options: -Wall+  exposed-modules: Text.Replace+  build-depends:+      base       >=4.9     && <4.11+    , containers >=0.5.7.1 && <0.5.11++executable text-replace+  default-language: Haskell2010+  hs-source-dirs: app+  main-is: text-replace.hs+  ghc-options: -Wall+  build-depends: text-replace+    , base                 >=4.9      && <4.11+    , parsec               >=3.1.11   && <3.1.12+    , optparse-applicative >=0.12.1.0 && <0.14.1++test-suite properties+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  main-is: properties.hs+  hs-source-dirs: test+  ghc-options: -Wall -threaded+  build-depends: text-replace+    , base               >=4.9     && <4.11+    , hedgehog           >=0.5     && <0.6+    , neat-interpolation >=0.3     && <0.3.3+    , text               >=1.2.2.2 && <1.2.4