{-# OPTIONS_HADDOCK hide #-}

-- |
--
-- Copyright:
--   This file is part of the package byline. It is subject to the
--   license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/byline
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the
--   terms contained in the LICENSE file.
--
-- License: BSD-2-Clause
module Byline.Internal.Completion
  ( CompletionFunc,
    Completion (..),
    runCompletionFunction,
    runCompletionFunctions,
  )
where

import qualified Data.Text as Text
import qualified System.Console.Haskeline.Completion as Haskeline

-- | A completion function modeled after the one used in Haskeline.
--
-- /Warning:/ If you're familiar with the Haskeline version of the
-- @CompletionFunc@ type please be sure to read this description
-- carefully since the two behave differently.
--
-- The completion function is called when the user presses the tab
-- key.  The current input line is split into two parts based on where
-- the cursor is positioned.  Text to the left of the cursor will be
-- the first value in the tuple and text to the right of the cursor
-- will be the second value.
--
-- The text returned from the completion function is the text from the
-- left of the cursor which wasn't used in the completion.  It should
-- also produce a list of possible 'Completion' values.
--
-- In Haskeline, some of these text values are reversed.  This is
-- /not/ the case in Byline.
--
-- /A note about @IO@:/
--
-- Due to Haskeline, the completion function is forced to return an
-- @IO@ value.  It would be better if it could return a value in the
-- base monad instead but it doesn't look like that's possible.
-- Patches welcome.
--
-- @since 1.0.0.0
type CompletionFunc m = (Text, Text) -> m (Text, [Completion])

-- | A type representing a completion match to the user's input.
--
-- @since 1.0.0.0
data Completion = Completion
  { -- | Text to insert to the right of the cursor.
    Completion -> Text
replacement :: Text,
    -- | Text to display when listing all completions.
    Completion -> Text
display :: Text,
    -- | Whether to follow the completed word with a
    --  terminating space or close existing quotes.
    Completion -> Bool
isFinished :: Bool
  }
  deriving (Completion -> Completion -> Bool
(Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool) -> Eq Completion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Completion -> Completion -> Bool
$c/= :: Completion -> Completion -> Bool
== :: Completion -> Completion -> Bool
$c== :: Completion -> Completion -> Bool
Eq, Eq Completion
Eq Completion
-> (Completion -> Completion -> Ordering)
-> (Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool)
-> (Completion -> Completion -> Completion)
-> (Completion -> Completion -> Completion)
-> Ord Completion
Completion -> Completion -> Bool
Completion -> Completion -> Ordering
Completion -> Completion -> Completion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Completion -> Completion -> Completion
$cmin :: Completion -> Completion -> Completion
max :: Completion -> Completion -> Completion
$cmax :: Completion -> Completion -> Completion
>= :: Completion -> Completion -> Bool
$c>= :: Completion -> Completion -> Bool
> :: Completion -> Completion -> Bool
$c> :: Completion -> Completion -> Bool
<= :: Completion -> Completion -> Bool
$c<= :: Completion -> Completion -> Bool
< :: Completion -> Completion -> Bool
$c< :: Completion -> Completion -> Bool
compare :: Completion -> Completion -> Ordering
$ccompare :: Completion -> Completion -> Ordering
$cp1Ord :: Eq Completion
Ord, Int -> Completion -> ShowS
[Completion] -> ShowS
Completion -> String
(Int -> Completion -> ShowS)
-> (Completion -> String)
-> ([Completion] -> ShowS)
-> Show Completion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Completion] -> ShowS
$cshowList :: [Completion] -> ShowS
show :: Completion -> String
$cshow :: Completion -> String
showsPrec :: Int -> Completion -> ShowS
$cshowsPrec :: Int -> Completion -> ShowS
Show)

-- | Convert a Byline completion result into a Haskeline completion result.
--
-- @since 1.0.0.0
convertCompletion :: Completion -> Haskeline.Completion
convertCompletion :: Completion -> Completion
convertCompletion (Completion Text
r Text
d Bool
i) =
  Completion :: String -> String -> Bool -> Completion
Haskeline.Completion
    { replacement :: String
Haskeline.replacement = Text -> String
forall a. ToString a => a -> String
toString Text
r,
      display :: String
Haskeline.display = Text -> String
forall a. ToString a => a -> String
toString Text
d,
      isFinished :: Bool
Haskeline.isFinished = Bool
i
    }

-- | Adapt a completion function so it works with Haskeline.
--
-- @since 1.0.0.0
runCompletionFunction ::
  Monad m =>
  CompletionFunc m ->
  Haskeline.CompletionFunc m
runCompletionFunction :: CompletionFunc m -> CompletionFunc m
runCompletionFunction CompletionFunc m
comp (String
left, String
right) = do
  (Text
output, [Completion]
completions) <-
    CompletionFunc m
comp
      ( Text -> Text
Text.reverse (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
left,
        String -> Text
forall a. ToText a => a -> Text
toText String
right
      )
  (String, [Completion]) -> m (String, [Completion])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.reverse Text
output,
      (Completion -> Completion) -> [Completion] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map Completion -> Completion
convertCompletion [Completion]
completions
    )

-- | Run a list of completion functions, returning the results of the
-- first function that produced any.
--
-- @since 1.0.0.0
runCompletionFunctions ::
  forall m.
  Monad m =>
  [CompletionFunc m] ->
  Haskeline.CompletionFunc m
runCompletionFunctions :: [CompletionFunc m] -> CompletionFunc m
runCompletionFunctions [CompletionFunc m]
fs (String, String)
input =
  ((String, [Completion])
 -> CompletionFunc m -> m (String, [Completion]))
-> (String, [Completion])
-> [CompletionFunc m]
-> m (String, [Completion])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (String, [Completion])
-> CompletionFunc m -> m (String, [Completion])
go (String
forall a. Monoid a => a
mempty, [Completion]
forall a. Monoid a => a
mempty) [CompletionFunc m]
fs
  where
    go ::
      (String, [Haskeline.Completion]) ->
      CompletionFunc m ->
      m (String, [Haskeline.Completion])
    go :: (String, [Completion])
-> CompletionFunc m -> m (String, [Completion])
go (String, [Completion])
prev CompletionFunc m
f = case (String, [Completion])
prev of
      (String
_, []) -> CompletionFunc m -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
CompletionFunc m -> CompletionFunc m
runCompletionFunction CompletionFunc m
f (String, String)
input
      (String, [Completion])
_ -> (String, [Completion]) -> m (String, [Completion])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String, [Completion])
prev