-- |
--
-- 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.Completion
  ( -- * A Note About Completion
    -- $use

    -- * Completion Function
    CompletionFunc,
    Completion (..),

    -- * Completion Helpers
    CompLoc (..),
    completionFromList,

    -- * Setting the Active Completion Function
    pushCompletionFunction,
    popCompletionFunction,
  )
where

import Byline.Internal.Completion
import Byline.Internal.Eval (MonadByline (..))
import qualified Byline.Internal.Prim as Prim
import Data.Char (isSpace)
import qualified Data.Text as Text

-- | Add a 'CompletionFunc' to the stack.
--
-- @since 1.0.0.0
pushCompletionFunction :: MonadByline m => CompletionFunc IO -> m ()
pushCompletionFunction :: CompletionFunc IO -> m ()
pushCompletionFunction = CompletionFunc IO -> FT PrimF Identity ()
forall (m :: * -> *).
MonadFree PrimF m =>
CompletionFunc IO -> m ()
Prim.pushCompFunc (CompletionFunc IO -> FT PrimF Identity ())
-> (FT PrimF Identity () -> m ()) -> CompletionFunc IO -> m ()
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FT PrimF Identity () -> m ()
forall (m :: * -> *) a. MonadByline m => F PrimF a -> m a
liftByline

-- | Remove the top completion function from the stack.
--
-- @since 1.0.0.0
popCompletionFunction :: MonadByline m => m ()
popCompletionFunction :: m ()
popCompletionFunction = FT PrimF Identity () -> m ()
forall (m :: * -> *) a. MonadByline m => F PrimF a -> m a
liftByline FT PrimF Identity ()
forall (m :: * -> *). MonadFree PrimF m => m ()
Prim.popCompFunc

-- | Type to describe where completions are allowed.
--
-- @since 1.1.0.0
data CompLoc
  = -- | Only complete the first word of input.
    CompHead
  | -- | Complete any word except the first.
    CompTail
  | -- | Perform completion anywhere in the input.
    CompAny

-- | Generate a completion function that uses the given list as the
-- completion candidates.
--
-- @since 1.1.0.0
completionFromList ::
  forall m.
  Applicative m =>
  -- | Where to allow completion.
  CompLoc ->
  -- | List of completion candidates.
  [Text] ->
  -- | The generated completion function.
  CompletionFunc m
completionFromList :: CompLoc -> [Text] -> CompletionFunc m
completionFromList CompLoc
loc [Text]
ts (Text
left, Text
right) =
  case CompLoc
loc of
    CompLoc
CompHead ->
      if Text -> Bool
Text.null Text
left Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
Text.all (Char -> Bool
isSpace (Char -> Bool) -> (Bool -> Bool) -> Char -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Bool -> Bool
not) Text
left
        then CompletionFunc m
go (Text
left, Text
right)
        else (Text, [Completion]) -> m (Text, [Completion])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
forall a. Monoid a => a
mempty, [Completion]
forall a. Monoid a => a
mempty)
    CompLoc
CompTail ->
      if (Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
isSpace Text
left
        then CompletionFunc m
completeLastWord (Text
left, Text
right)
        else (Text, [Completion]) -> m (Text, [Completion])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
forall a. Monoid a => a
mempty, [Completion]
forall a. Monoid a => a
mempty)
    CompLoc
CompAny ->
      CompletionFunc m
completeLastWord (Text
left, Text
right)
  where
    go :: CompletionFunc m
    go :: CompletionFunc m
go (Text
left, Text
_) =
      if Text -> Bool
Text.null Text
left
        then (Text, [Completion]) -> m (Text, [Completion])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"", [Text] -> [Completion]
completions [Text]
ts)
        else (Text, [Completion]) -> m (Text, [Completion])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"", [Text] -> [Completion]
completions ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
Text.isPrefixOf Text
left) [Text]
ts))
    completeLastWord :: CompletionFunc m
    completeLastWord :: CompletionFunc m
completeLastWord (Text
left, Text
right) =
      let word :: Text
word = (Char -> Bool) -> Text -> Text
Text.takeWhileEnd (Char -> Bool
isSpace (Char -> Bool) -> (Bool -> Bool) -> Char -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Bool -> Bool
not) Text
left
          prefix :: Text
prefix = Int -> Text -> Text
Text.dropEnd (Text -> Int
Text.length Text
word) Text
left
       in CompletionFunc m
go (Text
word, Text
right) m (Text, [Completion])
-> ((Text, [Completion]) -> (Text, [Completion]))
-> m (Text, [Completion])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text) -> (Text, [Completion]) -> (Text, [Completion])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text -> Text
forall a b. a -> b -> a
const Text
prefix)
    completions :: [Text] -> [Completion]
    completions :: [Text] -> [Completion]
completions = (Text -> Completion) -> [Text] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
t -> Text -> Text -> Bool -> Completion
Completion Text
t Text
t Bool
True)

-- $use
--
-- Haskeline makes it very difficult (if not impossible) to implement
-- a completion function that runs in an arbitrary monad.  More
-- information can be found in the documentation for 'CompletionFunc'.