{-# LANGUAGE QuasiQuotes #-}

module Ghcitui.Ghcid.ParseTabCompletions (ParseError (..), parseCompletionsWithHeader) where

import Control.Error (readMay)
import Data.Array ((!))
import Data.String.Interpolate (i)
import qualified Data.Text as T
import Text.Regex.TDFA (MatchResult (..), (=~~))

import Ghcitui.Ghcid.ParseError (ParseError (..)) -- Re-export.

{- | Parse a completion result which begins with a header.

    Example input:
    [ "4 4 \"hello \""
    , "\"world\""
    , "\"wyvern\""
    , "\"withers\""
    , "\"wonderbolts\""]

    See https://downloads.haskell.org/ghc/latest/docs/users_guide/ghci.html#ghci-cmd-:complete
-}
parseCompletionsWithHeader
    :: [T.Text]
    -- ^ Full :complete output to parse.
    -> Either ParseError (T.Text, [T.Text])
    -- ^ Failure message (Left) or Completion possibilities (Right)
parseCompletionsWithHeader :: [Text] -> Either ParseError (Text, [Text])
parseCompletionsWithHeader (Text
headerLine : [Text]
rest) = do
    Text
sharedPrefix <- Either ParseError Text
eSharedPrefix
    [Text]
completions <- [Text] -> Either ParseError [Text]
parseCompletions [Text]
rest
    (Text, [Text]) -> Either ParseError (Text, [Text])
forall a. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
sharedPrefix, [Text]
completions)
  where
    eSharedPrefix :: Either ParseError Text
eSharedPrefix = case (Text
headerLine Text -> Text -> Maybe (MatchResult Text)
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ Text
reg :: Maybe (MatchResult T.Text)) of
        Just MatchResult Text
match -> Text -> Either ParseError Text
forall a b. b -> Either a b
Right (MatchResult Text -> Array Int Text
forall a. MatchResult a -> Array Int a
mrSubs MatchResult Text
match Array Int Text -> Int -> Text
forall i e. Ix i => Array i e -> i -> e
! Int
1)
        Maybe (MatchResult Text)
Nothing -> ParseError -> Either ParseError Text
forall a b. a -> Either a b
Left (ParseError -> Either ParseError Text)
-> ParseError -> Either ParseError Text
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
ParseError [i|Failed to parse ':complete' header line: '#{headerLine}'|]
    reg :: Text
reg = Text
".* \"(.*)\"$" :: T.Text
parseCompletionsWithHeader [Text]
_ = ParseError -> Either ParseError (Text, [Text])
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (Text, [Text]))
-> ParseError -> Either ParseError (Text, [Text])
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
ParseError Text
"Failed to parse completions with no header line"

parseCompletions
    :: [T.Text]
    -- ^ Completion lines.
    -> Either ParseError [T.Text]
    -- ^ Completion possibilities.
parseCompletions :: [Text] -> Either ParseError [Text]
parseCompletions = (Text -> Either ParseError Text)
-> [Text] -> Either ParseError [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Either ParseError Text
mapper
  where
    mapper :: Text -> Either ParseError Text
mapper Text
x =
        Either ParseError Text
-> (String -> Either ParseError Text)
-> Maybe String
-> Either ParseError Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (ParseError -> Either ParseError Text
forall a b. a -> Either a b
Left (ParseError -> Either ParseError Text)
-> ParseError -> Either ParseError Text
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
ParseError [i|Failed to parse ':completion' entry '#{x}'|])
            (Text -> Either ParseError Text
forall a b. b -> Either a b
Right (Text -> Either ParseError Text)
-> (String -> Text) -> String -> Either ParseError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
            (String -> Maybe String
forall a. Read a => String -> Maybe a
readMay (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe String) -> Text -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text
x)