split.hs

#!/usr/bin/env -S runhaskell --ghc-arg="-Wall" --ghc-arg="-i lib/haskell"

import Control.Applicative ((<**>), (<|>))
import Data.List (foldl')
import Data.Text (Text)
import Data.Text.IO as Text (getContents, writeFile)
import Options.Applicative
  ( Parser, execParser, flag', fullDesc, help, helper, info, long, metavar
  , progDesc, short, strArgument, strOption)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (takeDirectory)
import Text.Filter (Editable(..))
import Text.Printf (printf)
import Text.Regex.TDFA ((=~))

data Mode = Discard | StartWith | EndWith

data Config = Config
  { splitPattern :: String
  , mode :: Mode
  , outputPattern :: String }

configParser :: Parser Config
configParser = Config
  <$> strOption on
  <*> (flag' StartWith startWith <|> flag' EndWith endWith <|> pure Discard)
  <*> strArgument outputPattern
  where
    on = short 'o' <> long "on" <> metavar "REGEX"
      <> help "pattern of the lines on which to split"
    outputPattern =
      metavar "OUTPUT_PATTERN" <> help "pattern of the output files"
    startWith =
      short 's' <> long "start" <> help "a part begins with the pattern"
    endWith = short 'e' <> long "end" <> help "a part ends with the pattern"

getConfig :: IO Config
getConfig = execParser
  (info
    (configParser <**> helper)
    (fullDesc
    <> progDesc "A tool to split a textual flow on a predefined line or prefix"))

split :: Config -> [Text] -> [[Text]]
split (Config {splitPattern, mode}) = reverse . close . foldl' aggregate ([], [])
  where
    close (currentPart, previousParts) = reverse currentPart:previousParts
    aggregate tmp@(currentPart, previousParts) line
      | line =~ splitPattern =
        case mode of
          Discard -> ([], close tmp)
          StartWith -> ([line], close tmp)
          EndWith -> ([], close (line:currentPart, previousParts))
      | otherwise = (line:currentPart, previousParts)

create :: Editable a => Config -> [a] -> IO ()
create (Config {outputPattern}) = mapM_ createFile . zip [1..] . fmap leave
  where
    createFile :: (Int, Text) -> IO ()
    createFile (i, content) =
      let path = printf outputPattern i in do
      createDirectoryIfMissing True (takeDirectory path)
      Text.writeFile path content

main :: IO ()
main = do
  config <- getConfig
  Text.getContents >>= create config . split config . enter