text-replace 0.0.0.8 → 0.1
raw patch · 4 files changed
+130/−105 lines, 4 filesdep ~neat-interpolationdep ~optparse-applicative
Dependency ranges changed: neat-interpolation, optparse-applicative
Files
- app/text-replace.hs +20/−17
- src/Text/Replace.hs +84/−74
- test/properties.hs +21/−11
- text-replace.cabal +5/−3
app/text-replace.hs view
@@ -2,11 +2,9 @@ -- 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 @@ -14,9 +12,14 @@ import qualified Options.Applicative as Opt -- parsec-import qualified Text.Parsec as P-import Text.Parsec.String as P (Parser)+import qualified Text.Parsec as P+import Text.Parsec.Text.Lazy as P (Parser) +-- text+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.IO as LT+ (!) :: Monoid a => a -> a -> a (!) = mappend infixr 6 !@@ -51,16 +54,16 @@ let f path = IO.withFile path IO.ReadMode $ \h -> do IO.hSetEncoding h enc- x <- IO.hGetContents h+ x <- LT.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+ input <- LT.hGetContents inH let output = replaceWithList (argMapping ++ fileMapping) input- IO.hPutStr outH output+ LT.hPutStr outH output withInputH :: Maybe FilePath -> (IO.Handle -> IO a) -> IO a withInputH Nothing f = f IO.stdin@@ -74,7 +77,7 @@ Opts { opt_inFile :: Maybe FilePath , opt_outFile :: Maybe FilePath- , opt_mapping :: [String]+ , opt_mapping :: [LT.Text] , opt_mapFile :: [FilePath] , opt_delimiter :: [Delimiter] , opt_newlineDelimiter :: Bool@@ -108,7 +111,7 @@ ! Opt.short 'o' ! Opt.help "Output file to write (optional, defaults to stdout)" -mappingParser :: Opt.Parser [String]+mappingParser :: Opt.Parser [LT.Text] mappingParser = Opt.many $ Opt.strOption@@ -152,21 +155,21 @@ opt_delimiter opts & (if opt_newlineDelimiter opts then ("\n" :) else id) -parseReplacementList :: [Delimiter] -> P.SourceName -> String+parseReplacementList :: [Delimiter] -> P.SourceName -> LT.Text -> 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 T.Text+ strP = T.pack <$> P.manyTill P.anyChar (delimP <|> P.eof) - strP' :: P.Parser String'+ strP' :: P.Parser Text' strP' = do x <- P.anyChar- xs <- P.manyTill P.anyChar (delimP)- pure $ String' (x :| xs)+ xs <- T.pack <$> P.manyTill P.anyChar (delimP)+ pure $ Text' x xs replaceP :: P.Parser Replace replaceP = Replace <$> strP' <*> strP@@ -174,6 +177,6 @@ in P.parse (P.many replaceP <* P.eof) sourceName input -parseReplacementList' :: [Delimiter] -> P.SourceName -> String -> IO [Replace]+parseReplacementList' :: [Delimiter] -> P.SourceName -> LT.Text -> IO [Replace] parseReplacementList' delims sourceName input =- parseReplacementList delims sourceName input & either (show >>> die) pure+ parseReplacementList delims sourceName input & either (die . show) pure
src/Text/Replace.hs view
@@ -9,16 +9,14 @@ -- * Replacements in trie structure , Trie, Trie' (..), listToTrie, ascListToTrie, mapToTrie, drawTrie - -- * Non-empty string- , String' (..), string'fromString, string'head, string'tail+ -- * Non-empty text+ , Text' (..), text'fromString, text'fromText ) 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 (..)) @@ -28,6 +26,10 @@ import Data.Tree (Tree) import qualified Data.Tree as Tree +-- text+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. 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.@@ -36,72 +38,82 @@ replaceWithList :: Foldable f => f Replace -- ^ List of replacement rules- -> String -- ^ Input string- -> String -- ^ Result after performing replacements on the input string-replaceWithList = listToTrie >>> replaceWithTrie+ -> 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. 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+ -> 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. 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+ :: 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 [] = []- go xs@(x : xs') =- case replaceWithTrie1 trie xs of- Nothing -> x : go xs'- Just (r, xs'') -> r ++ go xs''+ go xs =+ case LT.uncons xs of+ Nothing -> LT.empty+ 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 -> 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+replaceWithTrie1 :: Trie -> LT.Text -> Maybe (T.Text, LT.Text)+replaceWithTrie1 trie xs =+ case LT.uncons xs of+ Nothing -> Nothing+ 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 string.-newtype String' = String' (NonEmpty Char)+-- | 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 String'+instance Show Text' where- showsPrec i (String' x) = showsPrec i (NonEmpty.toList x)+ showsPrec i (Text' x xs) = showsPrec i (LT.cons x (LT.fromStrict xs)) -{- | @'fromString' = 'string'fromString'@+{- | @'fromString' = 'text'fromString'@ -🌶️ Warning: @('fromString' "" :: 'String'') = ⊥@ -}-instance IsString String'+🌶️ Warning: @('fromString' "" :: 'Text'') = ⊥@ -}+instance IsString Text' where- fromString = string'fromString+ fromString = text'fromString -{- | Convert an ordinary 'String' to a non-empty 'String''.+{- | Convert an ordinary 'String' to a non-empty 'Text''. -🌶️ Warning: @string'fromString "" = ⊥@ -}-string'fromString :: String -> String'-string'fromString = NonEmpty.fromList >>> String'+🌶️ Warning: @text'fromString "" = ⊥@ -}+text'fromString :: String -> Text'+text'fromString [] = error "Text' cannot be empty"+text'fromString (x : xs) = Text' x (T.pack xs) -{- | The first character of a non-empty string. -}-string'head :: String' -> Char-string'head (String' x) = NonEmpty.head x+{- | Convert an ordinary 'T.Text' to a non-empty 'Text''. -{- | All characters of a non-empty string except the first. -}-string'tail :: String' -> String-string'tail (String' x) = NonEmpty.tail x+🌶️ Warning: @text'fromText "" = ⊥@ -}+text'fromText :: T.Text -> Text'+text'fromText t =+ case T.uncons t of+ Nothing -> error "Text' cannot be empty"+ Just (x, xs) -> Text' x xs {- | A replacement rule. @@ -114,27 +126,27 @@ 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+ { 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. 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+type ReplaceMap = Map Text' T.Text {- | 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+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. -} mapToAscList :: ReplaceMap -> [Replace]-mapToAscList = Map.toAscList >>> fmap (\(x, y) -> Replace x y)+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'. @@ -144,36 +156,34 @@ {- | A variant of 'Trie' which may contain a value at the root of the tree. -} data Trie' = Trie'- { trieRoot :: Maybe String+ { trieRoot :: Maybe T.Text , trieBranches :: Trie } deriving (Eq, Show) {- | Draws a text diagram of a trie; useful for debugging. -}-drawTrie :: Trie -> String-drawTrie = trieForest >>> Tree.drawForest+drawTrie :: Trie -> LT.Text+drawTrie = LT.pack . Tree.drawForest . fmap (fmap T.unpack) . trieForest -trieForest :: Trie -> Tree.Forest String-trieForest =- Map.toAscList >>>- fmap (\(c, t) -> trieTree [c] t)+trieForest :: Trie -> Tree.Forest T.Text+trieForest = fmap (\(c, t) -> trieTree (T.singleton c) t) . Map.toAscList -trieTree :: String -> Trie' -> Tree String+trieTree :: T.Text -> Trie' -> Tree T.Text 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)+ (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'. -} mapToTrie :: ReplaceMap -> Trie-mapToTrie = mapToAscList >>> ascListToTrie+mapToTrie = ascListToTrie . mapToAscList {- | 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+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. @@ -186,25 +196,25 @@ -- 🌶️ Warning: this precondition is not checked -> Trie ascListToTrie =- NonEmpty.groupBy ((==) `on` (replaceFrom >>> string'head)) >>>- fmap (\xs -> (firstChar xs, subtrie xs)) >>>- Map.fromAscList+ Map.fromAscList+ . fmap (\xs -> (firstChar xs, subtrie xs))+ . NonEmpty.groupBy ((==) `on` (text'head . replaceFrom)) where- firstChar = NonEmpty.head >>> replaceFrom >>> string'head- subtrie = fmap (\(Replace x y) -> (string'tail x, y)) >>> ascListToTrie'+ firstChar = text'head . replaceFrom . NonEmpty.head+ subtrie = ascListToTrie' . fmap (\(Replace x y) -> (text'tail x, y)) ascListToTrie' :: Foldable f- => f (String, String) -- ^ This list must be sorted according to the left+ => 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' = Foldable.toList >>> f+ascListToTrie' = f . Foldable.toList where- f :: [(String, String)] -> Trie'- f (([], x) : xs) = Trie' (Just x) (g xs)- f xs = Trie' Nothing (g xs)+ f :: [(T.Text, T.Text)] -> Trie'+ f ((a, x) : xs') | T.null a = 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+ g :: (Foldable f, Functor f) => f (T.Text, T.Text) -> Trie+ g = ascListToTrie . fmap (\(x, y) -> Replace (text'fromText x) y)
test/properties.hs view
@@ -5,10 +5,8 @@ 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 @@ -18,11 +16,11 @@ import qualified Hedgehog.Gen as Gen -- neat-interpolation-import NeatInterpolation (text)+import qualified NeatInterpolation as N --- test-import Data.Text (Text)-import qualified Data.Text as Text+-- text+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT main :: IO () main = do@@ -56,9 +54,8 @@ in replaceWithList xs "-_--_---_----_-----" === "1_2_3_31_32" -drawReplacementsTrie :: [Replace] -> Text-drawReplacementsTrie =- listToTrie >>> drawTrie >>> Text.pack+drawReplacementsTrie :: [Replace] -> LT.Text+drawReplacementsTrie = drawTrie . listToTrie prop_drawTrie :: Property prop_drawTrie = property $ do@@ -71,7 +68,7 @@ , Replace "broke" "5" ] - drawReplacementsTrie replacements === [text|+ drawReplacementsTrie replacements === LT.fromStrict (T.append [N.trimming| a |@@ -87,4 +84,17 @@ | `- oke - "5" - |] <> "\n"+ |] "\n\n")++prop_shuffle :: Property+prop_shuffle = property $ do++ replacements <- forAll $ Gen.shuffle+ [ Replace "aft" "1"+ , Replace "after" "2"+ , Replace "apply" "3"+ , Replace "brain" "4"+ , Replace "broke" "5"+ ]++ replaceWithList replacements "afteraftbrainapple" === "214apple"
text-replace.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: text-replace-version: 0.0.0.8+version: 0.1 category: Text, Application synopsis: Simple text replacements from a list of search/replace pairs @@ -43,6 +43,7 @@ build-depends: base ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 build-depends: containers ^>= 0.5.10.2 || ^>= 0.6+ build-depends: text ^>= 1.2.2.2 executable text-replace default-language: Haskell2010@@ -54,7 +55,8 @@ build-depends: base ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 build-depends: parsec ^>= 3.1.13- build-depends: optparse-applicative ^>= 0.14.2 || ^>= 0.15+ build-depends: optparse-applicative ^>= 0.14.2 || ^>= 0.15 || ^>= 0.16+ build-depends: text ^>= 1.2.2.2 test-suite properties default-language: Haskell2010@@ -67,5 +69,5 @@ build-depends: base ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 build-depends: hedgehog ^>= 0.5.3 || ^>= 0.6 || ^>= 1.0- build-depends: neat-interpolation ^>= 0.3.2.1+ build-depends: neat-interpolation ^>= 0.5 build-depends: text ^>= 1.2.2.2