Windows compatibility

.gitignore

@@ -32,3 +32,4 @@ tags
 # Binaries
 hs-init
 *.hsfiles
+*.exe

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

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:

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,26 +431,34 @@ 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]
 
 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

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"