-- | This module provides utility functions for creating prompts. Useful
-- if you want to use Shh and GHCi as a shell.
module Shh.Prompt where

import Shh
import System.Environment
import Network.HostName
import Data.Time
import Data.List

-- | The type of GHCi prompt functions
type PromptFn = [String] -- ^ names of the modules currently in scope
                -> Int -- ^ line number (as referenced in compiler messages) of the current prompt
                -> IO String

-- | Format a prompt line suitable for use with Shh.
--
-- This also calls `initInteractive`, which is required for a good
-- user experience when using `shh` as a shell.
--
-- The format of the prompt uses the "%" character as an escape mechanism,
-- allowing for the substitution of various values into the prompt.
--
-- * @%% -> %@
-- * @%u -> current user@
-- * @%w -> current directory@
-- * @%h -> hostname@
-- * @%t -> HH:MM:SS@
--
-- Use it by importing @Shh.Prompt@ in your @.ghci@ or @$SHH_DIR/init.ghci@
-- files and @:set prompt-function formatPrompt "%u\@%h:%w$ "@
formatPrompt :: String -> PromptFn
formatPrompt :: String -> PromptFn
formatPrompt String
fmt [String]
_ Int
_ = do
    IO ()
initInteractive
    String -> IO String
format String
fmt
        where

            format :: String -> IO String
            format :: String -> IO String
format (Char
'%' : Char
'%' : String
rest) = (Char
'%'Char -> 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
<$> String -> IO String
format String
rest
            format (Char
'%' : Char
'u' : String
rest) = String -> String -> IO String
insertEnv String
"USER" String
rest
            format (Char
'%' : Char
'w' : String
rest) = IO String -> String -> IO String
insertIO IO String
prettyPwd String
rest
            format (Char
'%' : Char
'h' : String
rest) = IO String -> String -> IO String
insertIO IO String
getHostName String
rest
            format (Char
'%' : Char
't' : String
rest) = IO String -> String -> IO String
insertIO IO String
getTime String
rest
            format ( Char
x  : String
rest) = (Char
xChar -> 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
<$> String -> IO String
format String
rest
            format [] = String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

            insertEnv :: String -> String -> IO String
            insertEnv :: String -> String -> IO String
insertEnv String
var String
rest = IO String -> String -> IO String
insertIO (String -> IO String
getEnv String
var) String
rest

            insertIO :: IO String -> String -> IO String
            insertIO :: IO String -> String -> IO String
insertIO IO String
a String
rest = IO String
a IO String -> (String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
s -> (String
s 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
<$> String -> IO String
format String
rest

            getTime :: IO String
            getTime :: IO String
getTime = TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S" (LocalTime -> String) -> IO LocalTime -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (TimeZone -> UTCTime -> LocalTime
utcToLocalTime (TimeZone -> UTCTime -> LocalTime)
-> IO TimeZone -> IO (UTCTime -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TimeZone
getCurrentTimeZone IO (UTCTime -> LocalTime) -> IO UTCTime -> IO LocalTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO UTCTime
getCurrentTime)

            prettyPwd :: IO String
            prettyPwd :: IO String
prettyPwd = do
                String
pwd  <- String -> IO String
getEnv String
"PWD"
                String
home <- String -> IO String
getEnv String
"HOME"
                if String
home String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
pwd
                then
                    String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Char
'~' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
home) String
pwd
                else
                    String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
pwd