-- | Demo tutorial, accessed with --demo
module Development.Shake.Internal.Demo(demo) where

import Development.Shake.Internal.Paths
import Development.Shake.Command

import Control.Exception.Extra
import Control.Monad
import Data.List.Extra
import Data.Maybe
import System.Directory
import System.Exit
import System.FilePath
import General.Extra
import Development.Shake.FilePath(exe)
import System.IO
import System.Info.Extra


demo :: Bool -> IO ()
demo :: Bool -> IO ()
demo Bool
auto = do
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"% Welcome to the Shake v" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
shakeVersionString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" demo mode!"

    String -> IO ()
putStr String
"% Detecting machine configuration... "
    hasManual <- IO Bool
hasManualData
    ghc <- isJust <$> findExecutable "ghc"
    (gcc, gccPath) <- findGcc
    shakeLib <- wrap $ fmap (not . null . words . fromStdout) (cmd ("ghc-pkg list --simple-output shake" :: String))
    ninja <- findExecutable "ninja"
    putStrLn "done\n"

    let path = if Bool
isWindows then String
"%PATH%" else String
"$PATH"
    require ghc $ "% You don't have 'ghc' on your " ++ path ++ ", which is required to run the demo."
    require gcc $ "% You don't have 'gcc' on your " ++ path ++ ", which is required to run the demo."
    require shakeLib "% You don't have the 'shake' library installed with GHC, which is required to run the demo."
    require hasManual "% You don't have the Shake data files installed, which are required to run the demo."

    empty <- all (all (== '.')) <$> getDirectoryContents "."
    dir <- if empty then getCurrentDirectory else do
        home <- getHomeDirectory
        dir <- getDirectoryContents home
        pure $ home </> headErr (map ("shake-demo" ++) ("":map show [2..]) \\ dir)

    putStrLn "% The Shake demo uses an empty directory, OK to use:"
    putStrLn $ "%     " ++ dir
    b <- yesNo auto
    require b "% Please create an empty directory to run the demo from, then run 'shake --demo' again."

    putStr "% Copying files... "
    copyManualData dir
    unless isWindows $ do
         p <- getPermissions $ dir </> "build.sh"
         setPermissions (dir </> "build.sh") p{executable=True}
    putStrLn "done"

    let pause = do
            String -> IO ()
putStr String
"% Press ENTER to continue: "
            if Bool
auto then String -> IO String
putLine String
"" else IO String
getLine
    let execute String
x = do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"% RUNNING: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
            CmdOption -> CmdOption -> CmdOption -> String -> IO ()
forall args r. (Partial, CmdArguments args) => args
cmd (String -> CmdOption
Cwd String
dir) ([String] -> [String] -> CmdOption
AddPath [] (Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
gccPath)) CmdOption
Shell String
x :: IO ()
    let build = if Bool
isWindows then String
"build" else String
"./build.sh"

    putStrLn "\n% [1/5] Building an example project with Shake."
    pause
    putStrLn $ "% RUNNING: cd " ++ dir
    execute build

    putStrLn "\n% [2/5] Running the produced example."
    pause
    execute $ "_build" </> "run" <.> exe

    putStrLn "\n% [3/5] Rebuilding an example project with Shake (nothing should change)."
    pause
    execute build

    putStrLn "\n% [4/5] Cleaning the build."
    pause
    execute $ build ++ " clean"

    putStrLn "\n% [5/5] Rebuilding with 2 threads and profiling."
    pause
    execute $ build ++ " -j2 --report --report=-"
    putStrLn "\n% See the profiling summary above, or look at the HTML profile report in"
    putStrLn $ "%     " ++ dir </> "report.html"

    putStrLn "\n% Demo complete - all the examples can be run from:"
    putStrLn $ "%     " ++ dir
    putStrLn "% For more info see https://shakebuild.com"
    when (isJust ninja) $ do
        putStrLn "\n% PS. Shake can also execute Ninja build files"
        putStrLn "% For more info see https://shakebuild.com/ninja"



-- | Require the user to press @y@ before continuing.
yesNo :: Bool -> IO Bool
yesNo :: Bool -> IO Bool
yesNo Bool
auto = do
    String -> IO ()
putStr String
"% [Y/N] (then ENTER): "
    x <- if Bool
auto then String -> IO String
putLine String
"y" else String -> String
lower (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getLine
    if "y" `isPrefixOf` x then
        pure True
     else if "n" `isPrefixOf` x then
        pure False
     else
        yesNo auto

putLine :: String -> IO String
putLine :: String -> IO String
putLine String
x = String -> IO ()
putStrLn String
x IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x


-- | Replace exceptions with 'False'.
wrap :: IO Bool -> IO Bool
wrap :: IO Bool -> IO Bool
wrap IO Bool
act = IO Bool
act IO Bool -> (SomeException -> IO Bool) -> IO Bool
forall a. IO a -> (SomeException -> IO a) -> IO a
`catch_` IO Bool -> SomeException -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)


-- | Require a condition to be true, or exit with a message.
require :: Bool -> String -> IO ()
require :: Bool -> String -> IO ()
require Bool
b String
msg = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitFailure