Util.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections        #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE CPP #-}

module System.Util
  ( isRW
  , isExe
  , exeExists
  , getShellExe
  , getXdgConfigFolder
  , getDotConfigFolder
  , getHomeFolder
  , getCurrFolder
  , getCustomFolder
  , checkOrCreate
  , tidleExp
  , normFilePath
  , getDefaultShell
  ) where

import Prelude
import Data.Semigroup

import System.Lifted
import System.Directory.Lifted
import System.Environment.Lifted
import System.Posix.User.Lifted
import System.FilePath
import System.IO.Error
import GHC.IO.Exception

import Control.Monad.Trans.Either
import Control.Applicative

------------------------------------------------------------------------------
-- Text Utils ----------------------------------------------------------------
------------------------------------------------------------------------------

type EitherIOException  = EitherT IOException

deriveSystemLiftedErrors "DisallowIOE [HardwareFault]" ''EitherIOException
deriveSystemDirectory   ''EitherIOException
deriveSystemEnvironment ''EitherIOException
deriveSystemPosixUser   ''EitherIOException

isRW :: FilePath -> EitherT IOException IO FilePath
isRW path = do
  perm <- getPermissions path
  if readable perm && writable perm
    then right path
    else left $ mkIOError PermissionDenied
                          "Missing read/write permissions"
                          Nothing (Just path)

isExe :: FilePath -> EitherT IOException IO FilePath
isExe path = do
  perm <- getPermissions path
  if executable perm
    then right path
    else left $ mkIOError PermissionDenied
                          "Missing executable permissions"
                          Nothing (Just path)

doesNotExist :: String -> IOError
doesNotExist str = mkIOError doesNotExistErrorType str
                             Nothing Nothing

-- this could receive a path relative to the current directory or
-- the executable name (in the path).
exeExists :: FilePath -> EitherT IOException IO FilePath
exeExists path = joinMET (doesNotExist "Executable not found")
         $  bimapEitherT id Just (isExe path)
        <> findExecutable path

-- | Check if a executable pointed by the given environement
-- variable exists, and is executable.
getShellExe :: FilePath -> EitherT IOException IO FilePath
getShellExe var = do
  exe <- joinMET ( doesNotExist (  "Variable "
                                <> var
                                <> " not found in current environment")
                 )
       $ lookupEnv var
  exeExists exe

-- | Get configuration folder
-- http://stackoverflow.com/a/1024339/516184
getXdgConfigFolder :: EitherT IOException IO FilePath
getXdgConfigFolder = isRW =<< getEnv "XDG_CONFIG_HOME"

getDotConfigFolder :: EitherT IOException IO FilePath
getDotConfigFolder = do
  home   <- isRW =<< getHomeDirectory
  isRW $ home </> ".config"

getHomeFolder :: EitherT IOException IO FilePath
getHomeFolder = isRW =<< getHomeDirectory

getCurrFolder :: EitherT IOException IO FilePath
getCurrFolder = isRW "."

getCustomFolder :: Maybe FilePath -> EitherT IOException IO FilePath
getCustomFolder fp = case fp of
  Nothing  -> left . userError $ "No path provided"
  Just fp' -> do
      dirExists <- doesDirectoryExist fp'
      if dirExists
        then isRW fp'
        else left $ mkIOError NoSuchThing "Invalid path provided"
                              Nothing (Just fp')

-- | Check if a given directory exists, and if it features Read/Write permissions.
-- If it does not exist, create it.
checkOrCreate :: FilePath -> EitherT IOException IO FilePath
checkOrCreate path = createDirectoryIfMissing True path >> isRW path

-- | Perform tidle expansion so that @~ = $HOME@.
-- It does not handle tidle as $HOME in other places besides first caracter
-- in FilePath
tidleExp :: FilePath -> EitherT IOException IO FilePath
tidleExp fp = do
  home <- getHomeFolder
  right $ case fp of
    ""     -> ""
    (x:xs) -> case x of
      '~' -> case xs of
        []     -> home
        (y:ys) -> if isPathSeparator y then home </> ys else x:xs
      _ -> x:xs

normFilePath :: FilePath -> EitherT IOException IO FilePath
normFilePath fp
  = makeValid . normalise <$> (canonicalizePath =<< tidleExp fp)


-- | Determine system shell: best effort. Tries @$SHELL@ variable first,
-- then POSIX shell user entry, than in a last effort @/bin/sh@.
getDefaultShell :: EitherT IOException IO FilePath
getDefaultShell = envShell <> nixShell <> wtfShell
  where
    envShell = getEnv "SHELL"
    nixShell = fmap userShell $ getUserEntryForID =<< getRealUserID
    wtfShell = joinMET (mkIOError NoSuchThing "No shell found!" Nothing Nothing)
             $ findExecutable "/bin/sh"