module Text.Parser.Substring
( replaceFileOnceWithParser
, replaceOnceWithParser
, onceReplacify
, takeMatch
) where
import Control.Applicative ((<|>), optional)
import Data.Attoparsec.Text
import Data.Maybe (isJust)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text.Lazy as Text
import qualified Data.Text.Lazy.Builder as TextBuilder
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.IO as Text
import Debug.NoTrace (trace, traceM)
replaceFileOnceWithParser :: Parser Text -> FilePath -> IO ()
replaceFileOnceWithParser p filePath =
Text.writeFile filePath =<< replaceOnceWithParser p <$> Text.readFile filePath
replaceOnceWithParser :: Parser Text -> Text -> Text
replaceOnceWithParser p t =
maybe t (Text.toStrict . TextBuilder.toLazyText)
$ maybeResult
$ traceId "fed"
$ flip feed ""
$ traceId "parsed"
$ parse (onceReplacify p) t
onceReplacify :: Parser Text -> Parser Builder
onceReplacify p =
let firstToMatched =
(TextBuilder.fromText <$> p)
<|> ((<>) <$> (TextBuilder.singleton <$> anyChar) <*> firstToMatched)
in
(<>) <$> firstToMatched <*> (TextBuilder.fromText <$> takeText)
takeMatch :: Parser a -> Parser (Text, a)
takeMatch p = loop mempty
where
loop taken = do
mMatched <- optional p
traceM $ "isJust mMatched: " ++ show (isJust mMatched)
case mMatched of
Just matched ->
return (Text.toStrict $ TextBuilder.toLazyText taken, matched)
_ -> do
newChar <- (TextBuilder.singleton <$> anyChar) <|> pure mempty
traceM $ "newChar: " ++ show newChar
loop (taken <> newChar)
traceIdVia :: Show b => (a -> b) -> String -> a -> a
traceIdVia via prefix x = trace (prefix ++ ": " ++ show (via x)) x
traceId :: Show a => String -> a -> a
traceId = traceIdVia id