{-# LANGUAGE TupleSections #-}
module Matterhorn.FilePaths
( historyFilePath
, historyFileName
, lastRunStateFilePath
, lastRunStateFileName
, configFileName
, xdgName
, locateConfig
, xdgSyntaxDir
, xdgDataDirs
, 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
, getAllDataDirs
)
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_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
unpack Text
teamId FilePath -> FilePath -> FilePath
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)
xdgSyntaxDir :: IO FilePath
xdgSyntaxDir :: IO FilePath
xdgSyntaxDir = (FilePath -> FilePath -> FilePath
</> FilePath
syntaxDirName) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
getUserConfigDir FilePath
xdgName
xdgDataDirs :: IO [FilePath]
xdgDataDirs :: IO [FilePath]
xdgDataDirs = do
[FilePath]
dirs <- FilePath -> IO [FilePath]
getAllDataDirs FilePath
xdgName
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath -> FilePath
</> FilePath
syntaxDirName) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
dirs
userEmojiJsonPath :: IO FilePath
userEmojiJsonPath :: IO FilePath
userEmojiJsonPath = (FilePath -> FilePath -> FilePath
</> FilePath
emojiJsonFilename) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
getUserConfigDir FilePath
xdgName
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
Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path else Maybe FilePath
forall a. Maybe a
Nothing
FilePath
cabalEmojiJsonPath <- FilePath -> IO FilePath
Paths.getDataFileName (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
emojiDirName FilePath -> FilePath -> FilePath
</> FilePath
emojiJsonFilename
FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ if FilePath
distDir FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
pathBits
then
([FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
distDir) [FilePath]
pathBits) FilePath -> FilePath -> FilePath
</> FilePath
emojiDirName FilePath -> FilePath -> FilePath
</> FilePath
emojiJsonFilename
else
FilePath -> Maybe FilePath -> FilePath
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"
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
"./" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
filename] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath]
xdgLocations [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath
"/etc/matterhorn/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
filename]
[(FilePath, Bool)]
results <- [FilePath]
-> (FilePath -> IO (FilePath, Bool)) -> IO [(FilePath, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
confLocations ((FilePath -> IO (FilePath, Bool)) -> IO [(FilePath, Bool)])
-> (FilePath -> IO (FilePath, Bool)) -> IO [(FilePath, Bool)]
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> (FilePath
fp,) (Bool -> (FilePath, Bool)) -> IO Bool -> IO (FilePath, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist FilePath
fp
Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, Bool) -> FilePath) -> [(FilePath, Bool)] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath, Bool) -> Bool)
-> [(FilePath, Bool)] -> [(FilePath, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath, Bool) -> Bool
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
(Script -> Script -> Bool)
-> (Script -> Script -> Bool) -> Eq Script
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Script -> Script -> Bool
== :: Script -> Script -> Bool
$c/= :: Script -> Script -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS Script
readsPrec :: Int -> ReadS Script
$creadList :: ReadS [Script]
readList :: ReadS [Script]
$creadPrec :: ReadPrec Script
readPrec :: ReadPrec Script
$creadListPrec :: ReadPrec [Script]
readListPrec :: ReadPrec [Script]
Read, Int -> Script -> FilePath -> FilePath
[Script] -> FilePath -> FilePath
Script -> FilePath
(Int -> Script -> FilePath -> FilePath)
-> (Script -> FilePath)
-> ([Script] -> FilePath -> FilePath)
-> Show Script
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Script -> FilePath -> FilePath
showsPrec :: Int -> Script -> FilePath -> FilePath
$cshow :: Script -> FilePath
show :: Script -> FilePath
$cshowList :: [Script] -> FilePath -> FilePath
showList :: [Script] -> FilePath -> FilePath
Show)
toScript :: FilePath -> IO (Script)
toScript :: FilePath -> IO Script
toScript FilePath
fp = do
Permissions
perm <- FilePath -> IO Permissions
getPermissions FilePath
fp
Script -> IO Script
forall a. a -> IO a
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 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
Bool -> IO Bool
forall a. a -> IO a
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
| FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' = Script -> IO Script
forall a. a -> IO a
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 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name
| FilePath
xdgLoc <- [FilePath]
xdgLocations
] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"/etc/matterhorn/scripts/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name ]
[FilePath]
existingFiles <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
cmdLocations
[Script]
executables <- (FilePath -> IO Script) -> [FilePath] -> IO [Script]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO Script
toScript [FilePath]
existingFiles
Script -> IO Script
forall a. a -> IO a
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
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 [FilePath] -> [FilePath] -> [FilePath]
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 (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
else [FilePath] -> IO [FilePath]
forall a. a -> IO a
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 <- [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO [FilePath]
getCommands [FilePath]
cmdLocations
[FilePath]
execs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
isExecutable [FilePath]
allScripts
[FilePath]
nonexecs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool)
-> (FilePath -> IO Bool) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
isExecutable) [FilePath]
allScripts
([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ( (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isNotHidden ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
takeBaseName [FilePath]
execs
, (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isNotHidden ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
takeBaseName [FilePath]
nonexecs
)