{-# LANGUAGE LambdaCase #-} module Main where import Control.Monad (forM_, when) import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.IO as T import Options.Applicative import System.Exit import Pattern import Parser import Pretty import SourceFile apply :: Pattern -> SourceFile -> SourceFile apply pat (SourceFile chunks) = SourceFile $ flip map chunks $ \case CSkip s -> CSkip s COcc occ -> COcc (apply' pat occ) apply' :: Pattern -> Occurrence -> Occurrence apply' (Pattern name items) origocc@(Occurrence name' args) | name == name' = Occurrence name' (travOrigsArgs items args) | otherwise = origocc travOrigsArgs :: [Origin] -> [(Text, Text)] -> [(Text, Text)] travOrigsArgs [] args = args travOrigsArgs (OCopy : items) (arg:args) = arg : travOrigsArgs items args travOrigsArgs (ONew name : items) args = (T.pack " ", name) : travOrigsArgs items args travOrigsArgs _ [] = [] data Options = Options { optPattern :: Pattern , optFiles :: [FilePath] , optInPlace :: Bool } deriving (Show) parseOptions :: Parser Options parseOptions = Options <$> option (eitherReader parsePattern) (short 'p' <> help "The pattern to apply. *-prefixed type variables are added." <> metavar "PAT") <*> some (argument str (metavar "FILES...")) <*> switch (short 'i' <> help "Apply changes in-place. WARNING: This mutates files! \ \(This also allows multiple files to be given on the command line.)") main :: IO () main = do opts <- execParser $ info (parseOptions <**> helper) (fullDesc <> progDesc "Refactor type variables of a data type in Haskell" <> header "refactor-type-variables - Refactoring Haskell data type parameters") when (not (optInPlace opts) && length (optFiles opts) /= 1) $ die "Multiple input files can only be given in conjunction with -i" forM_ (optFiles opts) $ \fname -> do source <- readFile fname parsed <- case parseSourceFile fname source (optPattern opts) of Left err -> die ("Could not parse '" ++ fname ++ "': " ++ show err) Right res -> return res let result = apply (optPattern opts) parsed resultText = B.toLazyText (sourceFileToBuilder False result) if optInPlace opts then do T.writeFile fname resultText putStrLn ("Processed '" ++ fname ++ "'") else T.putStrLn (pretty (apply (optPattern opts) parsed)) -- print parsed -- T.putStrLn (pretty parsed) -- putStrLn (replicate 80 '-') -- T.putStrLn (pretty (apply (optPattern opts) parsed))