{-# 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)
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
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
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
([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
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
"./" 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
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
)