#!/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