summaryrefslogtreecommitdiff
path: root/Main.hs
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2021-05-25 21:45:22 +0200
committerTom Smeding <tom@tomsmeding.com>2021-05-25 21:45:22 +0200
commit953b23229f38f1b76d130086a213d565f13cdc06 (patch)
treed59282f7a65fd2dc9ae2f40886930c632595232f /Main.hs
parentb03f51f3a363f861f9d5de30ec6a337fec316383 (diff)
Make it workHEADmaster
Diffstat (limited to 'Main.hs')
-rw-r--r--Main.hs59
1 files changed, 42 insertions, 17 deletions
diff --git a/Main.hs b/Main.hs
index d52fedc..30f8f0e 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,10 +1,12 @@
{-# 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 System.Environment
+import Options.Applicative
import System.Exit
import Pattern
@@ -25,24 +27,47 @@ apply' (Pattern name items) origocc@(Occurrence name' args)
travOrigsArgs :: [Origin] -> [(Text, Text)] -> [(Text, Text)]
travOrigsArgs [] args = args
-travOrigsArgs _ [] = []
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
- getArgs >>= \case
- [fname, pat] -> do
- pat' <- case parsePattern pat of
- Left err -> die err
- Right pat' -> return pat'
- source <- readFile fname
- parsed <- case parseSourceFile fname source pat' of
- Left err -> die (show err)
- Right res -> return res
- print parsed
- T.putStrLn (pretty parsed)
- putStrLn (replicate 80 '-')
- T.putStrLn (pretty (apply pat' parsed))
- _ -> do
- die "Usage: refactor-type-parameters <file.hs> <OpenAcc env aenv *taenv t>"
+ 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))