{-# LANGUAGE TemplateHaskell #-}

module Distribution.CommandLine
    ( writeManpages
    , writeBashCompletions
    , setManpath
    , writeTheFuck
    ) where

import           Data.Bool          (bool)
import           Control.Monad      (unless, void)
import           System.Directory   (createDirectoryIfMissing, doesDirectoryExist)
import           System.Environment (lookupEnv)
import           System.Process     (readCreateProcessWithExitCode, shell)
import           Data.FileEmbed     (embedStringFile)

rules :: String
rules = $(embedStringFile "py/optparse-applicative.py")

-- | Write a set of rules based on
-- [optparse-applicative](http://hackage.haskell.org/package/optparse-applicative)
-- for the command-line tool
-- [fuck](https://pypi.python.org/pypi/thefuck/).
writeTheFuck :: IO ()
writeTheFuck = do
    h <- lookupEnv "HOME"
    case h of
        Just h' -> do
            proceed <- doesDirectoryExist (h' ++ "/.config/thefuck/rules")
            bool (pure ()) (writeFile (h' ++ "/.config/thefuck/rules/optparse-applicative.py") rules) proceed
        Nothing -> pure ()

-- | Add a line exporting the modified @MANPATH@ to the user's @bashrc@, if it
-- does not exist already.
setManpath :: IO ()
setManpath = do
    home <- lookupEnv "HOME"
    case home of
        Just x -> do
            let bashRc = x ++ "/.bashrc"
            config <- readFile bashRc
            unless ("#manpath updated by cli-setup" `elem` lines config && length config > 0)
                (appendFile bashRc "\n#manpath updated by cli-setup\nexport MANPATH=~/.local/share:$MANPATH\n" >>
                 void (readCreateProcessWithExitCode (shell $ "MANPATH=" ++ x ++ "/.local/share mandb") ""))
        Nothing -> pure ()

-- | As an example, if your source tarball contains a file @man/madlang.1@ you
-- could use
--
-- > writeManpages "man/madlang.1" "madlang.1"
writeManpages :: FilePath -- ^ Source File
              -> FilePath -- ^ Manpage file name
              -> IO ()
writeManpages p p' = do
    home <- lookupEnv "HOME"
    case home of
        Just x -> do
            let manPath = x ++ "/.local/share/man/man1"
            createDirectoryIfMissing True manPath
            writeFile (manPath ++ "/" ++ p') =<< readFile p
        Nothing -> pure ()

-- | Add a line to the user's @bashrc@ so that command-line completions work
-- automatically.
writeBashCompletions :: String -- ^ Executable name
                     -> IO ()
writeBashCompletions exeName = do
    home <- lookupEnv "HOME"
    case home of
        Just x -> do
            let bashRc = x ++ "/.bashrc"
            config <- readFile bashRc
            unless (("# Added for " ++ exeName) `elem` lines config)
                (appendFile bashRc ("\n# Added for " ++ exeName ++ "\neval \"$(" ++ exeName ++ " --bash-completion-script " ++ exeName ++ ")\"\n"))
        Nothing -> pure ()