{-# 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 :: FilePath
xdgName = FilePath
"matterhorn"

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

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

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

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

lastRunStateFilePath :: Text -> IO FilePath
lastRunStateFilePath :: Text -> IO FilePath
lastRunStateFilePath Text
teamId =
  FilePath -> FilePath -> IO FilePath
getUserConfigFile FilePath
xdgName (Text -> FilePath
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 FilePath
xdgSyntaxDir = (FilePath -> FilePath -> FilePath
</> FilePath
syntaxDirName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
getUserConfigDir FilePath
xdgName

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

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

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

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

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if FilePath
distDir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
pathBits
             then
                 -- We're in development, so use the development
                 -- executable path to locate the emoji path in the
                 -- development tree.
                 ([FilePath] -> FilePath
joinPath forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= FilePath
distDir) [FilePath]
pathBits) FilePath -> FilePath -> FilePath
</> FilePath
emojiDirName FilePath -> FilePath -> FilePath
</> FilePath
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.
                 forall a. a -> Maybe a -> a
fromMaybe FilePath
cabalEmojiJsonPath Maybe FilePath
adjacentEmojiJsonPath

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

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

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

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

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

data Script
  = ScriptPath FilePath
  | NonexecScriptPath FilePath
  | ScriptNotFound
    deriving (Script -> Script -> Bool
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]
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 -> FilePath -> FilePath
[Script] -> FilePath -> FilePath
Script -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Script] -> FilePath -> FilePath
$cshowList :: [Script] -> FilePath -> FilePath
show :: Script -> FilePath
$cshow :: Script -> FilePath
showsPrec :: Int -> Script -> FilePath -> FilePath
$cshowsPrec :: Int -> Script -> FilePath -> FilePath
Show)

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

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

locateScriptPath :: FilePath -> IO Script
locateScriptPath :: FilePath -> IO Script
locateScriptPath FilePath
name
  | forall a. [a] -> a
head FilePath
name forall a. Eq a => a -> a -> Bool
== Char
'.' = forall (m :: * -> *) a. Monad m => a -> m a
return Script
ScriptNotFound
  | Bool
otherwise = do
    [FilePath]
xdgLocations <- FilePath -> FilePath -> IO [FilePath]
getAllConfigFiles FilePath
xdgName FilePath
scriptDirName
    let cmdLocations :: [FilePath]
cmdLocations = [ FilePath
xdgLoc forall a. [a] -> [a] -> [a]
++ FilePath
"/" forall a. [a] -> [a] -> [a]
++ FilePath
name
                       | FilePath
xdgLoc <- [FilePath]
xdgLocations
                       ] forall a. [a] -> [a] -> [a]
++ [ FilePath
"/etc/matterhorn/scripts/" forall a. Semigroup a => a -> a -> a
<> FilePath
name ]
    [FilePath]
existingFiles <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
cmdLocations
    [Script]
executables <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO Script
toScript [FilePath]
existingFiles
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 ([FilePath], [FilePath])
getAllScripts = do
  [FilePath]
xdgLocations <- FilePath -> FilePath -> IO [FilePath]
getAllConfigFiles FilePath
xdgName FilePath
scriptDirName
  let cmdLocations :: [FilePath]
cmdLocations = [FilePath]
xdgLocations forall a. [a] -> [a] -> [a]
++ [FilePath
"/etc/matterhorn/scripts"]
  let getCommands :: FilePath -> IO [FilePath]
getCommands FilePath
dir = do
        Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
        if Bool
exists
          then forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
"/") forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
          else forall (m :: * -> *) a. Monad m => a -> m a
return []
  let isNotHidden :: FilePath -> Bool
isNotHidden FilePath
f = case FilePath
f of
        (Char
'.':FilePath
_) -> Bool
False
        []      -> Bool
False
        FilePath
_       -> Bool
True
  [FilePath]
allScripts <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
getCommands [FilePath]
cmdLocations
  [FilePath]
execs <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
isExecutable [FilePath]
allScripts
  [FilePath]
nonexecs <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
isExecutable) [FilePath]
allScripts
  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isNotHidden forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
takeBaseName [FilePath]
execs
         , forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isNotHidden forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
takeBaseName [FilePath]
nonexecs
         )