-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Generic parsing utils.
module Util.Parse where
import qualified Control.Monad.Identity as Identity
import qualified Control.Monad.State.Strict as State
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Data.Void as Void

import qualified Numeric
import qualified Text.Megaparsec as P
import           Text.Megaparsec ((<?>))
import qualified Text.Megaparsec.Char as P

import qualified Util.Exceptions as Exceptions

import           Global

-- * parsec

type Parser a = ParserT Identity.Identity a
type ParserT m a = P.ParsecT Void.Void Text m a
type ParserS s a = ParserT (State.StateT s Identity.Identity) a

parse :: Parser a -> Text -> Either Text a
parse :: forall a. Parser a -> Text -> Either Text a
parse Parser a
p = forall a. Identity a -> a
Identity.runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
FilePath -> ParserT m a -> Text -> m (Either Text a)
parseM FilePath
"" Parser a
p

parseM :: Monad m => FilePath -> ParserT m a -> Text -> m (Either Text a)
parseM :: forall (m :: * -> *) a.
Monad m =>
FilePath -> ParserT m a -> Text -> m (Either Text a)
parseM FilePath
fname ParserT m a
p =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> Text
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
P.errorBundlePretty)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> FilePath -> s -> m (Either (ParseErrorBundle s e) a)
P.runParserT (ParserT m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof) FilePath
fname

parseS :: state -> FilePath -> ParserS state a -> Text -> Either Text a
parseS :: forall state a.
state -> FilePath -> ParserS state a -> Text -> Either Text a
parseS state
state FilePath
fname ParserS state a
p = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
State.runState state
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
FilePath -> ParserT m a -> Text -> m (Either Text a)
parseM FilePath
fname ParserS state a
p

parse_maybe :: Parser a -> Text -> Maybe a
parse_maybe :: forall a. Parser a -> Text -> Maybe a
parse_maybe Parser a
p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either Text a
parse Parser a
p

-- | Try to parse a file, or return a default value if the file doesn't exist.
file :: a -> ParserS st a -> st -> FilePath -> IO (Either Text a)
file :: forall a st.
a -> ParserS st a -> st -> FilePath -> IO (Either Text a)
file a
deflt ParserS st a
parser st
state FilePath
fname = do
    Maybe Text
mb_text <- forall a. IO a -> IO (Maybe a)
Exceptions.ignoreEnoent (FilePath -> IO Text
Text.IO.readFile FilePath
fname)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right a
deflt) (forall state a.
state -> FilePath -> ParserS state a -> Text -> Either Text a
parseS st
state FilePath
fname ParserS st a
parser) Maybe Text
mb_text

-- -- | Format a ParseError assuming the input is just one line.
-- format1 :: Text -> P.ParseError -> Text
-- format1 input err
--     | line == 1 = "col " <> showt col <> ": " <> msg
--     | otherwise = showt line <> ":" <> showt col <> ": " <> msg
--     where
--     msg = Text.intercalate "; " (show_error err) <> ": " <> showt input
--     pos = P.errorPos err
--     (line, col) = (P.sourceLine pos, P.sourceColumn pos)
--
-- show_error :: P.ParseError -> [Text]
-- show_error = filter (not . Text.null) . Text.lines . txt
--     . Error.showErrorMessages "or" "unknown parse error"
--         "expecting" "unexpected" "end of input"
--     . Error.errorMessages

p_int :: ParserT m Int
p_int :: forall (m :: * -> *). ParserT m Int
p_int = do
    Int
sign <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Int
1 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1))
    (forall a. Num a => a -> a -> a
*Int
sign) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). ParserT m Int
p_nat
    forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"int"

-- | Natural number including 0.
p_nat :: ParserT m Int
p_nat :: forall (m :: * -> *). ParserT m Int
p_nat = do
    Text
i <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P forall a. Maybe a
Nothing Char -> Bool
is_digit
    case forall a. (Eq a, Num a) => ReadS a
Numeric.readDec (Text -> FilePath
untxt Text
i) of
        (Int
n, FilePath
_) : [(Int, FilePath)]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
        [(Int, FilePath)]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero -- this should never happen
    forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"nat"

-- | Natural number without 0.
p_positive :: ParserT m Int
p_positive :: forall (m :: * -> *). ParserT m Int
p_positive = do
    Int
n <- forall (m :: * -> *). ParserT m Int
p_nat
    if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then forall (m :: * -> *) a. MonadPlus m => m a
mzero else forall (m :: * -> *) a. Monad m => a -> m a
return Int
n

p_float :: ParserT m Double
p_float :: forall (m :: * -> *). ParserT m Double
p_float = do
    Double
sign <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Double
1 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Double
1))
    Double
val <- forall (m :: * -> *). ParserT m Double
p_unsigned_float
    forall (m :: * -> *) a. Monad m => a -> m a
return (Double
val forall a. Num a => a -> a -> a
* Double
sign)
    forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"float"

p_unsigned_float :: ParserT m Double
p_unsigned_float :: forall (m :: * -> *). ParserT m Double
p_unsigned_float = do
    Text
i <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP forall a. Maybe a
Nothing Char -> Bool
is_digit
    Text
f <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Text
"" (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P forall a. Maybe a
Nothing Char -> Bool
is_digit)
    if Text -> Bool
Text.null Text
i Bool -> Bool -> Bool
&& Text -> Bool
Text.null Text
f then forall (m :: * -> *) a. MonadPlus m => m a
mzero else do
    case (Text -> Maybe Int
dec Text
i, Text -> Maybe Int
dec Text
f) of
        (Just Int
i', Just Int
f') -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i'
            forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f' forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Text -> Int
Text.length Text
f)
        (Maybe Int, Maybe Int)
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
    forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"unsigned float"
    where
    dec :: Text -> Maybe Int
    dec :: Text -> Maybe Int
dec Text
s
        | Text -> Bool
Text.null Text
s = forall a. a -> Maybe a
Just Int
0
        | Bool
otherwise = case forall a. (Eq a, Num a) => ReadS a
Numeric.readDec (Text -> FilePath
untxt Text
s) of
            (Int
d, FilePath
"") : [(Int, FilePath)]
_ -> forall a. a -> Maybe a
Just Int
d
            [(Int, FilePath)]
_ -> forall a. Maybe a
Nothing

is_digit :: Char -> Bool
is_digit :: Char -> Bool
is_digit Char
c = Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'