diff --git a/.gitignore b/.gitignore index b091dff7..dc6b68a6 100644 --- a/.gitignore +++ b/.gitignore @@ -32,3 +32,4 @@ tags # Binaries hs-init *.hsfiles +*.exe diff --git a/CHANGELOG.md b/CHANGELOG.md index 35bec718..161818c8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +1.0.4 +===== +* Now works on windows systems as well +* Add powershell install script for Windows + + 1.0.3 ===== diff --git a/README.md b/README.md index 5f5027b9..be35ab0e 100644 --- a/README.md +++ b/README.md @@ -17,6 +17,7 @@ To start using it make sure you have next tools installed on your machine: * [`Stack`](http://haskellstack.org) * [`git`](https://git-scm.com) * [`hub`](https://github.com/github/hub) +* [`curl`](https://curl.haxx.se) ### Installation @@ -48,6 +49,14 @@ After that you can call `hs-init` with required command line options, follow the instructions that will appear, and a new project would be created in a subfolder as well as a repository under your github account. +#### windows +A PowerShell install script is available for windows users + + PS > Invoke-WebRequest https://raw.githubusercontent.com/vrom911/hs-init/master/install.ps1 -Out-File hs-init_install.ps1 + PS > powershell.exe -ExecutionPolicy ByPass .\hs-init_install.ps1 + +The binary will be installed to %LOCALAPPDATA%\hs-init which will also be added to your path + ### Usage See the basic usage syntax below: diff --git a/hs-init.hs b/hs-init.hs index bf77f02a..889659bf 100755 --- a/hs-init.hs +++ b/hs-init.hs @@ -26,6 +26,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +import Control.Exception import Control.Monad (when) import Data.Aeson (FromJSON (..), decodeStrict, withObject, (.:)) import Data.ByteString.Char8 (pack) @@ -43,10 +44,11 @@ import Options.Applicative.Help.Chunk (stringChunk) import System.Console.ANSI (Color (Blue, Green, Red, Yellow), ColorIntensity (Vivid), ConsoleIntensity (BoldIntensity), ConsoleLayer (Foreground), SGR (Reset, SetColor, SetConsoleIntensity), setSGR) -import System.Directory (doesPathExist, getCurrentDirectory, setCurrentDirectory) +import System.Directory (doesPathExist, getCurrentDirectory, removeFile, setCurrentDirectory) import System.FilePath (()) -import System.IO (hSetEncoding, stdout, utf8) -import System.Process (callCommand, readProcess, showCommandForUser) +import System.Info (os) +import System.IO (hFlush, hSetEncoding, stdout, utf8) +import System.Process (callProcess, readProcess) import qualified Data.Text as T import qualified Data.Text.IO as T @@ -170,8 +172,8 @@ generateProject repo owner description Targets{..} = do where ifGithub :: Bool -> Text -> Decision -> IO Bool - ifGithub github target flag = if github - then decisionToBool flag target + ifGithub github target decision = if github + then decisionToBool decision target else falseMessage target doStackCommands :: ProjectData -> IO () @@ -181,12 +183,11 @@ generateProject repo owner description Targets{..} = do -- create new project with stack "stack" ["new", repo, "temp.hsfiles"] -- do not need template file anymore - "rm" ["temp.hsfiles"] + deleteFile "temp.hsfiles" "cd" [repo] doScriptCommand :: IO () - doScriptCommand = - "chmod" ["+x", "b"] + doScriptCommand = when (os /= "mingw32") ("chmod" ["+x", "b"]) doGithubCommands :: Bool -> IO () doGithubCommands private = do @@ -430,6 +431,12 @@ falseMessage target = False <$ warningMessage (T.toTitle target <> " won't be ad -- Ansi-terminal ---------------------------------------------------------------------------- +-- Explicit flush ensures prompt messages are in the correct order on all systems. +putStrFlush :: Text -> IO () +putStrFlush msg = do + T.putStr msg + hFlush stdout + setColor :: Color -> IO () setColor color = setSGR [SetColor Foreground Vivid color] @@ -437,19 +444,21 @@ bold :: IO () bold = setSGR [SetConsoleIntensity BoldIntensity] reset :: IO () -reset = setSGR [Reset] +reset = do + setSGR [Reset] + hFlush stdout prompt :: IO Text prompt = do setColor Blue - T.putStr " → " + putStrFlush " -> " reset T.getLine boldDefault :: Text -> IO () boldDefault message = do bold - T.putStr (" [" <> message <> "]") + putStrFlush (" [" <> message <> "]") reset colorMessage :: Color -> Text -> IO () @@ -508,7 +517,12 @@ customizeLicense l t nm year -- This is needed to be able to call commands by writing strings. instance (a ~ Text, b ~ ()) => IsString ([a] -> IO b) where fromString "cd" [arg] = setCurrentDirectory $ T.unpack arg - fromString cmd args = callCommand $ showCommandForUser cmd (map T.unpack args) + fromString cmd args = callProcess cmd (map T.unpack args) + +-- Delete file, but just print a message if delete fails and continue instead of raising an error. +deleteFile :: FilePath -> IO () +deleteFile file = catch (removeFile file) printError + where printError (e :: SomeException) = errorMessage $ "Could not delete file '" <> T.pack file <> "'. " <> T.pack (displayException e) ---------------------------------------------------------------------------- -- IO Questioning @@ -517,7 +531,7 @@ instance (a ~ Text, b ~ ()) => IsString ([a] -> IO b) where printQuestion :: Text -> [Text] -> IO () printQuestion question (def:rest) = do let restSlash = T.intercalate "/" rest - T.putStr question + putStrFlush question boldDefault def T.putStrLn $ "/" <> restSlash printQuestion question [] = @@ -547,7 +561,7 @@ query question = do queryDef :: Text -> Text -> IO Text queryDef question defAnswer = do - T.putStr question + putStrFlush question boldDefault defAnswer T.putStrLn "" answer <- prompt diff --git a/install.ps1 b/install.ps1 new file mode 100644 index 00000000..15db823a --- /dev/null +++ b/install.ps1 @@ -0,0 +1,71 @@ +$ErrorActionPreference = "Stop" + +function populate_defaults { + $script:DEFAULT_OWNER= Read-Host 'Default GitHub username' + $script:DEFAULT_NAME=Read-Host 'Default name' + $script:DEFAULT_EMAIL=Read-Host 'Default email address' +} +function set_defaults{ + Move-Item hs-init.hs hs-init.orig.hs + foreach($line in Get-Content -Encoding UTF8 hs-init.orig.hs){ + $line = $line -replace "^(defaultOwner) = ""(.*)""$","`$1 = ""$DEFAULT_OWNER""" + $line = $line -replace "^(defaultName) = ""(.*)""$","`$1 = ""$DEFAULT_NAME""" + $line = $line -replace "^(defaultEmail) = ""(.*)""$","`$1 = ""$DEFAULT_EMAIL""" + $line | Out-File -encoding UTF8 -Append hs-init.hs + } + Remove-Item hs-init.orig.hs +} + +function install_dependencies{ + $packages = Select-String -Pattern "--package (.*)" -Path hs-init.hs | % {($_.matches.groups[1].value)} + stack install $packages + if($LASTEXITCODE -ne 0){ + exit 1 + } +} + +$TempDir = "_hs-init_install_" + [GUID]::NewGuid() +$TargetDir = "$env:LOCALAPPDATA\hs-init" + +Write-Host "Using temporary directory $TempDir" + +$null = New-Item $TempDir -ItemType Directory +Set-Location $TempDir + +$hsFile = "https://raw.githubusercontent.com/vrom911/hs-init/master/hs-init.hs" + +Write-Host "Downloading $hsFile" + +Invoke-Webrequest $hsFile -OutFile .\hs-init.hs + +populate_defaults + +Write-Host "modifying hs-init.hs with selected defaults" +set_defaults + +Write-Host "Installing dependencies" +install_dependencies + +Write-Host "compiling" + +stack ghc -- -O2 hs-init.hs +if($LASTEXITCODE -ne 0){ + exit 1 +} + +Write-Host "Installing hs-init.exe to $TargetDir" +$null = New-Item $TargetDir -ItemType Directory -Force +Move-Item .\hs-init.exe "$TargetDir\hs-init.exe" -Force + +if($env:Path -notmatch '(^|;)' + [Regex]::Escape("$env:localappdata\hs-init") + '(;|$)'){ + Write-Host "Adding $TargetDir to Path" + [System.Environment]::SetEnvironmentVariable("Path", $env:Path + ";$TargetDir",[System.EnvironmentVariableTarget]::User) +} else { + Write-Host "$TargetDir already on Path" +} + +Write-Host "Cleaning up Temp Dir $TempDir" +Set-Location .. +Remove-Item $TempDir -Recurse + +Write-Host "Installation Complete"