descript-lang-0.2.0.0: app/Run.hs

-- | 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