diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2016-2018, Dino Morelli +Copyright (c) 2016-2019, Dino Morelli Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,85 +3,96 @@ ## Synopsis -Install Haskell software +Pack a haskell project into a deployable directory structure ## Description ### OVERVIEW -hsinstall is a tool for deploying software projects into directory structures -suitable for installation on a system. At this time this means Haskell software -but possible future expansion could support other types of projects. It builds -upon the `stack install` command and adds more features. Those are: +hsinstall is a tool for installing a Haskell software project into a directory +structure for deployment. It builds upon the `stack install` command and adds +these features: -- Copying the `LICENSE` file into the deployment directory -- Copying the `resources` directory into the deployment directory so these - files can be located using relative paths at runtime (more on this later in - RESOURCES) -- Building an AppDir directory structure for a project and producing an - [AppImage](https://appimage.org/) +- Copies the `LICENSE` file into /share//doc +- Copies the contents of a static directory stucture in your project (named + `hsinstall`) into the destination prefix directory. This can contain + additional binaries or scripts, resources, documentation, etc. (more on this + later in TEMPLATE DIRECTORY) +- Optionally builds an AppDir directory structure for the project and produces + an [AppImage](https://appimage.org/) binary -It will be necessary to have the Haskell stack tool on your PATH: +To use hsinstall, it will be necessary to have the Haskell stack tool on your PATH: https://docs.haskellstack.org/en/stable/README/ -If the AppImage features are desired, you must have these tools on your PATH: -linuxdeploy: https://github.com/linuxdeploy/linuxdeploy/releases +If the AppImage features are desired, you must have these tools on your PATH: +linuxdeploy: https://github.com/linuxdeploy/linuxdeploy/releases linuxdeploy-plugin-appimage: https://github.com/linuxdeploy/linuxdeploy-plugin-appimage/releases -### MODES - -hsinstall operates in two modes. The first is a plain deployment with no -AppImage creation. The PREFIX will default to `AppDir/usr` and all binaries in -the project will be deployed to `AppDir/usr/bin`. - -The second mode is intended to set up for AppImage creation and is triggered by -specifying exactly one EXECUTABLE from the project in the arguments. This will -change the PREFIX to `AppDir_EXECUTABLE/usr`. And only that single executable -will be copied to the `AppDir_EXECUTABLE/usr/bin` directory. +Running hsinstall on a project for the first time and with no arguments will produce this in . : -Regardless of which mode is being used, the directory layout will be a standard -[FHS](http://www.pathname.com/fhs/) shape, common in UNIX-like operating -systems. Like this: + AppDir/ + usr/ + bin/ <-- All binaries in the project + share/ + / + doc/ + LICENSE - / - bin/... - share/ - -/ <-- this is the share directory - doc/LICENSE - resources/... +The -p,--prefix switch allows you to set a prefix other than `AppDir/usr`. This +could be anywhere, like `myproject-2.3` or `/usr/local` or `/opt` -Be aware that when the `--delete` switch is used the binaries in `/bin` -WILL NOT be deleted, only the share directory: -`/share/-` +In addition, if an `hsinstall` directory exists, its contents will be copied +into the prefix before build and install. See TEMPLATE DIRECTORY below for more +info on this. ### APPIMAGE CREATION -Even for a first-time AppImaging, this tool should produce a working AppImage. -If missing, it will create default `.desktop` and `.svg` files in -`util/resources/appimage`. Customize or replace these to fit your project, and -then check these two files into source control for future builds. +The -i,--mk-appimage switch will change the default prefix to `EXE.AppDir/usr` +and only the specified EXE will be installed into `/bin`, AppImages are +intended to be made for exactly one binary. +If .desktop and .svg files are not found in the hsinstall directory, defaults +will be created for you and placed in the correct subdirs. Check these files +into source control for future builds. + The default `.desktop` file Categories will be populated with 'Utility;'. We recommend adjusting this using the XDG list of registered categories: https://specifications.freedesktop.org/menu-spec/latest/apa.html -If your application is a command-line program, append this line to the end of -the default `.desktop` file: 'Terminal=true' +If your application is a command-line program, append a line containing this to +the end of the default `.desktop` file: 'Terminal=true' -If your application isn't a command-line tool, we recommend using a proper icon -instead of the hsinstall default, which is a command shell icon. +If your application isn't a command-line program, we recommend using a proper +icon instead of the hsinstall default, which is a command shell icon. -### RESOURCES +For more info on AppImage: https://appimage.org/ -If present, hsinstall will deploy a `resources` directory to -`/share/PROJECT-VERSION/resources`. In order to locate these files at -runtime, the hsinstall project includes a library to construct paths relative -to the executable. See this source code for help with integrating this into -your app: -https://github.com/dino-/hsinstall/blob/master/src/lib/HSInstall/Resources.hs +### TEMPLATE DIRECTORY +If present, hsinstall will copy the contents of the `hsinstall` template +directory into ``. Here's an explanation of the hsinstall directory +contents: + hsinstall/ + bin/ <-- Put additional binaries and scripts to be deployed here + share/ + applications/ <-- Only for AppImage + .desktop <-- Will be generated by first-time AppImage creation attempt + / <-- Only needed if you have resources + resources/ <-- Put data files your software will need at runtime here + icons/ <-- Only for AppImage + hicolor/ + scalable/ + apps/ + .svg <-- Will be generated by first-time AppImage creation attempt + +In order to locate data files at runtime, including resources, the hsinstall +project includes a library to construct the share path relative to the +executable. See [this source code](https://github.com/dino-/hsinstall/blob/master/src/lib/HSInstall/Resources.hs) +for help with integrating this into your app. + + ## Development Browse [the source](https://github.com/dino-/hsinstall) @@ -91,6 +102,7 @@ $ git clone https://github.com/dino-/hsinstall.git $ cd hsinstall $ stack build + $ stack haddock --no-haddock-deps hsinstall If you have the abovementioned `linuxdeploy-*` programs on your path, we can do something *really* cool. Use this freshly-built hsinstall to package itself @@ -98,7 +110,10 @@ $ stack exec hsinstall -- --mk-appimage hsinstall -And you should see an `hsinstall-x86_64.AppImage` binary in `.` +And you should see an `hsinstall-y.z-x86_64.AppImage` binary in `.` + +Tip: Use `git clean -df` to blow away untracked things like the AppDir and +AppImage artifacts. ## Contact diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,36 @@ +2.5 (2019-12-01) + + * Using an infoHelper for the --version switch + * Moved Stackage snapshot up to lts-14.8 + * Updated usage to reflect the new template dir behavior + * Changed lib/HSInstall/Resources.hs to Paths.hs + * Added custom code for recursive file copying + * Fixed bug with default prefix directory + * Removed the --delete switch + * Rolled EXE argument into --mk-appimage switch + * Changed how resources and AppImage source files are handled + * Added a handy tip about git clean + * Removed code to force cabal file creation + + +2.4 (2019-04-26) + + * Moved copyright date up to 2019 + * Separated code into more modules for clarity + * Switched from GetOpt to optparse-applicative + * Fixed API doc wording + * Adjusted code with hlint's advice + * Now trying to force stack/hpack to generate the cabal file if it's missing + * Added app version number to AppImage filename + + +2.3 (2019-03-03) + + * Changed deployment dir name to EXECUTABLE.AppDir + * Switched all uses of Text.Printf to the Fmt library + * Moved Stackage resolver up to lts-13.9 + + 2.2 (2018-11-07) * Added actual exception handling diff --git a/hsinstall.cabal b/hsinstall.cabal --- a/hsinstall.cabal +++ b/hsinstall.cabal @@ -1,11 +1,13 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack -- --- hash: 35c4f282c3fea06102620b49eaf6f60604590bc715e824129b7d631d3abcce75 +-- hash: cde38aac58226456391a0e700ed87399090f09072641677d7446a999c45dc231 name: hsinstall -version: 2.2 +version: 2.5 synopsis: Install Haskell software description: This is a tool for deploying software projects into directory structures suitable for installation on a system. It builds upon the `stack install` command and adds more features. It's also a tool for easier AppImage creation. category: Utility @@ -13,21 +15,21 @@ bug-reports: https://github.com/dino-/hsinstall/issues author: Dino Morelli maintainer: Dino Morelli -copyright: 2016-2018 Dino Morelli +copyright: 2016-2019 Dino Morelli license: ISC license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 extra-source-files: - .gitignore changelog.md doc/hcar/hsinstall.tex + .gitignore + hsinstall/share/applications/hsinstall.desktop + hsinstall/share/hsinstall/resources/unix-terminal.svg + hsinstall/share/icons/hicolor/scalable/apps/hsinstall.svg package.yaml README.md - resources/unix-terminal.svg stack.yaml - util/resources/appimage/hsinstall.desktop - util/resources/appimage/hsinstall.svg + stack.yaml.lock source-repository head type: git @@ -35,7 +37,7 @@ library exposed-modules: - HSInstall.Resources + HSInstall.Paths other-modules: Paths_hsinstall hs-source-dirs: @@ -50,19 +52,26 @@ executable hsinstall main-is: hsinstall.hs other-modules: + HSInstall.AppImage + HSInstall.Common + HSInstall.DeploymentInfo HSInstall.Except HSInstall.Opts + HSInstall.System.Directory Paths_hsinstall hs-source-dirs: src/app ghc-options: -fwarn-tabs -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends: Cabal + , ansi-wl-pprint , base >=4.8 && <5.0 , directory , filepath + , fmt , heredoc , hsinstall + , optparse-applicative , process , safe-exceptions default-language: Haskell2010 diff --git a/hsinstall/share/applications/hsinstall.desktop b/hsinstall/share/applications/hsinstall.desktop new file mode 100644 --- /dev/null +++ b/hsinstall/share/applications/hsinstall.desktop @@ -0,0 +1,7 @@ +[Desktop Entry] +Name=hsinstall +Exec=hsinstall +Icon=hsinstall +Type=Application +Categories=Utility;ConsoleOnly; +Terminal=true diff --git a/hsinstall/share/hsinstall/resources/unix-terminal.svg b/hsinstall/share/hsinstall/resources/unix-terminal.svg new file mode 100644 --- /dev/null +++ b/hsinstall/share/hsinstall/resources/unix-terminal.svg @@ -0,0 +1,320 @@ + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + + + diff --git a/hsinstall/share/icons/hicolor/scalable/apps/hsinstall.svg b/hsinstall/share/icons/hicolor/scalable/apps/hsinstall.svg new file mode 100644 --- /dev/null +++ b/hsinstall/share/icons/hicolor/scalable/apps/hsinstall.svg @@ -0,0 +1,320 @@ + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + + + diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,22 +1,23 @@ name: hsinstall -version: '2.2' +version: '2.5' synopsis: Install Haskell software description: This is a tool for deploying software projects into directory structures suitable for installation on a system. It builds upon the `stack install` command and adds more features. It's also a tool for easier AppImage creation. license: ISC author: Dino Morelli maintainer: Dino Morelli -copyright: 2016-2018 Dino Morelli +copyright: 2016-2019 Dino Morelli category: Utility extra-source-files: - changelog.md - doc/hcar/hsinstall.tex - .gitignore +- hsinstall/share/applications/hsinstall.desktop +- hsinstall/share/hsinstall/resources/unix-terminal.svg +- hsinstall/share/icons/hicolor/scalable/apps/hsinstall.svg - package.yaml - README.md -- resources/unix-terminal.svg - stack.yaml -- util/resources/appimage/hsinstall.desktop -- util/resources/appimage/hsinstall.svg +- stack.yaml.lock github: dino-/hsinstall @@ -30,22 +31,22 @@ dependencies: - base >= 4.8 && < 5.0 +- directory +- filepath library: source-dirs: src/lib - dependencies: - - directory - - filepath executables: hsinstall: source-dirs: src/app main: hsinstall.hs dependencies: + - ansi-wl-pprint - Cabal - - directory - - filepath + - fmt - heredoc - hsinstall + - optparse-applicative - process - safe-exceptions diff --git a/resources/unix-terminal.svg b/resources/unix-terminal.svg deleted file mode 100644 --- a/resources/unix-terminal.svg +++ /dev/null @@ -1,320 +0,0 @@ - - - - - - - - - - image/svg+xml - - - - - - - - - - - - - - - - - - - diff --git a/src/app/HSInstall/AppImage.hs b/src/app/HSInstall/AppImage.hs new file mode 100644 --- /dev/null +++ b/src/app/HSInstall/AppImage.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HSInstall.AppImage + ( mkAppImage, prepAppImageFiles ) + where + +import Control.Monad ( unless ) +import qualified System.Directory as Dir +import System.Environment ( setEnv ) +import System.FilePath ( (), (<.>), takeDirectory ) +import System.Process ( callProcess ) + +import HSInstall.Common ( dumpStockIcon, tmplDir ) +import HSInstall.DeploymentInfo ( DeploymentInfo (binDir, prefixDir, version) ) + + +data DesktopFileStatus = CreateNewDesktop | DesktopExists + + +desktopDir :: FilePath +desktopDir = tmplDir "share" "applications" + +iconDir :: FilePath +iconDir = tmplDir "share" "icons" "hicolor" "scalable" "apps" + + +prepAppImageFiles :: String -> IO DesktopFileStatus +prepAppImageFiles exe = do + -- Check and possibly create new icon + let iconPath = iconDir exe <.> "svg" + iconExists <- Dir.doesFileExist iconPath + unless iconExists $ do + Dir.createDirectoryIfMissing True iconDir + dumpStockIcon $ Just iconPath + + -- Check desktop file, return status to caller + let desktopPath = desktopDir exe <.> "desktop" + desktopFileExists <- Dir.doesFileExist desktopPath + return $ if desktopFileExists then DesktopExists else CreateNewDesktop + + +mkAppImage :: String -> DeploymentInfo -> DesktopFileStatus -> IO () + +mkAppImage exe di DesktopExists = do + let desktopArg = "--desktop-file=" ++ + (desktopDir exe <.> "desktop") + mkAppImage' exe di desktopArg + +mkAppImage exe di CreateNewDesktop = do + mkAppImage' exe di "--create-desktop-file" + -- Now copy the freshly-created .desktop file into the project sources + let desktopFile = exe <.> "desktop" + Dir.createDirectoryIfMissing True desktopDir + Dir.copyFile + (prefixDir di "share" "applications" desktopFile) + (desktopDir desktopFile) + + +mkAppImage' :: String -> DeploymentInfo -> String -> IO () +mkAppImage' exe di desktopArg = do + setEnv "VERSION" $ version di + callProcess "linuxdeploy-x86_64.AppImage" + [ "--appdir=" ++ (takeDirectory . prefixDir $ di) + , "--executable=" ++ (binDir di exe) + , desktopArg + , "--icon-file=" ++ (iconDir exe <.> "svg") + , "--output=appimage" + ] diff --git a/src/app/HSInstall/Common.hs b/src/app/HSInstall/Common.hs new file mode 100644 --- /dev/null +++ b/src/app/HSInstall/Common.hs @@ -0,0 +1,24 @@ +module HSInstall.Common + ( dumpStockIcon + , tmplDir + ) + where + +import Data.Maybe ( fromMaybe ) +import HSInstall.Paths ( getShareDir ) +import Paths_hsinstall ( getDataDir ) +import System.Directory ( copyFile ) +import System.FilePath ( FilePath, (), (<.>) ) + + +tmplDir :: FilePath +tmplDir = "." "hsinstall" + + +dumpStockIcon :: Maybe FilePath -> IO () +dumpStockIcon mbDestPath = do + shareDir <- getShareDir getDataDir + let iconFilename = "unix-terminal" <.> "svg" + let iconSourcePath = shareDir "resources" iconFilename + let destPath = fromMaybe iconFilename mbDestPath + copyFile iconSourcePath destPath diff --git a/src/app/HSInstall/DeploymentInfo.hs b/src/app/HSInstall/DeploymentInfo.hs new file mode 100644 --- /dev/null +++ b/src/app/HSInstall/DeploymentInfo.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HSInstall.DeploymentInfo + ( DeploymentInfo (..) + , constructDeploymentInfo + + -- re-exporting + , normal + ) + where + +import Data.List ( isSuffixOf ) +import Data.Maybe ( listToMaybe ) +import Distribution.Package + ( PackageId + , PackageIdentifier (pkgName, pkgVersion) + ) +import Distribution.PackageDescription + ( GenericPackageDescription (packageDescription) + , PackageDescription (package) + ) +import Distribution.PackageDescription.Parsec + ( readGenericPackageDescription ) +import Distribution.Pretty ( prettyShow ) +import Distribution.Types.PackageName ( unPackageName ) +import Distribution.Verbosity ( normal ) +import Fmt ( (+|), (|+) ) +import System.Directory ( getDirectoryContents ) +import System.FilePath ( () ) + +import HSInstall.Except + ( HSInstallException (NoCabalFiles) + , throwM + ) +import HSInstall.Opts + ( BuildMode (AppImageExe, Project) , Options (..) + ) + + +data DeploymentInfo = DeploymentInfo + { prefixDir :: FilePath + , binDir :: FilePath + , shareDir :: FilePath + , docDir :: FilePath + , rsrcDir :: FilePath + , version :: String + } + + +constructDeploymentInfo :: Options -> IO DeploymentInfo +constructDeploymentInfo opts = do + mbCabalFile <- listToMaybe . filter (isSuffixOf ".cabal") + <$> getDirectoryContents "." + maybe (throwM NoCabalFiles) + (fmap (constructDeploymentInfo' opts . package . packageDescription) + . readGenericPackageDescription normal) mbCabalFile + + +constructDeploymentInfo' :: Options -> PackageId -> DeploymentInfo +constructDeploymentInfo' opts pkgId = + DeploymentInfo prefixDir' binDir' shareDir' + (shareDir' "doc") (shareDir' "resources") version' + + where + prefixDir' = computePrefixDir (optPrefix opts) (optBuildMode opts) + binDir' = prefixDir' "bin" + project = unPackageName . pkgName $ pkgId + version' = prettyShow . pkgVersion $ pkgId + shareDir' = prefixDir' "share" (""+|project|+"") + + +computePrefixDir :: Maybe FilePath -> BuildMode -> FilePath +computePrefixDir (Just prefix') _ = prefix' +computePrefixDir Nothing (AppImageExe exe) = (""+|exe|+".AppDir") "usr" +computePrefixDir Nothing Project = "AppDir" "usr" diff --git a/src/app/HSInstall/Except.hs b/src/app/HSInstall/Except.hs --- a/src/app/HSInstall/Except.hs +++ b/src/app/HSInstall/Except.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module HSInstall.Except @@ -11,19 +12,16 @@ import Control.Exception.Safe ( Exception, Handler (..), Typeable, catches, throwM ) -import GHC.IO.Exception ( IOException (ioe_filename, ioe_type) ) +import GHC.IO.Exception ( IOException ) import System.Exit ( die ) -import Text.Printf ( printf ) data HSInstallException = NoCabalFiles - | OneExePerAppImage deriving Typeable instance Show HSInstallException where - show NoCabalFiles = "no cabal files were found in ." - show OneExePerAppImage = "one executable must be specified to build an AppImage" + show NoCabalFiles = "no cabal files were found in . If this is a buildable project directory that uses hpack, try issuing any stack command to generate the cabal file from the package.yaml" instance Exception HSInstallException @@ -34,11 +32,10 @@ exceptionHandlers :: [Handler IO a] exceptionHandlers = - [ Handler (\(err :: IOException) -> explainError $ - printf "%s%s" (show . ioe_type $ err) (maybe "" (": " ++) . ioe_filename $ err)) + [ Handler (\(err :: IOException) -> explainError . show $ err) , Handler (\(err :: HSInstallException) -> explainError $ show err) ] explainError :: String -> IO a -explainError = die . printf "Could not continue because: %s" +explainError = die . ("Could not continue because: " ++) diff --git a/src/app/HSInstall/Opts.hs b/src/app/HSInstall/Opts.hs --- a/src/app/HSInstall/Opts.hs +++ b/src/app/HSInstall/Opts.hs @@ -1,150 +1,142 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module HSInstall.Opts - ( AppImageExe (getExe) + ( BuildMode (..) , Options (..) - , formattedVersion , parseOpts - , usageText ) where -import Data.Maybe ( listToMaybe ) import Data.Version ( showVersion ) +import Fmt ( (+|), (|+), format ) +import Options.Applicative import Paths_hsinstall ( version ) -import System.Console.GetOpt import System.Environment ( getProgName ) import Text.Heredoc ( here ) -import Text.Printf ( printf ) +import Text.PrettyPrint.ANSI.Leijen ( string ) -newtype AppImageExe = AppImageExe { getExe :: String } +data BuildMode = AppImageExe String | Project data Options = Options { optClean :: Bool - , optDelete :: Bool , optDumpIcon :: Bool - , optHelp :: Bool - , optMkAppImage :: Bool - , optPrefix :: FilePath - , optVersion :: Bool + , optBuildMode :: BuildMode + , optPrefix :: Maybe FilePath } -defaultOptions :: Options -defaultOptions = Options - { optClean = False - , optDelete = False - , optDumpIcon = False - , optHelp = False - , optMkAppImage = False - , optPrefix = "AppDir/usr" - , optVersion = False - } +parser :: Parser Options +parser = Options + <$> switch + ( long "clean" + <> short 'c' + <> help "Do 'stack clean' first" + ) + <*> switch + ( long "dump-stock-icon" + <> help "Save a default icon, unix-terminal.svg, to the current working directory" + ) + <*> ( maybe Project AppImageExe <$> optional + ( strOption + ( long "mk-appimage" + <> short 'i' + <> metavar "EXE" + <> help "Prepare the AppDir structure and build an AppImage for EXE. Changes PREFIX to EXE.AppDir/usr." + ) + ) + ) + <*> optional ( strOption + ( long "prefix" + <> short 'p' + <> metavar "DIR" + <> help "Install prefix directory (Default: AppDir/usr)" + ) + ) -options :: [OptDescr (Options -> Options)] -options = - [ Option ['c'] ["clean"] - (NoArg (\opts -> opts { optClean = True } )) - "Do 'stack clean' first" - , Option ['d'] ["delete"] - (NoArg (\opts -> opts { optDelete = True } )) - "Delete the share directory before copying files" - , Option [] ["dump-stock-icon"] - (NoArg (\opts -> opts { optDumpIcon = True } )) - "Save a default icon, unix-termianl.svg, to the current working directory" - , Option ['h'] ["help"] - (NoArg (\opts -> opts { optHelp = True } )) - "This help information" - , Option ['i'] ["mk-appimage"] - (NoArg (\opts -> opts { optMkAppImage = True } )) - "Prepare the AppDir structure and build an AppImage for EXECUTABLE" - , Option ['p'] ["prefix"] - (ReqArg (\s opts -> opts { optPrefix = s } ) "PREFIX" ) - (printf "Install prefix directory. Default: %s" (optPrefix defaultOptions)) - , Option [] ["version"] - (NoArg (\opts -> opts { optVersion = True } )) - "Show version information" +versionHelper :: String -> Parser (a -> a) +versionHelper progName = + infoOption (""+|progName|+" "+|showVersion version|+"") $ mconcat + [ long "version" + , help "Show version information" + , hidden ] -parseOpts :: [String] -> IO (Options, Maybe AppImageExe) -parseOpts args = - case getOpt Permute options args of - (o,n,[] ) -> do - let oApplied = foldl (flip id) defaultOptions o - return (oApplied, AppImageExe <$> listToMaybe n) - (_,_,errs) -> do - ut <- usageText - ioError $ userError (concat errs ++ ut) +parseOpts :: IO Options +parseOpts = do + pn <- getProgName + execParser $ info (parser <**> helper <**> versionHelper pn) + ( header (""+|pn|+" - Pack a haskell project into a deployable directory structure") + <> footer' + ) -usageText :: IO String -usageText = do - progName <- getProgName - return $ (usageInfo (header progName) options) ++ "\n" ++ - (printf body $ showVersion version) - - where - header progName = init $ unlines - [ "Usage: " ++ progName ++ " [OPTIONS]" - , " " ++ progName ++ " [OPTIONS] [EXECUTABLE]" - , "" - , "options:" - ] - body = [here|OVERVIEW +footer' :: InfoMod a +footer' = footerDoc . Just . string . format content . showVersion $ version + where content = [here|OVERVIEW -hsinstall is a tool for deploying software projects into directory structures suitable for installation on a system. At this time this means Haskell software but possible future expansion could support other types of projects. It builds upon the `stack install` command and adds more features. Those are: +hsinstall is a tool for installing a Haskell software project into a directory structure for deployment. It builds upon the `stack install` command and adds these features: -- Copying the `LICENSE` file into the deployment directory -- Copying the `resources` directory into the deployment directory so these files can be located using relative paths at runtime (more on this later in RESOURCES) -- Building an AppDir directory structure for a project and producing an AppImage +- Copies the `LICENSE` file into /share//doc +- Copies the contents of a static directory stucture in your project (named `hsinstall`) into the destination prefix directory. This can contain additional binaries or scripts, resources, documentation, etc. (more on this later in TEMPLATE DIRECTORY) +- Optionally builds an AppDir directory structure for the project and produces an AppImage binary -It will be necessary to have the Haskell stack tool on your PATH: +To use hsinstall, it will be necessary to have the Haskell stack tool on your PATH: https://docs.haskellstack.org/en/stable/README/ If the AppImage features are desired, you must have these tools on your PATH: linuxdeploy: https://github.com/linuxdeploy/linuxdeploy/releases linuxdeploy-plugin-appimage: https://github.com/linuxdeploy/linuxdeploy-plugin-appimage/releases -MODES - -hsinstall operates in two modes. The first is a plain deployment with no AppImage creation. The PREFIX will default to `AppDir/usr` and all binaries in the project will be deployed to `AppDir/usr/bin`. - -The second mode is intended to set up for AppImage creation and is triggered by specifying exactly one EXECUTABLE from the project in the arguments. This will change the PREFIX to `AppDir_EXECUTABLE/usr`. And only that single executable will be copied to the `AppDir_EXECUTABLE/usr/bin` directory. +Running hsinstall on a project for the first time and with no arguments will produce this in . : -Regardless of which mode is being used, the directory layout will be a standard FHS shape, common in UNIX-like operating systems. Like this: + AppDir/ + usr/ + bin/ <-- All binaries in the project + share/ + / + doc/ + LICENSE - / - bin/... - share/ - -/ <-- this is the share directory - doc/LICENSE - resources/... +The -p,--prefix switch allows you to set a prefix other than `AppDir/usr`. This could be anywhere, like `myproject-2.3` or `/usr/local` or `/opt` -Be aware that when the `--delete` switch is used the binaries in `/bin` WILL NOT be deleted, only the share directory: `/share/-` +In addition, if an `hsinstall` directory exists, its contents will be copied into the prefix before build and install. See TEMPLATE DIRECTORY below for more info on this. APPIMAGE CREATION -Even for a first-time AppImaging, this tool should produce a working AppImage. If missing, it will create default `.desktop` and `.svg` files in `util/resources/appimage`. Customize or replace these to fit your project, and then check these two files into source control for future builds. +The -i,--mk-appimage switch will change the default prefix to `EXE.AppDir/usr` and only the specified EXE will be installed into `/bin`, AppImages are intended to be made for exactly one binary. +If .desktop and .svg files are not found in the hsinstall directory, defaults will be created for you and placed in the correct subdirs. Check these files into source control for future builds. + The default `.desktop` file Categories will be populated with 'Utility;'. We recommend adjusting this using the XDG list of registered categories: https://specifications.freedesktop.org/menu-spec/latest/apa.html -If your application is a command-line program, append this line to the end of the default `.desktop` file: 'Terminal=true' +If your application is a command-line program, append a line containing this to the end of the default `.desktop` file: 'Terminal=true' -If your application isn't a command-line tool, we recommend using a proper icon instead of the hsinstall default, which is a command shell icon. +If your application isn't a command-line program, we recommend using a proper icon instead of the hsinstall default, which is a command shell icon. -RESOURCES +For more info on AppImage: https://appimage.org/ -If present, hsinstall will deploy a `resources` directory to `/share/PROJECT-VERSION/resources`. In order to locate these files at runtime, the hsinstall project includes a library to construct paths relative to the executable. See this source code for help with integrating this into your app: https://github.com/dino-/hsinstall/blob/master/src/lib/HSInstall/Resources.hs +TEMPLATE DIRECTORY +If present, hsinstall will copy the contents of the `hsinstall` template directory into ``. Here's an explanation of the hsinstall directory contents: -Version %s Dino Morelli |] + hsinstall/ + bin/ <-- Put additional binaries and scripts to be deployed here + share/ + applications/ <-- Only for AppImage + .desktop <-- Will be generated by first-time AppImage creation attempt + / <-- Only needed if you have resources + resources/ <-- Put data files your software will need at runtime here + icons/ <-- Only for AppImage + hicolor/ + scalable/ + apps/ + .svg <-- Will be generated by first-time AppImage creation attempt +In order to locate data files at runtime, including resources, the hsinstall project includes a library to construct the share path relative to the executable. See this source code for help with integrating this into your app: https://github.com/dino-/hsinstall/blob/master/src/lib/HSInstall/Resources.hs -formattedVersion :: IO String -formattedVersion = do - progName <- getProgName - return $ printf "%s %s" progName (showVersion version) +Version {} Dino Morelli |] diff --git a/src/app/HSInstall/System/Directory.hs b/src/app/HSInstall/System/Directory.hs new file mode 100644 --- /dev/null +++ b/src/app/HSInstall/System/Directory.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HSInstall.System.Directory + ( copyTree + ) + where + +import Control.Monad ( when ) +import Data.List ( (\\) ) +import Fmt ( (+|), (|+), fmtLn ) +import System.Directory ( copyFile, createDirectoryIfMissing, + doesDirectoryExist, getDirectoryContents ) +import System.FilePath ( () ) + + +{- + Recursive file copying code + + It proved difficult to find a stock recursive file copy utility that + preserved the executable bits on things. + + chatty in this context means describe the file copies on stdout. + + Many thanks to [abuzittin gillifirca](https://codereview.stackexchange.com/users/20251/abuzittin-gillifirca) + for the StackOverflow post [Copying files in Haskell](https://codereview.stackexchange.com/questions/68908/copying-files-in-haskell) + from which the following code was lifted. +-} + +copyTree :: Bool -> FilePath -> FilePath -> IO () +copyTree chatty s t = do + createDirectoryIfMissing True t + subItems <- getSubitems s + mapM_ (copyItem chatty s t) subItems + + +getSubitems :: FilePath -> IO [(Bool, FilePath)] +getSubitems path = getSubitems' "" + where + getChildren path' = (\\ [".", ".."]) <$> getDirectoryContents path' + + getSubitems' relPath = do + let absPath = path relPath + isDir <- doesDirectoryExist absPath + children <- if isDir then getChildren absPath else return [] + let relChildren = [relPath p | p <- children] + ((isDir, relPath) :) . concat <$> mapM getSubitems' relChildren + + +copyItem :: Bool -> FilePath -> FilePath -> (Bool, FilePath) -> IO () +copyItem chatty baseSourcePath baseTargetPath (isDir, relativePath) = do + let sourcePath = baseSourcePath relativePath + let targetPath = baseTargetPath relativePath + + when chatty $ + fmtLn $ "Copying "+|sourcePath|+" to "+|targetPath|+"" + + if isDir + then createDirectoryIfMissing False targetPath + else copyFile sourcePath targetPath diff --git a/src/app/hsinstall.hs b/src/app/hsinstall.hs --- a/src/app/hsinstall.hs +++ b/src/app/hsinstall.hs @@ -1,210 +1,65 @@ -import Control.Monad ( unless, when ) -import Data.List ( isSuffixOf ) -import Data.Maybe ( isNothing ) -import Distribution.Package - ( PackageId - , PackageIdentifier (pkgName, pkgVersion) - ) -import Distribution.PackageDescription - ( GenericPackageDescription (packageDescription) - , PackageDescription (package) - ) -import Distribution.PackageDescription.Parsec - ( readGenericPackageDescription ) -import Distribution.Pretty ( prettyShow ) -import Distribution.Simple.Utils ( copyDirectoryRecursive ) -import Distribution.Types.PackageName ( unPackageName ) -import Distribution.Verbosity ( normal ) -import HSInstall.Resources ( getRsrcDir ) +{-# LANGUAGE OverloadedStrings #-} + +import Control.Monad ( when ) +import Fmt ( (+|), (|+), fmtLn ) import qualified System.Directory as Dir -import System.Environment ( getArgs ) import System.Exit ( exitSuccess ) -import System.FilePath ( (), (<.>), takeDirectory ) +import System.FilePath ( () ) import System.Process ( callProcess ) -import Text.Printf ( printf ) -import HSInstall.Except - ( HSInstallException (NoCabalFiles, OneExePerAppImage) - , withExceptionHandling, throwM +import HSInstall.AppImage ( mkAppImage, prepAppImageFiles ) +import HSInstall.Common ( dumpStockIcon, tmplDir ) +import HSInstall.DeploymentInfo + ( DeploymentInfo (binDir, docDir, prefixDir) + , constructDeploymentInfo ) +import HSInstall.Except ( withExceptionHandling ) import HSInstall.Opts - ( AppImageExe (getExe), Options (..) - , formattedVersion, parseOpts, usageText + ( BuildMode (AppImageExe, Project), Options (..) + , parseOpts ) -import Paths_hsinstall ( getDataDir ) +import HSInstall.System.Directory ( copyTree ) main :: IO () main = withExceptionHandling $ do - (opts, mbAppImageExe) <- getOpts + opts <- parseOpts when (optDumpIcon opts) $ dumpStockIcon Nothing >> exitSuccess - dirs <- constructDirs opts mbAppImageExe - - cleanup opts dirs - deployApplication mbAppImageExe dirs - maybe (return ()) (\aie -> - when (optMkAppImage opts) $ - prepAppImageFiles aie >>= mkAppImage aie dirs - ) mbAppImageExe - - -getOpts :: IO (Options, Maybe AppImageExe) -getOpts = do - -- Parse args - allOpts@(opts, mbAppImageExe) <- parseOpts =<< getArgs - - -- User asked for help - when (optHelp opts) $ usageText >>= putStrLn >> exitSuccess - - -- User asked for version - when (optVersion opts) $ formattedVersion >>= putStrLn >> exitSuccess - - when (isNothing mbAppImageExe && optMkAppImage opts) $ do - throwM OneExePerAppImage - - return allOpts - - -dumpStockIcon :: Maybe FilePath -> IO () -dumpStockIcon mbDestPath = do - resourcesDir <- getRsrcDir getDataDir - let iconFilename = "unix-terminal" <.> "svg" - let iconSourcePath = resourcesDir iconFilename - let destPath = maybe iconFilename id mbDestPath - Dir.copyFile iconSourcePath destPath - - -data Dirs = Dirs - { prefixDir :: FilePath - , binDir :: FilePath - , shareDir :: FilePath - , docDir :: FilePath - , rsrcDir :: FilePath - } - - -constructDirs :: Options -> Maybe AppImageExe -> IO Dirs -constructDirs opts mbAppImageExe = do - -- Locate cabal file - cabalFiles <- (filter $ isSuffixOf ".cabal") - <$> Dir.getDirectoryContents "." - - when (null cabalFiles) $ throwM NoCabalFiles - - -- Parse the cabal file and extract things we need from it - -- then pass a pile of what we know to a function to create the - -- installation dirs - constructDirs' opts mbAppImageExe . package . packageDescription - <$> readGenericPackageDescription normal (head cabalFiles) - - -constructDirs' :: Options -> Maybe AppImageExe -> PackageId -> Dirs -constructDirs' opts mbAppImageExe pkgId = - Dirs prefixDir' binDir' shareDir' - (shareDir' "doc") (shareDir' "resources") + di <- constructDeploymentInfo opts - where - prefixDir' = maybe (optPrefix opts) (\e -> "AppDir_" ++ getExe e "usr") - $ mbAppImageExe - binDir' = prefixDir' "bin" - project = unPackageName . pkgName $ pkgId - version' = prettyShow . pkgVersion $ pkgId - shareDir' = prefixDir' "share" (printf "%s-%s" project version') + when (optClean opts) $ callProcess "stack" ["clean"] + deployApplication (optBuildMode opts) di + case optBuildMode opts of + AppImageExe exe -> prepAppImageFiles exe >>= mkAppImage exe di + Project -> return () -cleanup :: Options -> Dirs -> IO () -cleanup opts dirs= do - -- Remove existing application directory (the one down in PREFIX/share) - shareDirExists <- Dir.doesDirectoryExist $ shareDir dirs - when (optDelete opts && shareDirExists) $ do - putStrLn $ "Removing existing directory " ++ (shareDir dirs) - Dir.removeDirectoryRecursive $ shareDir dirs - - -- Clean before building - when (optClean opts) $ callProcess "stack" ["clean"] +modeToStackArg :: BuildMode -> String +modeToStackArg (AppImageExe exe) = ":"+|exe|+"" +modeToStackArg Project = "" -deployApplication :: Maybe AppImageExe -> Dirs -> IO () -deployApplication mbAppImageExe dirs = do +deployApplication :: BuildMode -> DeploymentInfo -> IO () +deployApplication mode di = do -- Copy the binaries - Dir.createDirectoryIfMissing True $ binDir dirs + Dir.createDirectoryIfMissing True $ binDir di callProcess "stack" - [ "install", maybe "" (\aie -> ':' : getExe aie) $ mbAppImageExe - , "--local-bin-path=" ++ binDir dirs + [ "install", modeToStackArg mode + , "--local-bin-path=" ++ binDir di ] - -- Copy additional scripts - {- - putStrLn "Copying additional scripts" - mapM_ (\f -> copyFile ("util" f) (binDir dirs f)) - [ "script1.sh", "script2.hs" ] - -} - -- Copy the license let licenseFile = "LICENSE" licenseFileExists <- Dir.doesFileExist licenseFile when licenseFileExists $ do - printf "\nCopying %s\n" licenseFile - Dir.createDirectoryIfMissing True $ docDir dirs - Dir.copyFile licenseFile (docDir dirs licenseFile) - - -- Copy the resources - let rsrcDirSrc = "." "resources" - rsrcsExist <- Dir.doesDirectoryExist rsrcDirSrc - when rsrcsExist $ do - putStrLn $ "\nCopying resources" - copyDirectoryRecursive normal rsrcDirSrc (rsrcDir dirs) - - -data DesktopFileStatus = CreateNewDesktop | DesktopExists - - -appImageRsrcDir :: FilePath -appImageRsrcDir = "util" "resources" "appimage" - - -prepAppImageFiles :: AppImageExe -> IO DesktopFileStatus -prepAppImageFiles appImageExe = do - let exe = getExe appImageExe - - -- Check and possibly create new icon - let iconPath = appImageRsrcDir exe <.> "svg" - iconExists <- Dir.doesFileExist iconPath - unless iconExists $ do - Dir.createDirectoryIfMissing True appImageRsrcDir - dumpStockIcon $ Just iconPath - - -- Check desktop file, return status to caller - let desktopPath = appImageRsrcDir exe <.> "desktop" - desktopFileExists <- Dir.doesFileExist desktopPath - return $ if desktopFileExists then DesktopExists else CreateNewDesktop - - -mkAppImage :: AppImageExe -> Dirs -> DesktopFileStatus -> IO () - -mkAppImage appImageExe dirs DesktopExists = do - let desktopArg = "--desktop-file=" ++ - (appImageRsrcDir getExe appImageExe <.> "desktop") - mkAppImage' appImageExe dirs desktopArg - -mkAppImage appImageExe dirs CreateNewDesktop = do - mkAppImage' appImageExe dirs "--create-desktop-file" - -- Now copy the freshly-created .desktop file into the project sources - let desktopFile = getExe appImageExe <.> "desktop" - Dir.copyFile - (prefixDir dirs "share" "applications" desktopFile) - (appImageRsrcDir desktopFile) - + fmtLn $ "\nCopying "+|licenseFile|+"" + Dir.createDirectoryIfMissing True $ docDir di + Dir.copyFile licenseFile (docDir di licenseFile) -mkAppImage' :: AppImageExe -> Dirs -> String -> IO () -mkAppImage' appImageExe dirs desktopArg = do - let executable = getExe appImageExe - callProcess "linuxdeploy-x86_64.AppImage" - [ "--appdir=" ++ (takeDirectory $ prefixDir dirs) - , "--executable=" ++ (binDir dirs executable) - , desktopArg - , "--icon-file=" ++ (appImageRsrcDir executable <.> "svg") - , "--output=appimage" - ] + -- Copy the static pack files + tmplExists <- Dir.doesDirectoryExist tmplDir + when tmplExists $ do + putStrLn ("\nCopying distribution files from template dir ("+|tmplDir|+")") + copyTree False tmplDir (prefixDir di) diff --git a/src/lib/HSInstall/Paths.hs b/src/lib/HSInstall/Paths.hs new file mode 100644 --- /dev/null +++ b/src/lib/HSInstall/Paths.hs @@ -0,0 +1,45 @@ +{- | + Deployed file location support library for software deployed with the + hsinstall utility. Or, really, anything that roughly follows an FHS-like + deployment structure. +-} +module HSInstall.Paths + ( getShareDir ) + where + +import System.Directory ( doesDirectoryExist ) +import System.Environment ( getExecutablePath ) +import System.FilePath ( (), takeDirectory, takeFileName ) + + +{- | + Get a path to the share directory relative to the binary location. The + argument passed here is expected to be the output of @getDataDir@ generated + by Cabal at compile time in the @Paths_PROJECTNAME@ module. + + Usage: + + @ + import HSInstall.Paths ( getShareDir ) + import Paths_PROJECTNAME ( getDataDir ) + + shareDir <- getShareDir getDataDir + @ + + If your binary is at @\/foo\/bar\/usr\/bin\/BINARY@, this library will generate + this path: @\/foo\/bar\/usr\/share\/PROJECTNAME@ +-} +getShareDir :: IO FilePath -> IO FilePath +getShareDir cabalDataDir = do + appDir <- stripVersion . takeFileName <$> cabalDataDir + sharePath <- ( "share" appDir ) + . takeDirectory . takeDirectory <$> getExecutablePath + + sharePathExists <- doesDirectoryExist sharePath + if sharePathExists + then return sharePath + else fail $ "Share directory " ++ sharePath ++ " does not exist" + + +stripVersion :: String -> String +stripVersion = reverse . tail . dropWhile (/= '-') . reverse diff --git a/src/lib/HSInstall/Resources.hs b/src/lib/HSInstall/Resources.hs deleted file mode 100644 --- a/src/lib/HSInstall/Resources.hs +++ /dev/null @@ -1,42 +0,0 @@ -{- | - Resource location support library for software deployed with the hsinstall - utility. Or, really, anything that roughly follows an FHS-like deployment - structure. --} -module HSInstall.Resources - ( getRsrcDir ) - where - -import System.Directory ( doesDirectoryExist ) -import System.Environment ( getExecutablePath ) -import System.FilePath ( (), takeDirectory, takeFileName ) - - -{- | - Get a path to the application resources directory relative to the binary - location. The argument passed here is expected to be the output of - @getDataDir@ generated by Cabal at compile time in the @Paths_YOUR_PROJECT@ - module. - - Usage: - - @ - import HSInstall.Resources ( getRsrcDir ) - import Paths_PROJECTNAME ( getDataDir ) - - resourcesDir <- getRsrcDir getDataDir - @ - - If your binary is at @\/foo\/bar\/usr\/bin\/BINARY@, this library will generate - this path: @\/foo\/bar\/usr\/share\/PROJECTNAME-VERSION\/resources@ --} -getRsrcDir :: IO FilePath -> IO FilePath -getRsrcDir cabalDataDir = do - appDir <- takeFileName <$> cabalDataDir - rsrcPath <- ( "share" appDir "resources" ) - . takeDirectory . takeDirectory <$> getExecutablePath - - rsrcPathExists <- doesDirectoryExist rsrcPath - if rsrcPathExists - then return rsrcPath - else fail "Unable to find resources directory" diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-12.13 +resolver: lts-14.8 packages: - '.' diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 524789 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/8.yaml + sha256: 8af5eb80734f02621d37e82cc0cde614af2ddc9c320610acb0b1b6d9ac162930 + original: lts-14.8 diff --git a/util/resources/appimage/hsinstall.desktop b/util/resources/appimage/hsinstall.desktop deleted file mode 100644 --- a/util/resources/appimage/hsinstall.desktop +++ /dev/null @@ -1,7 +0,0 @@ -[Desktop Entry] -Name=hsinstall -Exec=hsinstall -Icon=hsinstall -Type=Application -Categories=Utility;ConsoleOnly; -Terminal=true diff --git a/util/resources/appimage/hsinstall.svg b/util/resources/appimage/hsinstall.svg deleted file mode 100644 --- a/util/resources/appimage/hsinstall.svg +++ /dev/null @@ -1,320 +0,0 @@ - - - - - - - - - - image/svg+xml - - - - - - - - - - - - - - - - - - -