module Core.Util
    ( -- * Better prelude
      module BasePrelude
    , ByteString
    , Map
    , XdgDirectory(XdgConfig)
    , Type
    , ifM
    , doesFileExist
    , proc
    , getXdgDirectory
    , spawnCommand
    , createDirectoryIfMissing

      -- * Types
    , ShowBS              -- type alias: ByteString -> ByteString
    , OpenIn(Term, Open)
    , Items               -- type alias: Map ByteString Int

      -- * Combining file paths
    , tryAddPrefix        -- :: ByteString -> ByteString -> ByteString
    , (<</>>)             -- :: Functor f => f FilePath -> FilePath -> f FilePath
    , (</>)               -- :: FilePath -> FilePath -> FilePath

      -- * System file paths
    , hdmenuPath          -- :: IO FilePath
    , histFile            -- :: IO FilePath

      -- * Running commands
    , spawn               -- :: ByteString -> IO ()
    , openWith            -- :: OpenIn -> ShowBS -> ByteString -> ByteString
    ) where

import BasePrelude
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.UTF8  (toString)
import Data.Kind (Type)
import Data.Map.Strict (Map)
import System.Directory (XdgDirectory (XdgConfig), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
import System.Posix.FilePath qualified as BS -- used for ByteString version of </>
import System.Process (proc, spawnCommand)

-- | Like 'if', but in a monadic context.
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
p m a
x m a
y = m Bool
p m Bool -> (Bool -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then m a
x else m a
y
{-# INLINE ifM #-}

-- | Type for an Map that describes all of the executables with their
-- ratings.
type Items :: Type
type Items = Map ByteString Double

-- | Type for helping to decide how to open something.
type OpenIn :: Type
data OpenIn = Term ShowBS | Open ShowBS

-- | 'ShowS' for 'ByteString' because it is shorter :>.
type ShowBS :: Type
type ShowBS = ByteString -> ByteString

{- | Add a prefix to a string if it does not start with "/".

This will ensure the user can specify absolute paths to files, but also
conveniently use relative paths (starting from @$HOME@) if that is
desired.
-}
tryAddPrefix :: ByteString -> ByteString -> ByteString
tryAddPrefix :: ByteString -> ByteString -> ByteString
tryAddPrefix ByteString
prefix ByteString
xs
    | ByteString -> Bool
BS.null ByteString
xs  = ByteString
""
    | Char -> Bool
isSpecial Char
x = ByteString
xs
    | Bool
otherwise   = ByteString
prefix ByteString -> ByteString -> ByteString
BS.</> ByteString
xs
  where
    Char
x         :: Char         = ByteString -> Char
BS.head ByteString
xs
    Char -> Bool
isSpecial :: Char -> Bool = (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'/', Char
'~'])

-- | Spawn a command and forget about it.
spawn :: ByteString -> IO ()
spawn :: ByteString -> IO ()
spawn = IO ProcessHandle -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ProcessHandle -> IO ())
-> (ByteString -> IO ProcessHandle) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> IO ProcessHandle
spawnCommand ([Char] -> IO ProcessHandle)
-> (ByteString -> [Char]) -> ByteString -> IO ProcessHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> [Char]
toString

-- | Open something.
openWith
    :: OpenIn      -- ^ How (and with what) to open something.
    -> ByteString  -- ^ The thing to open.
    -> ByteString
openWith :: OpenIn -> ByteString -> ByteString
openWith = \case
    Term ByteString -> ByteString
t -> ByteString -> ByteString
t (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ByteString
" -e " <>) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
escape
    Open ByteString -> ByteString
o -> ByteString -> ByteString
o (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ByteString
" "    <>) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
escape
  where
    escape :: ByteString -> ByteString
    escape :: ByteString -> ByteString
escape = (ByteString
"\"" <>) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\"") (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> ByteString) -> ByteString -> ByteString
BS.concatMap \case
        Char
'('  -> ByteString
"\\("
        Char
')'  -> ByteString
"\\)"
        Char
'\'' -> ByteString
"'\"'\"'"
        Char
'\"' -> ByteString
"\\\""
        Char
x    -> Char -> ByteString
BS.singleton Char
x

-- | XDG_CONFIG_HOME
xdgConfig :: IO FilePath
xdgConfig :: IO [Char]
xdgConfig = XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig [Char]
""

-- | Path to the hdmenu directory.
-- @XDG_CONFIG_HOME\/hdmenu@, so probably @~\/.config\/hdmenu@.
hdmenuPath :: IO FilePath
hdmenuPath :: IO [Char]
hdmenuPath = IO [Char]
xdgConfig IO [Char] -> [Char] -> IO [Char]
forall (f :: * -> *). Functor f => f [Char] -> [Char] -> f [Char]
<</>> [Char]
"hdmenu"

-- | Path to the history file.
-- @~\/.config\/hdmenu\/histFile@
histFile :: IO FilePath
histFile :: IO [Char]
histFile = IO [Char]
hdmenuPath IO [Char] -> [Char] -> IO [Char]
forall (f :: * -> *). Functor f => f [Char] -> [Char] -> f [Char]
<</>> [Char]
"histFile"

-- | Functorial path-append operation.
infixr 5 <</>>  -- same as </>
(<</>>) :: Functor f => f FilePath -> FilePath -> f FilePath
f [Char]
liftedFp <</>> :: forall (f :: * -> *). Functor f => f [Char] -> [Char] -> f [Char]
<</>> [Char]
fp = f [Char]
liftedFp f [Char] -> ([Char] -> [Char]) -> f [Char]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Char] -> [Char] -> [Char]
</> [Char]
fp)

-- | Combine two paths into a new path.
-- Adapted from: <https://hackage.haskell.org/package/filepath>
infixr 5 </>
(</>) :: FilePath -> FilePath -> FilePath
</> :: [Char] -> [Char] -> [Char]
(</>) [Char]
a [Char]
b
    | Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'/' Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe [Char]
b = [Char]
b  -- leading path separator
    | Bool
otherwise = [Char] -> [Char] -> [Char]
combineAlways [Char]
a [Char]
b
  where
    -- Combine two paths, assuming rhs is NOT absolute.
    combineAlways :: FilePath -> FilePath -> FilePath
    combineAlways :: [Char] -> [Char] -> [Char]
combineAlways [Char]
z [Char]
w
        | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
z        = [Char]
w
        | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
w        = [Char]
z
        | [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
z Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = [Char]
z [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
w
        | Bool
otherwise     = [Char]
z [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
w