content: {-# LANGUAGE TupleSections #-}
  module Matterhorn.FilePaths
    ( historyFilePath
    , historyFileName
  
    , lastRunStateFilePath
    , lastRunStateFileName
  
    , configFileName
    , charWidthsFileName
  
    , 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 = "matterhorn"
  
  historyFileName :: FilePath
  historyFileName = "history.txt"
  
  lastRunStateFileName :: Text -> FilePath
  lastRunStateFileName teamId = "last_run_state_" ++ unpack teamId ++ ".json"
  
  configFileName :: FilePath
  configFileName = "config.ini"
  
  charWidthsFileName :: FilePath
  charWidthsFileName = "char_widths.txt"
  
  historyFilePath :: IO FilePath
  historyFilePath = getUserConfigFile xdgName historyFileName
  
  lastRunStateFilePath :: Text -> IO FilePath
  lastRunStateFilePath teamId =
    getUserConfigFile xdgName (lastRunStateFileName teamId)
  
  -- | Get the XDG path to the user-specific syntax definition directory.
  -- The path does not necessarily exist.
  xdgSyntaxDir :: IO FilePath
  xdgSyntaxDir = (</> syntaxDirName) <$> getUserConfigDir xdgName
  
  -- | Get the list of syntax paths based on XDG data directory paths.
  xdgDataDirs :: IO [FilePath]
  xdgDataDirs = do
      dirs <- getAllDataDirs xdgName
      return $ (</> syntaxDirName) <$> dirs
  
  -- | Get the XDG path to the user-specific emoji JSON file. The path
  -- does not necessarily exist.
  userEmojiJsonPath :: IO FilePath
  userEmojiJsonPath = (</> emojiJsonFilename) <$> getUserConfigDir xdgName
  
  -- | Get the emoji JSON path relative to the development binary location
  -- or the release binary location.
  bundledEmojiJsonPath :: IO FilePath
  bundledEmojiJsonPath = do
      selfPath <- getExecutablePath
      let distDir = "dist-newstyle/"
          pathBits = splitPath selfPath
  
      adjacentEmojiJsonPath <- do
        let path = takeDirectory selfPath </> emojiDirName </> emojiJsonFilename
        exists <- doesFileExist path
        return $ if exists then Just path else Nothing
  
      cabalEmojiJsonPath <- Paths.getDataFileName $ emojiDirName </> emojiJsonFilename
  
      return $ if distDir `elem` pathBits
               then
                   -- We're in development, so use the development
                   -- executable path to locate the emoji path in the
                   -- development tree.
                   (joinPath $ takeWhile (/= distDir) pathBits) </> emojiDirName </> 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.
                   fromMaybe cabalEmojiJsonPath adjacentEmojiJsonPath
  
  emojiJsonFilename :: FilePath
  emojiJsonFilename = "emoji.json"
  
  emojiDirName :: FilePath
  emojiDirName = "emoji"
  
  syntaxDirName :: FilePath
  syntaxDirName = "syntax"
  
  -- | Find a specified configuration file by looking in all of the
  -- supported locations.
  locateConfig :: FilePath -> IO (Maybe FilePath)
  locateConfig filename = do
    xdgLocations <- getAllConfigFiles xdgName filename
    let confLocations = ["./" <> filename] ++
                        xdgLocations ++
                        ["/etc/matterhorn/" <> filename]
    results <- forM confLocations $ \fp -> (fp,) <$> doesFileExist fp
    return $ listToMaybe $ fst <$> filter snd results
  
  scriptDirName :: FilePath
  scriptDirName = "scripts"
  
  data Script
    = ScriptPath FilePath
    | NonexecScriptPath FilePath
    | ScriptNotFound
      deriving (Eq, Read, Show)
  
  toScript :: FilePath -> IO (Script)
  toScript fp = do
    perm <- getPermissions fp
    return $ if executable perm
      then ScriptPath fp
      else NonexecScriptPath fp
  
  isExecutable :: FilePath -> IO Bool
  isExecutable fp = do
    perm <- getPermissions fp
    return (executable perm)
  
  locateScriptPath :: FilePath -> IO Script
  locateScriptPath name
    | head name == '.' = return ScriptNotFound
    | otherwise = do
      xdgLocations <- getAllConfigFiles xdgName scriptDirName
      let cmdLocations = [ xdgLoc ++ "/" ++ name
                         | xdgLoc <- xdgLocations
                         ] ++ [ "/etc/matterhorn/scripts/" <> name ]
      existingFiles <- filterM doesFileExist cmdLocations
      executables <- mapM toScript existingFiles
      return $ case executables of
        (path:_) -> path
        _        -> ScriptNotFound
  
  -- | This returns a list of valid scripts, and a list of non-executable
  --   scripts.
  getAllScripts :: IO ([FilePath], [FilePath])
  getAllScripts = do
    xdgLocations <- getAllConfigFiles xdgName scriptDirName
    let cmdLocations = xdgLocations ++ ["/etc/matterhorn/scripts"]
    let getCommands dir = do
          exists <- doesDirectoryExist dir
          if exists
            then map ((dir ++ "/") ++) `fmap` getDirectoryContents dir
            else return []
    let isNotHidden f = case f of
          ('.':_) -> False
          []      -> False
          _       -> True
    allScripts <- concat `fmap` mapM getCommands cmdLocations
    execs <- filterM isExecutable allScripts
    nonexecs <- filterM (fmap not . isExecutable) allScripts
    return ( filter isNotHidden $ map takeBaseName execs
           , filter isNotHidden $ map takeBaseName nonexecs
           )
  