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)


{-# INLINE traceIdVia #-}
traceIdVia :: Show b => (a -> b) -> String -> a -> a
traceIdVia via prefix x = trace (prefix ++ ": " ++ show (via x)) x


{-# INLINE traceId #-}
traceId :: Show a => String -> a -> a
traceId = traceIdVia id