-- | Runs actions - actually does them. module Run ( run ) where import Server.Run import Action import Descript import Data.Char import qualified Data.Text.IO as Text import Control.Monad import Rainbow hiding ((<>)) import System.FilePath import System.FSNotify hiding (Action) run :: Action -> IO () run ActionServe = runServe run (ActionIndiv indiv) = runWatcher runIndivAction indiv runWatcher :: (PathAction a) => (a -> IO ()) -> Watcher a -> IO () runWatcher f (Watcher watch x) | watch = withManager $ \mgr -> do let runEvt = f . (`setSrcPath` x) . eventPath stop <- watchTree mgr (getSrcPath x) rerunForEvt runEvt putStrLn "Press 'enter' to stop watching" _ <- getLine stop | otherwise = f x runIndivAction :: IndivAction -> IO () runIndivAction (ActionCompile x) = runCompile x runIndivAction (ActionEval x) = runEval x runIndivAction (ActionRefactor x) = runRefactor x runCompile :: Compile -> IO () runCompile (Compile path outDir) = do file <- loadFile path res <- runResultT $ compile file case res of Failure err -> do putFailureLn putStrLn $ summaryF (sfile file) err Success package -> do putAlmostLn savePackage outDir package putSuccessLn putStrLn $ "Compiled to " ++ outDir packageName package runEval :: Eval -> IO () runEval (Eval path) = do file <- loadFile path res <- runResultT $ eval file case res of Failure err -> do putFailureLn putStrLn $ summaryF (sfile file) err Success x -> do putAlmostLn x `seq` pure () putSuccessLn Text.putStrLn x runRefactor :: Refactor -> IO () runRefactor (Refactor action args path outPath) = do file <- loadFile path Dirty warnings res <- runDirtyResT $ parseRefactor action args file case res of Failure err -> do putFailureLn putStrLn $ summaryF (sfile file) err Success patch -> do if null warnings then continueRefactor else do putWarningLn $ "the refactor might create problems - \ \the refactored file might have different semantics." forM_ warnings $ \warning -> putStrLn $ summary warning doContinue <- promptContinue if doContinue then continueRefactor else putAbortedLn where continueRefactor = do putAlmostLn let out = apPatch patch $ fileContents file Text.writeFile outPath out putSuccessLn if path == outPath then putStrLn $ "Refactored" else putStrLn $ "Refactored to " ++ outPath putFailureLn :: IO () putFailureLn = putChunkLn $ fore red $ chunk $ "Failure:" putAbortedLn :: IO () putAbortedLn = putChunkLn $ fore red $ chunk "Aborted" putWarningLn :: String -> IO () putWarningLn msg = putChunkLn $ fore yellow $ chunk $ "Warning: " ++ msg putAlmostLn :: IO () putAlmostLn = putChunkLn $ faint $ chunk "..." putSuccessLn :: IO () putSuccessLn = putChunkLn $ fore green $ chunk "Success:" promptContinue :: IO Bool promptContinue = do putChunkLn $ fore yellow $ chunk "Continue? (yes or no)" prompt prompt :: IO Bool prompt = do res <- map toLower <$> getLine case res of "yes" -> pure True "no" -> pure False _ -> do putStrLn "Type either 'yes' or 'no'" prompt rerunForEvt :: Event -> Bool rerunForEvt (Added _ _) = True rerunForEvt (Modified _ _) = True rerunForEvt (Removed _ _) = False