{-# LANGUAGE TupleSections #-}
module Matterhorn.FilePaths
  ( historyFilePath
  , historyFileName

  , lastRunStateFilePath
  , lastRunStateFileName

  , configFileName

  , xdgName
  , locateConfig
  , xdgSyntaxDir
  , syntaxDirName
  , userEmojiJsonPath
  , bundledEmojiJsonPath
  , emojiJsonFilename

  , Script(..)
  , locateScriptPath
  , getAllScripts
  )
where

import Prelude ()
import Matterhorn.Prelude

import qualified Paths_matterhorn as Paths

import Data.Text ( unpack )
import System.Directory ( doesFileExist
                        , doesDirectoryExist
                        , getDirectoryContents
                        , getPermissions
                        , executable
                        )
import System.Environment ( getExecutablePath )
import System.Environment.XDG.BaseDir ( getUserConfigFile
                                      , getAllConfigFiles
                                      , getUserConfigDir
                                      )
import System.FilePath ( (</>), takeBaseName, takeDirectory, splitPath, joinPath )


xdgName :: String
xdgName :: String
xdgName = String
"matterhorn"

historyFileName :: FilePath
historyFileName :: String
historyFileName = String
"history.txt"

lastRunStateFileName :: Text -> FilePath
lastRunStateFileName :: Text -> String
lastRunStateFileName Text
teamId = String
"last_run_state_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
teamId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json"

configFileName :: FilePath
configFileName :: String
configFileName = String
"config.ini"

historyFilePath :: IO FilePath
historyFilePath :: IO String
historyFilePath = String -> String -> IO String
getUserConfigFile String
xdgName String
historyFileName

lastRunStateFilePath :: Text -> IO FilePath
lastRunStateFilePath :: Text -> IO String
lastRunStateFilePath Text
teamId =
  String -> String -> IO String
getUserConfigFile String
xdgName (Text -> String
lastRunStateFileName Text
teamId)

-- | Get the XDG path to the user-specific syntax definition directory.
-- The path does not necessarily exist.
xdgSyntaxDir :: IO FilePath
xdgSyntaxDir :: IO String
xdgSyntaxDir = (String -> String -> String
</> String
syntaxDirName) (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getUserConfigDir String
xdgName

-- | Get the XDG path to the user-specific emoji JSON file. The path
-- does not necessarily exist.
userEmojiJsonPath :: IO FilePath
userEmojiJsonPath :: IO String
userEmojiJsonPath = (String -> String -> String
</> String
emojiJsonFilename) (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getUserConfigDir String
xdgName

-- | Get the emoji JSON path relative to the development binary location
-- or the release binary location.
bundledEmojiJsonPath :: IO FilePath
bundledEmojiJsonPath :: IO String
bundledEmojiJsonPath = do
    String
selfPath <- IO String
getExecutablePath
    let distDir :: String
distDir = String
"dist-newstyle/"
        pathBits :: [String]
pathBits = String -> [String]
splitPath String
selfPath

    Maybe String
adjacentEmojiJsonPath <- do
      let path :: String
path = String -> String
takeDirectory String
selfPath String -> String -> String
</> String
emojiDirName String -> String -> String
</> String
emojiJsonFilename
      Bool
exists <- String -> IO Bool
doesFileExist String
path
      Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then String -> Maybe String
forall a. a -> Maybe a
Just String
path else Maybe String
forall a. Maybe a
Nothing

    String
cabalEmojiJsonPath <- String -> IO String
Paths.getDataFileName (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
emojiDirName String -> String -> String
</> String
emojiJsonFilename

    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ if String
distDir String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
pathBits
             then
                 -- We're in development, so use the development
                 -- executable path to locate the emoji path in the
                 -- development tree.
                 ([String] -> String
joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
distDir) [String]
pathBits) String -> String -> String
</> String
emojiDirName String -> String -> String
</> String
emojiJsonFilename
             else
                 -- In this case we assume the binary is being run from
                 -- a release, in which case the syntax directory is a
                 -- sibling of the executable path. If it does not exist
                 -- we fall back to the cabal data files path discovered
                 -- via Paths.getDataFileName.
                 String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
cabalEmojiJsonPath Maybe String
adjacentEmojiJsonPath

emojiJsonFilename :: FilePath
emojiJsonFilename :: String
emojiJsonFilename = String
"emoji.json"

emojiDirName :: FilePath
emojiDirName :: String
emojiDirName = String
"emoji"

syntaxDirName :: FilePath
syntaxDirName :: String
syntaxDirName = String
"syntax"

-- | Find a specified configuration file by looking in all of the
-- supported locations.
locateConfig :: FilePath -> IO (Maybe FilePath)
locateConfig :: String -> IO (Maybe String)
locateConfig String
filename = do
  [String]
xdgLocations <- String -> String -> IO [String]
getAllConfigFiles String
xdgName String
filename
  let confLocations :: [String]
confLocations = [String
"./" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filename] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                      [String]
xdgLocations [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                      [String
"/etc/matterhorn/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filename]
  [(String, Bool)]
results <- [String] -> (String -> IO (String, Bool)) -> IO [(String, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
confLocations ((String -> IO (String, Bool)) -> IO [(String, Bool)])
-> (String -> IO (String, Bool)) -> IO [(String, Bool)]
forall a b. (a -> b) -> a -> b
$ \String
fp -> (String
fp,) (Bool -> (String, Bool)) -> IO Bool -> IO (String, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesFileExist String
fp
  Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ (String, Bool) -> String
forall a b. (a, b) -> a
fst ((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, Bool) -> Bool
forall a b. (a, b) -> b
snd [(String, Bool)]
results

scriptDirName :: FilePath
scriptDirName :: String
scriptDirName = String
"scripts"

data Script
  = ScriptPath FilePath
  | NonexecScriptPath FilePath
  | ScriptNotFound
    deriving (Script -> Script -> Bool
(Script -> Script -> Bool)
-> (Script -> Script -> Bool) -> Eq Script
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Script -> Script -> Bool
$c/= :: Script -> Script -> Bool
== :: Script -> Script -> Bool
$c== :: Script -> Script -> Bool
Eq, ReadPrec [Script]
ReadPrec Script
Int -> ReadS Script
ReadS [Script]
(Int -> ReadS Script)
-> ReadS [Script]
-> ReadPrec Script
-> ReadPrec [Script]
-> Read Script
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Script]
$creadListPrec :: ReadPrec [Script]
readPrec :: ReadPrec Script
$creadPrec :: ReadPrec Script
readList :: ReadS [Script]
$creadList :: ReadS [Script]
readsPrec :: Int -> ReadS Script
$creadsPrec :: Int -> ReadS Script
Read, Int -> Script -> String -> String
[Script] -> String -> String
Script -> String
(Int -> Script -> String -> String)
-> (Script -> String)
-> ([Script] -> String -> String)
-> Show Script
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Script] -> String -> String
$cshowList :: [Script] -> String -> String
show :: Script -> String
$cshow :: Script -> String
showsPrec :: Int -> Script -> String -> String
$cshowsPrec :: Int -> Script -> String -> String
Show)

toScript :: FilePath -> IO (Script)
toScript :: String -> IO Script
toScript String
fp = do
  Permissions
perm <- String -> IO Permissions
getPermissions String
fp
  Script -> IO Script
forall (m :: * -> *) a. Monad m => a -> m a
return (Script -> IO Script) -> Script -> IO Script
forall a b. (a -> b) -> a -> b
$ if Permissions -> Bool
executable Permissions
perm
    then String -> Script
ScriptPath String
fp
    else String -> Script
NonexecScriptPath String
fp

isExecutable :: FilePath -> IO Bool
isExecutable :: String -> IO Bool
isExecutable String
fp = do
  Permissions
perm <- String -> IO Permissions
getPermissions String
fp
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Permissions -> Bool
executable Permissions
perm)

locateScriptPath :: FilePath -> IO Script
locateScriptPath :: String -> IO Script
locateScriptPath String
name
  | String -> Char
forall a. [a] -> a
head String
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' = Script -> IO Script
forall (m :: * -> *) a. Monad m => a -> m a
return Script
ScriptNotFound
  | Bool
otherwise = do
    [String]
xdgLocations <- String -> String -> IO [String]
getAllConfigFiles String
xdgName String
scriptDirName
    let cmdLocations :: [String]
cmdLocations = [ String
xdgLoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
                       | String
xdgLoc <- [String]
xdgLocations
                       ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"/etc/matterhorn/scripts/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name ]
    [String]
existingFiles <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [String]
cmdLocations
    [Script]
executables <- (String -> IO Script) -> [String] -> IO [Script]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Script
toScript [String]
existingFiles
    Script -> IO Script
forall (m :: * -> *) a. Monad m => a -> m a
return (Script -> IO Script) -> Script -> IO Script
forall a b. (a -> b) -> a -> b
$ case [Script]
executables of
      (Script
path:[Script]
_) -> Script
path
      [Script]
_        -> Script
ScriptNotFound

-- | This returns a list of valid scripts, and a list of non-executable
--   scripts.
getAllScripts :: IO ([FilePath], [FilePath])
getAllScripts :: IO ([String], [String])
getAllScripts = do
  [String]
xdgLocations <- String -> String -> IO [String]
getAllConfigFiles String
xdgName String
scriptDirName
  let cmdLocations :: [String]
cmdLocations = [String]
xdgLocations [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"/etc/matterhorn/scripts"]
  let getCommands :: String -> IO [String]
getCommands String
dir = do
        Bool
exists <- String -> IO Bool
doesDirectoryExist String
dir
        if Bool
exists
          then (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/") String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO [String]
getDirectoryContents String
dir
          else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  let isNotHidden :: String -> Bool
isNotHidden String
f = case String
f of
        (Char
'.':String
_) -> Bool
False
        []      -> Bool
False
        String
_       -> Bool
True
  [String]
allScripts <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [String]
getCommands [String]
cmdLocations
  [String]
execs <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
isExecutable [String]
allScripts
  [String]
nonexecs <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool) -> (String -> IO Bool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
isExecutable) [String]
allScripts
  ([String], [String]) -> IO ([String], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ( (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isNotHidden ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
takeBaseName [String]
execs
         , (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isNotHidden ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
takeBaseName [String]
nonexecs
         )