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