{- |
  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 :: IO FilePath -> IO FilePath
getShareDir IO FilePath
cabalDataDir = do
  FilePath
appDir <- FilePath -> FilePath
stripVersion (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
cabalDataDir
  FilePath
sharePath <- ( FilePath -> FilePath -> FilePath
</> FilePath
"share" FilePath -> FilePath -> FilePath
</> FilePath
appDir )
    (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeDirectory (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeDirectory (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getExecutablePath

  Bool
sharePathExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
sharePath
  if Bool
sharePathExists
    then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
sharePath
    else FilePath -> IO FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Share directory " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sharePath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" does not exist"


stripVersion :: String -> String
stripVersion :: FilePath -> FilePath
stripVersion = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
tail (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse