-- | 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 forall a b. (a -> b) -> a -> b
$ String
"% Welcome to the Shake v" forall a. [a] -> [a] -> [a]
++ String
shakeVersionString forall a. [a] -> [a] -> [a]
++ String
" demo mode!"

    String -> IO ()
putStr String
"% Detecting machine configuration... "
    Bool
hasManual <- IO Bool
hasManualData
    Bool
ghc <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
findExecutable String
"ghc"
    (Bool
gcc, Maybe String
gccPath) <- IO (Bool, Maybe String)
findGcc
    Bool
shakeLib <- IO Bool -> IO Bool
wrap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stdout a -> a
fromStdout) (forall args r. (Partial, CmdArguments args) => args
cmd (String
"ghc-pkg list --simple-output shake" :: String))
    Maybe String
ninja <- String -> IO (Maybe String)
findExecutable String
"ninja"
    String -> IO ()
putStrLn String
"done\n"

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

    Bool
empty <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Char
'.')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getDirectoryContents String
"."
    String
dir <- if Bool
empty then IO String
getCurrentDirectory else do
        String
home <- IO String
getHomeDirectory
        [String]
dir <- String -> IO [String]
getDirectoryContents String
home
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
home String -> String -> String
</> forall a. [a] -> a
head (forall a b. (a -> b) -> [a] -> [b]
map (String
"shake-demo" forall a. [a] -> [a] -> [a]
++) (String
""forall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Integer
2..]) forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
dir)

    String -> IO ()
putStrLn String
"% The Shake demo uses an empty directory, OK to use:"
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"%     " forall a. [a] -> [a] -> [a]
++ String
dir
    Bool
b <- Bool -> IO Bool
yesNo Bool
auto
    Bool -> String -> IO ()
require Bool
b String
"% Please create an empty directory to run the demo from, then run 'shake --demo' again."

    String -> IO ()
putStr String
"% Copying files... "
    String -> IO ()
copyManualData String
dir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isWindows forall a b. (a -> b) -> a -> b
$ do
         Permissions
p <- String -> IO Permissions
getPermissions forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"build.sh"
         String -> Permissions -> IO ()
setPermissions (String
dir String -> String -> String
</> String
"build.sh") Permissions
p{executable :: Bool
executable=Bool
True}
    String -> IO ()
putStrLn String
"done"

    let pause :: IO String
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 -> IO ()
execute String
x = do
            String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"% RUNNING: " forall a. [a] -> [a] -> [a]
++ String
x
            forall args r. (Partial, CmdArguments args) => args
cmd (String -> CmdOption
Cwd String
dir) ([String] -> [String] -> CmdOption
AddPath [] (forall a. Maybe a -> [a]
maybeToList Maybe String
gccPath)) CmdOption
Shell String
x :: IO ()
    let build :: String
build = if Bool
isWindows then String
"build" else String
"./build.sh"

    String -> IO ()
putStrLn String
"\n% [1/5] Building an example project with Shake."
    IO String
pause
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"% RUNNING: cd " forall a. [a] -> [a] -> [a]
++ String
dir
    String -> IO ()
execute String
build

    String -> IO ()
putStrLn String
"\n% [2/5] Running the produced example."
    IO String
pause
    String -> IO ()
execute forall a b. (a -> b) -> a -> b
$ String
"_build" String -> String -> String
</> String
"run" String -> String -> String
<.> String
exe

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

    String -> IO ()
putStrLn String
"\n% [4/5] Cleaning the build."
    IO String
pause
    String -> IO ()
execute forall a b. (a -> b) -> a -> b
$ String
build forall a. [a] -> [a] -> [a]
++ String
" clean"

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

    String -> IO ()
putStrLn String
"\n% Demo complete - all the examples can be run from:"
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"%     " forall a. [a] -> [a] -> [a]
++ String
dir
    String -> IO ()
putStrLn String
"% For more info see https://shakebuild.com"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
ninja) forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
"\n% PS. Shake can also execute Ninja build files"
        String -> IO ()
putStrLn String
"% 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): "
    String
x <- if Bool
auto then String -> IO String
putLine String
"y" else String -> String
lower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getLine
    if String
"y" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
     else if String
"n" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
     else
        Bool -> IO Bool
yesNo Bool
auto

putLine :: String -> IO String
putLine :: String -> IO String
putLine String
x = String -> IO ()
putStrLn String
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall a. IO a -> (SomeException -> IO a) -> IO a
`catch_` forall a b. a -> b -> a
const (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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
msg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure