diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,33 @@ +module Main where + +import Options.Applicative +import SetupNative +import Install +import Update + +data Action = Update | Setup | Install String String deriving (Eq, Ord, Read, Show) + +extraOptsParser :: String -> Either String Char +extraOptsParser "" = Left "No characters left to parse" +extraOptsParser (c : _) = Right c + +installParser :: Parser Action +installParser = Install <$> strArgument (metavar "LIBRARY") + <*> (unwords <$> many (strArgument (metavar "ARGS..."))) + +actionParser :: Parser Action +actionParser = subparser ( + command "update" (info (pure Update) (progDesc updateDesc)) + <> command "setup" (info (pure Setup) (progDesc setupDesc)) + <> command "install" (info installParser (progDesc installDesc))) + where setupDesc = "Create the folders for libraries and set environment variables" + installDesc = "Install a library" + updateDesc = "Update the available library list" + +main :: IO () +main = do + act <- execParser (info actionParser fullDesc) + case act of + Update -> update + Setup -> setup + Install lib args -> install lib args diff --git a/native.cabal b/native.cabal new file mode 100644 --- /dev/null +++ b/native.cabal @@ -0,0 +1,59 @@ +name: native +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/githubuser/native#readme +license: BSD3 +license-file: LICENSE +author: Author name here +maintainer: example@example.com +copyright: 2016 Author name here +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +data-files: *.ps1 +data-dir: src/PowerShell + +library + hs-source-dirs: src + exposed-modules: SetupNative + Install + PowerShell + Update + other-modules: Paths_native + build-depends: base >= 4.7 && < 5 + , directory + , filepath + , process + , shelly + , text + , bytestring + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: OverloadedStrings + +executable native-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: base + , native + , optparse-applicative + default-language: Haskell2010 + default-extensions: OverloadedStrings + + +test-suite native-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , native + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/githubuser/native diff --git a/src/Install.hs b/src/Install.hs new file mode 100644 --- /dev/null +++ b/src/Install.hs @@ -0,0 +1,18 @@ +module Install where + +import System.FilePath +import PowerShell +import System.Directory +import Text.Printf + +install :: String -> String -> IO () +install lib args = do + dataDir <- getAppUserDataDirectory "native-libs" + let tempDir = dataDir "temp" + scriptsDir = dataDir "scripts" + includeDir = dataDir "include" + binDir = dataDir "bin" + dirArgs = printf "-temp \"%s\" -scripts \"%s\" -include \"%s\" -bin \"%s\" " + tempDir scriptsDir includeDir binDir + runPSStream (scriptsDir lib <.> "ps1") (dirArgs ++ args) + cleanTemp diff --git a/src/PowerShell.hs b/src/PowerShell.hs new file mode 100644 --- /dev/null +++ b/src/PowerShell.hs @@ -0,0 +1,54 @@ +module PowerShell where + +import Paths_native +import Data.Monoid +import Control.Monad +import System.Process +import System.Exit +import System.Directory +import System.FilePath + +paramsList :: [(String, String)] -> [String] +paramsList = concatMap (\(p, v) -> ["-" <> p, v]) + +runPS :: String -> String -> IO String +runPS psPath parStr = do + let cmdString = "powershell -ExecutionPolicy ByPass -File \"" ++ psPath ++ "\" " ++ parStr + cmd = shell cmdString + (ec, out, err) <- readCreateProcessWithExitCode cmd "" + case ec of + ExitSuccess -> return out + ExitFailure c -> error $ "Command `" ++ cmdString ++ "` failed with exit code " ++ show c + ++ "\nThe error was:\n" ++ err + +runPSStream :: String -> String -> IO () +runPSStream psPath parStr = do + let cmdString = "powershell -ExecutionPolicy ByPass -File \"" ++ psPath ++ "\" " ++ parStr + callCommand cmdString + +runDataPS :: String -> [(String, String)] -> IO String +runDataPS psFile params = do + psPath <- getDataFileName psFile + runPS psPath parStr + where parStr = unwords $ paramsList params + +getEnvVar :: String -> IO (Maybe String) +getEnvVar v = do + val <- runDataPS "GetEnvironmentVariable.ps1" [("var", v)] + case val of + "" -> return Nothing + x -> return (Just x) + +setupEnvVars :: IO () +setupEnvVars = void $ runDataPS "Setup.ps1" [] + +addPath :: IO () +addPath = void $ runDataPS "AddPath.ps1" [] + +download :: String -> IO String +download url = runDataPS "Download.ps1" [("url", url)] + +cleanTemp :: IO () +cleanTemp = do + dataDir <- getAppUserDataDirectory "native-libs" + void $ runDataPS "CleanTemp.ps1" [("tempDir", dataDir "temp")] diff --git a/src/PowerShell/AddPath.ps1 b/src/PowerShell/AddPath.ps1 new file mode 100644 --- /dev/null +++ b/src/PowerShell/AddPath.ps1 @@ -0,0 +1,3 @@ +$newPath = $env:PATH + ";" + $env:APPDATA + "\native-libs\bin" +[Environment]::SetEnvironmentVariable("PATH", $newPath, [System.EnvironmentVariableTarget]::User) +[Environment]::SetEnvironmentVariable("PATH", $newPath, [System.EnvironmentVariableTarget]::Process) diff --git a/src/PowerShell/CleanTemp.ps1 b/src/PowerShell/CleanTemp.ps1 new file mode 100644 --- /dev/null +++ b/src/PowerShell/CleanTemp.ps1 @@ -0,0 +1,2 @@ +param([String]$tempDir) +remove-item ($tempDir + "\*") -Recurse diff --git a/src/PowerShell/Download.ps1 b/src/PowerShell/Download.ps1 new file mode 100644 --- /dev/null +++ b/src/PowerShell/Download.ps1 @@ -0,0 +1,2 @@ +param([string]$url) +[Console]::Write((Invoke-WebRequest -Uri $url).Content) diff --git a/src/PowerShell/GetEnvironmentVariable.ps1 b/src/PowerShell/GetEnvironmentVariable.ps1 new file mode 100644 --- /dev/null +++ b/src/PowerShell/GetEnvironmentVariable.ps1 @@ -0,0 +1,2 @@ +param([string]$var) +[Console]::Write([Environment]::GetEnvironmentVariable($var)) diff --git a/src/PowerShell/Setup.ps1 b/src/PowerShell/Setup.ps1 new file mode 100644 --- /dev/null +++ b/src/PowerShell/Setup.ps1 @@ -0,0 +1,6 @@ +$newCPath = $env:CPATH + ";" + $env:APPDATA + "\native-libs\include" +[Environment]::SetEnvironmentVariable("CPATH", $newCPath, [System.EnvironmentVariableTarget]::User) +[Environment]::SetEnvironmentVariable("CPATH", $newCPath, [System.EnvironmentVariableTarget]::Process) +$newLibPath = $env:LIBRARY_PATH + ";" + $env:APPDATA + "\native-libs\bin" +[Environment]::SetEnvironmentVariable("LIBRARY_PATH", $newLibPath, [System.EnvironmentVariableTarget]::User) +[Environment]::SetEnvironmentVariable("LIBRARY_PATH", $newLibPath, [System.EnvironmentVariableTarget]::Process) diff --git a/src/SetupNative.hs b/src/SetupNative.hs new file mode 100644 --- /dev/null +++ b/src/SetupNative.hs @@ -0,0 +1,33 @@ +module SetupNative where + +import System.Directory +import System.FilePath +import PowerShell +import Control.Monad + +dirs :: [String] +dirs = ["bin", "include", "scripts", "temp"] + +setup :: IO () +setup = do + dataDir <- getAppUserDataDirectory "native-libs" + mapM_ (\d -> createDirectoryIfMissing True (dataDir d)) dirs + let binPath = dataDir "bin" + includePath = dataDir "include" + putStrLn $ "Adding " ++ binPath ++ " to the LIBRARY_PATH environment variable and" + putStrLn $ "adding " ++ includePath ++ " to the CPATH environment variable." + setupEnvVars + putStrLn $ "It's recommended that you also add " ++ binPath ++ " to your PATH variable." + putStrLn "Would you like this to be done for you? (y/n)" + shouldAddPath <- getYN + when shouldAddPath addPath + +getYN :: IO Bool +getYN = do + line <- getLine + case line of + "y" -> return True + "Y" -> return True + "n" -> return False + "N" -> return False + _ -> putStrLn "Please answer with y or n." >> getYN diff --git a/src/Update.hs b/src/Update.hs new file mode 100644 --- /dev/null +++ b/src/Update.hs @@ -0,0 +1,15 @@ +module Update where + +import PowerShell +import System.FilePath +import System.Directory +import Control.Monad + +update :: IO () +update = do + list <- filter (any (/= ' ')) . lines + <$> download "https://gitlab.com/LukaHorvat/native/raw/master/libs.txt" + forM_ list $ \s -> do + let name = reverse . takeWhile (/= '/') . reverse $ s + dataDir <- getAppUserDataDirectory "native-libs" + download s >>= writeFile (dataDir "scripts" name) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"