{-# OPTIONS_GHC -Wwarn #-}

-- | GHC language options parser
module Ide.Plugin.Eval.Parse.Option (
    langOptions,
    parseSetFlags,
) where

import           Control.Arrow        (left)
import           Data.Void            (Void)
import           Text.Megaparsec
import           Text.Megaparsec.Char

{- |
>>> langOptions ":set   -XBinaryLiterals  -XOverloadedStrings "
Right ["BinaryLiterals","OverloadedStrings"]

>>> langOptions ":set"
Right []

>>> langOptions ""
Left "No match"
-}
langOptions :: String -> Either String [String]
langOptions :: String -> Either String [String]
langOptions =
  (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) [String]
-> Either String [String]
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty
  (Either (ParseErrorBundle String Void) [String]
 -> Either String [String])
-> (String -> Either (ParseErrorBundle String Void) [String])
-> String
-> Either String [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void String [String]
-> String
-> String
-> Either (ParseErrorBundle String Void) [String]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void String Identity ()
-> Parsec Void String [String] -> Parsec Void String [String]
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void String [String]
languageOpts Parsec Void String [String]
-> ParsecT Void String Identity () -> Parsec Void String [String]
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
""

parseSetFlags :: String -> Maybe String
parseSetFlags :: String -> Maybe String
parseSetFlags = Parsec Void String String -> String -> Maybe String
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe
    (ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void String Identity ()
-> ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (Tokens String)
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk String
Tokens String
":set"
        ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 ParsecT Void String Identity ()
-> Parsec Void String String -> Parsec Void String String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void String String
ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest
        :: Parsec Void String String
    )

-- >>> parseMaybe languageOpts ":set -XBinaryLiterals -XOverloadedStrings"
-- Just ["BinaryLiterals","OverloadedStrings"]
languageOpts :: Parsec Void String [String]
languageOpts :: Parsec Void String [String]
languageOpts = Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
":set" ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
  ParsecT Void String Identity ()
-> Parsec Void String [String] -> Parsec Void String [String]
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void String String -> Parsec Void String [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"-X" ParsecT Void String Identity (Tokens String)
-> Parsec Void String String -> Parsec Void String String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity Char -> Parsec Void String String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar Parsec Void String String
-> ParsecT Void String Identity () -> Parsec Void String String
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)