module Development.Shake.Internal.Demo(demo) where
import Development.Shake.Internal.Paths
import Development.Shake.Command
import Control.Applicative
import Control.Exception.Extra
import Control.Monad
import Data.Char
import Data.List
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
import Prelude
demo :: Bool -> IO ()
demo :: Bool -> IO ()
demo auto :: 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
$ "% Welcome to the Shake v" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
shakeVersionString String -> String -> String
forall a. [a] -> [a] -> [a]
++ " demo mode!"
String -> IO ()
putStr "% Detecting machine configuration... "
Bool
hasManual <- IO Bool
hasManualData
Bool
ghc <- Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
findExecutable "ghc"
(gcc :: Bool
gcc, gccPath :: Maybe String
gccPath) <- IO (Bool, Maybe String)
findGcc
Bool
shakeLib <- IO Bool -> IO Bool
wrap (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Stdout String -> Bool) -> IO (Stdout String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not (Bool -> Bool) -> (Stdout String -> Bool) -> Stdout String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool)
-> (Stdout String -> [String]) -> Stdout String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String])
-> (Stdout String -> String) -> Stdout String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stdout String -> String
forall a. Stdout a -> a
fromStdout) ((String -> IO (Stdout String)) :-> Action Any
forall args r. CmdArguments args => args
cmd "ghc-pkg list --simple-output shake")
Maybe String
ninja <- String -> IO (Maybe String)
findExecutable "ninja"
String -> IO ()
putStrLn "done\n"
let path :: String
path = if Bool
isWindows then "%PATH%" else "$PATH"
Bool -> String -> IO ()
require Bool
ghc (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "% You don't have 'ghc' on your " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", which is required to run the demo."
Bool -> String -> IO ()
require Bool
gcc (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "% You don't have 'gcc' on your " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", which is required to run the demo."
Bool -> String -> IO ()
require Bool
shakeLib "% You don't have the 'shake' library installed with GHC, which is required to run the demo."
Bool -> String -> IO ()
require Bool
hasManual "% You don't have the Shake data files installed, which are required to run the demo."
Bool
empty <- Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.')) ([String] -> Bool) -> IO [String] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getDirectoryContents "."
String
dir <- if Bool
empty then IO String
getCurrentDirectory else do
String
home <- IO String
getHomeDirectory
[String]
dir <- String -> IO [String]
getDirectoryContents String
home
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
home String -> String -> String
</> [String] -> String
forall a. [a] -> a
head ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("shake-demo" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [2..]) [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
dir)
String -> IO ()
putStrLn "% The Shake demo uses an empty directory, OK to use:"
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "% " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir
Bool
b <- Bool -> IO Bool
yesNo Bool
auto
Bool -> String -> IO ()
require Bool
b "% Please create an empty directory to run the demo from, then run 'shake --demo' again."
String -> IO ()
putStr "% Copying files... "
String -> IO ()
copyManualData String
dir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isWindows (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Permissions
p <- String -> IO Permissions
getPermissions (String -> IO Permissions) -> String -> IO Permissions
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> "build.sh"
String -> Permissions -> IO ()
setPermissions (String
dir String -> String -> String
</> "build.sh") Permissions
p{executable :: Bool
executable=Bool
True}
String -> IO ()
putStrLn "done"
let pause :: IO String
pause = do
String -> IO ()
putStr "% Press ENTER to continue: "
if Bool
auto then String -> IO String
putLine "" else IO String
getLine
let execute :: String -> IO ()
execute x :: String
x = do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "% RUNNING: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
(CmdOption -> CmdOption -> CmdOption -> String -> IO ())
:-> Action Any
forall args r. 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 :: String
build = if Bool
isWindows then "build" else "./build.sh"
String -> IO ()
putStrLn "\n% [1/5] Building an example project with Shake."
IO String
pause
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "% RUNNING: cd " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir
String -> IO ()
execute String
build
String -> IO ()
putStrLn "\n% [2/5] Running the produced example."
IO String
pause
String -> IO ()
execute (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "_build" String -> String -> String
</> "run" String -> String -> String
<.> String
exe
String -> IO ()
putStrLn "\n% [3/5] Rebuilding an example project with Shake (nothing should change)."
IO String
pause
String -> IO ()
execute String
build
String -> IO ()
putStrLn "\n% [4/5] Cleaning the build."
IO String
pause
String -> IO ()
execute (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
build String -> String -> String
forall a. [a] -> [a] -> [a]
++ " clean"
String -> IO ()
putStrLn "\n% [5/5] Rebuilding with 2 threads and profiling."
IO String
pause
String -> IO ()
execute (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
build String -> String -> String
forall a. [a] -> [a] -> [a]
++ " -j2 --report --report=-"
String -> IO ()
putStrLn "\n% See the profiling summary above, or look at the HTML profile report in"
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "% " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir String -> String -> String
</> "report.html"
String -> IO ()
putStrLn "\n% Demo complete - all the examples can be run from:"
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "% " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir
String -> IO ()
putStrLn "% For more info see https://shakebuild.com"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
ninja) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn "\n% PS. Shake can also execute Ninja build files"
String -> IO ()
putStrLn "% For more info see https://shakebuild.com/ninja"
yesNo :: Bool -> IO Bool
yesNo :: Bool -> IO Bool
yesNo auto :: Bool
auto = do
String -> IO ()
putStr "% [Y/N] (then ENTER): "
String
x <- if Bool
auto then String -> IO String
putLine "y" else (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) IO String
getLine
if "y" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else if "n" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else
Bool -> IO Bool
yesNo Bool
auto
putLine :: String -> IO String
putLine :: String -> IO String
putLine x :: String
x = String -> IO ()
putStrLn String
x IO () -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
wrap :: IO Bool -> IO Bool
wrap :: IO Bool -> IO Bool
wrap act :: 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
require :: Bool -> String -> IO ()
require :: Bool -> String -> IO ()
require b :: Bool
b msg :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitFailure