diff --git a/app/text-replace.hs b/app/text-replace.hs --- a/app/text-replace.hs +++ b/app/text-replace.hs @@ -20,16 +20,11 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.IO as LT -(!) :: 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, \ +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." @@ -44,20 +39,15 @@ let d = delimiterOpt opts - argMapping <- - let - f arg = parseReplacementList' d "--mapping" arg - in - foldMap f (opt_mapping opts) + argMapping <- opt_mapping opts + & foldMap (parseReplacementList' d "--mapping") - fileMapping <- - let - f path = IO.withFile path IO.ReadMode $ \h -> do - IO.hSetEncoding h enc - x <- LT.hGetContents h - parseReplacementList' d path x - in - foldMap f (opt_mapFile opts) + fileMapping <- opt_mapFile opts + & foldMap (\path -> + IO.withFile path IO.ReadMode $ \h -> do + IO.hSetEncoding h enc + x <- LT.hGetContents h + parseReplacementList' d path x) withInputH (opt_inFile opts) $ \inH -> withOutputH (opt_outFile opts) $ \outH -> do @@ -73,8 +63,7 @@ withOutputH Nothing f = f IO.stdout withOutputH (Just path) f = IO.withFile path IO.WriteMode f -data Opts = - Opts +data Opts = Opts { opt_inFile :: Maybe FilePath , opt_outFile :: Maybe FilePath , opt_mapping :: [LT.Text] @@ -84,8 +73,7 @@ } optsParser :: Opt.Parser Opts -optsParser = - Opts +optsParser = Opts <$> inFileParser <*> outFileParser <*> mappingParser @@ -94,71 +82,50 @@ <*> 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)" +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)" +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 [LT.Text] -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 \ +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, \ +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 \ +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" +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) + opt_delimiter opts + & (if opt_newlineDelimiter opts then ("\n" :) else id) parseReplacementList :: [Delimiter] -> P.SourceName -> LT.Text -> Either P.ParseError [Replace] parseReplacementList delims sourceName input = - let + P.parse (P.many replaceP <* P.eof) sourceName input + where delimP :: P.Parser () delimP = delims & fmap (void . P.try . P.string) & asum @@ -174,9 +141,6 @@ replaceP :: P.Parser Replace replaceP = Replace <$> strP' <*> strP - in - P.parse (P.many replaceP <* P.eof) sourceName input - parseReplacementList' :: [Delimiter] -> P.SourceName -> LT.Text -> IO [Replace] parseReplacementList' delims sourceName input = - parseReplacementList delims sourceName input & either (die . show) pure + parseReplacementList delims sourceName input & either (die . show) pure diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,15 @@ +### 0.1.0.3 (2023-01-01) + +Support GHC 9.4 + +### 0.1.0.2 (2022-03-15) + +Support hedgehog 1.1, optparse-applicative 0.17 + +### 0.1.0.1 (2022-01-14) + +Support GHC 9.2 + +### 0.1 (2021-06-02) + +Start of changelog diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -1,22 +1,22 @@ # text-replace -Perform simple replacements in a text file, using a list of search/replace pairs. - -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. +Perform simple replacements in a text file, using a list of search/replace +pairs. 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. ## Command-line options -| Option | Description | -| --- | --- | -| `-h,--help` | Show help text | -| `-i,--in-file FILEPATH` | Input file to read (optional, defaults to stdin) | -| `-o,--out-file FILEPATH` | Output file to write (optional, defaults to stdout) -| `-m,--mapping MAPPING` | A list of search/replace pairs, separated by any of the delimiters | -| `-f,--map-file FILEPATH` | A file containing a list of search/replace pairs, separated by any of the delimiters | -| `-d,--delimiter DELIMITER` | Add a delimiter that separates search/replace strings in `--mapping` and in the contents of `--map-file` | -| `-n,--newline-delimiter` | Add newline as a delimiter | +* `-h`, `--help` - Show help text +* `-i`, `--in-file FILEPATH` - Input file to read (optional, defaults to stdin) +* `-o`, `--out-file FILEPATH` - Output file to write (optional, defaults to stdout) +* `-m`, `--mapping MAPPING` - A list of search/replace pairs, separated by any of + the delimiters +* `-f`, `--map-file FILEPATH` - A file containing a list of search/replace pairs, + separated by any of the delimiters +* `-d`, `--delimiter DELIMITER` - Add a delimiter that separates search/replace + strings in `--mapping` and in the contents of + `--map-file` +* `-n`, `--newline-delimiter` - Add newline as a delimiter ## Examples @@ -29,7 +29,8 @@ The (<&&>) operator ``` -You can use it to swap strings. In the following example we replace `*` with `**` and vice versa: +You can use it to swap strings. In the following example we replace `*` with +`**` and vice versa: ``` $ echo "What *is* going on **here**?" \ @@ -38,7 +39,8 @@ What **is** going on *here*? ``` -You also have the option to read the input string and replacement list from files, and to write the output to a file: +You also have the option to read the input string and replacement list from +files, and to write the output to a file: ``` $ cat input @@ -59,3 +61,4 @@ $ cat output I am extremely likely to appreciate Haskell once I develop sufficient ability with it. +``` diff --git a/src/Text/Replace.hs b/src/Text/Replace.hs --- a/src/Text/Replace.hs +++ b/src/Text/Replace.hs @@ -1,18 +1,18 @@ module Text.Replace ( - -- * Performing replacement - replaceWithList, replaceWithMap, replaceWithTrie - - -- * Specifying replacements - , Replace (..), ReplaceMap, listToMap, mapToAscList + -- * Performing replacement + replaceWithList, replaceWithMap, replaceWithTrie, - -- * Replacements in trie structure - , Trie, Trie' (..), listToTrie, ascListToTrie, mapToTrie, drawTrie + -- * Specifying replacements + Replace (..), ReplaceMap, listToMap, mapToAscList, - -- * Non-empty text - , Text' (..), text'fromString, text'fromText + -- * Replacements in trie structure + Trie, Trie' (..), listToTrie, ascListToTrie, mapToTrie, drawTrie, - ) where + -- * Non-empty text + Text' (..), text'fromString, text'fromText, + ) + where -- base import qualified Data.Foldable as Foldable @@ -30,138 +30,147 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as LT -{- | 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. +{- | Apply a list of replacement rules to a string -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. +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 list to a 'Trie' using 'listToTrie' and then use 'replaceWithTrie' instead. -} -replaceWithList - :: Foldable f - => f Replace -- ^ List of replacement rules +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 -> LT.Text -- ^ Input string -> LT.Text -- ^ Result after performing replacements on the input string replaceWithList = replaceWithTrie . listToTrie -{- | 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. +{- | Apply a map of replacement rules to a string -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 +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 -> LT.Text -- ^ Input string -> LT.Text -- ^ Result after performing replacements on the input string replaceWithMap = replaceWithTrie . mapToTrie -{- | 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. +{- | 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 +replaceWithTrie :: + Trie -- ^ Map of replacement rules, represented as a trie -> LT.Text -- ^ Input string -> LT.Text -- ^ Result after performing replacements on the input string replaceWithTrie trie = go where - go xs = - case LT.uncons xs of + go xs = case LT.uncons xs of Nothing -> LT.empty - Just (x, xs') -> - case replaceWithTrie1 trie xs of + Just (x, xs') -> case replaceWithTrie1 trie xs of Nothing -> LT.cons x (go xs') Just (r, xs'') -> LT.append (LT.fromStrict r) (go xs'') replaceWithTrie1 :: Trie -> LT.Text -> Maybe (T.Text, LT.Text) -replaceWithTrie1 trie xs = - case LT.uncons xs of +replaceWithTrie1 trie xs = case LT.uncons xs of Nothing -> Nothing - Just (x, xs') -> - case Map.lookup x trie of + Just (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 text. -data Text' = - Text' - { text'head :: Char -- ^ The first character of a non-empty string. - , text'tail :: T.Text -- ^ All characters of a non-empty string except the first. +-- | Non-empty text +data Text' = Text' + { text'head :: Char -- ^ The first character of a non-empty string + , text'tail :: T.Text -- ^ All characters of a non-empty string except the first } deriving (Eq, Ord) -instance Show Text' - where +instance Show Text' where showsPrec i (Text' x xs) = showsPrec i (LT.cons x (LT.fromStrict xs)) {- | @'fromString' = 'text'fromString'@ 🌶️ Warning: @('fromString' "" :: 'Text'') = ⊥@ -} -instance IsString Text' - where +instance IsString Text' where fromString = text'fromString -{- | Convert an ordinary 'String' to a non-empty 'Text''. +{- | Convert an ordinary 'String' to a non-empty 'Text'' 🌶️ Warning: @text'fromString "" = ⊥@ -} text'fromString :: String -> Text' text'fromString [] = error "Text' cannot be empty" text'fromString (x : xs) = Text' x (T.pack xs) -{- | Convert an ordinary 'T.Text' to a non-empty 'Text''. +{- | Convert an ordinary 'T.Text' to a non-empty 'Text'' 🌶️ Warning: @text'fromText "" = ⊥@ -} text'fromText :: T.Text -> Text' -text'fromText t = - case T.uncons t of +text'fromText t = case T.uncons t of Nothing -> error "Text' cannot be empty" Just (x, xs) -> Text' x xs -{- | A replacement rule. - -> Replace "abc" "xyz" - -means +{- | A replacement rule -/When you encounter the string __@abc@__ in the input text, replace it with __@xyz@__./ +@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 +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 :: Text' -- ^ A string we're looking for , replaceTo :: T.Text -- ^ 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. +{- | 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. -} +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 Text' T.Text -{- | Construct a 'ReplaceMap' from a list of replacement rules. +{- | Construct a replacement map 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. -} +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 = Map.fromList . fmap toTuple . Foldable.toList 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. -} +{- | 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 = fmap (\(x, y) -> Replace x y) . Map.toAscList -{- | A representation of a 'ReplaceMap' designed for efficient lookups when we perform the replacements in 'replaceWithTrie'. +{- | 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' +{- | A variant of 'Trie' which may contain a value at the root of the tree -} +data Trie' = Trie' { trieRoot :: Maybe T.Text , trieBranches :: Trie } deriving (Eq, Show) -{- | Draws a text diagram of a trie; useful for debugging. -} +{- | Draws a text diagram of a trie; useful for debugging -} drawTrie :: Trie -> LT.Text drawTrie = LT.pack . Tree.drawForest . fmap (fmap T.unpack) . trieForest @@ -169,31 +178,34 @@ trieForest = fmap (\(c, t) -> trieTree (T.singleton c) t) . Map.toAscList trieTree :: T.Text -> Trie' -> Tree T.Text -trieTree c (Trie' r bs) = - case (r, Map.toAscList bs) of +trieTree c (Trie' r bs) = case (r, Map.toAscList bs) of (Nothing, [(c', t)]) -> trieTree (T.snoc c c') t _ -> Tree.Node (T.append c (maybe T.empty (\rr -> T.pack (" - " ++ show rr)) r)) (trieForest bs) -{- | Convert a replacement map to a trie, which is used to efficiently implement 'replaceWithTrie'. -} +{- | Convert a replacement map to a trie, which is used to efficiently implement +'replaceWithTrie' -} mapToTrie :: ReplaceMap -> Trie mapToTrie = ascListToTrie . mapToAscList -{- | Convert a list of replacement rules to a trie, which is used to efficiently implement 'replaceWithTrie'. +{- | 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. -} +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 = mapToTrie . listToMap -{- | Convert a list of replacement rules to a 'Trie', where the rules must be sorted in ascending order by the 'replaceFrom' field. +{- | 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 +🌶️ 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 = Map.fromAscList @@ -203,12 +215,11 @@ firstChar = text'head . replaceFrom . NonEmpty.head subtrie = ascListToTrie' . fmap (\(Replace x y) -> (text'tail x, y)) -ascListToTrie' - :: Foldable f - => f (T.Text, T.Text) -- ^ This list must be sorted according to the left - -- field of the tuple in ascending order - -- - -- 🌶️ Warning: this precondition is not checked +ascListToTrie' :: Foldable f => + f (T.Text, T.Text) -- ^ This list must be sorted according to the left + -- field of the tuple in ascending order + -- + -- 🌶️ Warning: this precondition is not checked -> Trie' ascListToTrie' = f . Foldable.toList where diff --git a/text-replace.cabal b/text-replace.cabal --- a/text-replace.cabal +++ b/text-replace.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: text-replace -version: 0.1.0.2 +version: 0.1.0.3 category: Text, Application synopsis: Simple text replacements from a list of search/replace pairs @@ -13,20 +13,16 @@ 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 +homepage: https://github.com/chris-martin/text-replace +bug-reports: https://github.com/chris-martin/text-replace/issues -author: Chris Martin -maintainer: Chris Martin +author: Chris Martin +maintainer: Chris Martin license: Apache-2.0 license-file: license.txt -build-type: Simple - -extra-source-files: readme.md +extra-source-files: *.md source-repository head type: git @@ -36,23 +32,23 @@ default-language: Haskell2010 ghc-options: -Wall build-depends: - base ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 - , text ^>= 1.2.2.2 + base ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17 + , text ^>= 1.2.4 || ^>= 2.0 library import: base hs-source-dirs: src exposed-modules: Text.Replace build-depends: - containers ^>= 0.5.10.2 || ^>= 0.6 + containers ^>= 0.6.4 executable text-replace import: base hs-source-dirs: app main-is: text-replace.hs build-depends: - optparse-applicative ^>= 0.14.2 || ^>= 0.15 || ^>= 0.16 || ^>= 0.17 - , parsec ^>= 3.1.13 + optparse-applicative ^>= 0.16.1 || ^>= 0.17 + , parsec ^>= 3.1.14 , text-replace test-suite properties @@ -66,6 +62,6 @@ QuasiQuotes TemplateHaskell build-depends: - hedgehog ^>= 0.5.3 || ^>= 0.6 || ^>= 1.0 || ^>= 1.1 - , neat-interpolation ^>= 0.5 + hedgehog ^>= 1.0.5 || ^>= 1.0 || ^>= 1.1 || ^>= 1.2 + , neat-interpolation ^>= 0.5.1 , text-replace