{-# LANGUAGE LambdaCase #-}
{- |
Module      :  Neovim.User.Input
Description :  Utility functions to retrieve user input
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC

-}
module Neovim.User.Input
    where

import Neovim
import Neovim.API.String
import Neovim.User.Choice

import System.Directory


-- | Helper function that calls the @input()@ function of neovim.
input :: NvimObject result
      => String -- ^ Message to display
      -> Maybe String -- ^ Input fiiled in
      -> Maybe String -- ^ Completion mode
      -> Neovim env result
input :: forall result env.
NvimObject result =>
String -> Maybe String -> Maybe String -> Neovim env result
input String
message Maybe String
mPrefilled Maybe String
mCompletion = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall o. NvimObject o => Object -> o
fromObjectUnsafe
  forall a b. (a -> b) -> a -> b
$ forall env. String -> [Object] -> Neovim env Object
vim_call_function String
"input" forall a b. (a -> b) -> a -> b
$ (String
message forall a. Semigroup a => a -> a -> a
<> String
" ")
    forall o. NvimObject o => o -> [Object] -> [Object]
+: forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. a -> a
id Maybe String
mPrefilled
    forall o. NvimObject o => o -> [Object] -> [Object]
+: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall o. NvimObject o => o -> [Object] -> [Object]
+: []) Maybe String
mCompletion


-- | Prompt the user to specify a directory.
--
-- If the directory does not exist, ask the usere whether it should be created.
askForDirectory :: String -- ^ Message to put in front
                -> Maybe FilePath -- ^ Prefilled text
                -> Neovim env FilePath
askForDirectory :: forall env. String -> Maybe String -> Neovim env String
askForDirectory String
message Maybe String
mPrefilled = do
    String
fp <- forall result env.
NvimObject result =>
String -> Maybe String -> Maybe String -> Neovim env result
input String
message Maybe String
mPrefilled (forall a. a -> Maybe a
Just String
"dir")

    String
efp <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall o. NvimObject o => Object -> o
fromObjectUnsafe forall a b. (a -> b) -> a -> b
$ forall env. String -> [Object] -> Neovim env Object
vim_call_function String
"expand" forall a b. (a -> b) -> a -> b
$ (String
fp :: FilePath) forall o. NvimObject o => o -> [Object] -> [Object]
+: []

    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Bool
doesDirectoryExist String
efp)) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall env. String -> Neovim env Bool
yesOrNo (String
efp forall a. [a] -> [a] -> [a]
++ String
" does not exist, create it?")) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
efp

    forall (m :: * -> *) a. Monad m => a -> m a
return String
efp


askForString :: String -- ^ message to put in front
             -> Maybe String -- ^ Prefilled text
             -> Neovim env String
askForString :: forall env. String -> Maybe String -> Neovim env String
askForString String
message Maybe String
mPrefilled = forall result env.
NvimObject result =>
String -> Maybe String -> Maybe String -> Neovim env result
input String
message Maybe String
mPrefilled forall a. Maybe a
Nothing