{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.JCC.Lib.Parsec where

import           Control.Monad (Monad(..))
import           Data.Char (Char)
import qualified Data.Char as Char
import qualified Data.Foldable as Foldable
import           Data.Function (($), (.))
import           Data.String (String)
import           Prelude (Integer, Integral(..), Num(..), seq)
import           Text.Parsec (Stream, ParsecT, (<|>))
import qualified Text.Parsec as R

-- * Useful combinators

-- | Like 'R.choice' but with 'R.try' on each case.
choice_try :: Stream s m t => [ParsecT s u m a] -> ParsecT s u m a
choice_try = Foldable.foldr ((<|>) . R.try) R.parserZero
-- choice_try = R.choice . fmap R.try

-- | Like 'R.sepBy' but without parsing an ending separator.
many_separated
 :: Stream s m t
 => ParsecT s u m a
 -> ParsecT s u m b
 -> ParsecT s u m [a]
many_separated p sep =
	R.option [] $ do
		x <- R.try p
		xs <- R.many (R.try (sep >> p))
		return $ x:xs

-- | Like 'R.sepBy1' but without parsing an ending separator.
many1_separated
 :: Stream s m t
 => ParsecT s u m a
 -> ParsecT s u m b
 -> ParsecT s u m [a]
many1_separated p sep = do
	x <- p
	xs <- R.many (R.try (sep >> p))
	return $ x:xs
-- (:) <$> p <*> R.many (R.try (sep >> p))

-- | Make a 'R.ParsecT' also return its user state.
and_state
 :: Stream s m t
 => ParsecT s u m a
 -> ParsecT s u m (a, u)
and_state p = do
	a <- p
	s <- R.getState
	return (a, s)

-- * Numbers

-- | Return the 'Integer' obtained by multiplying the given digits
--   with the power of the given base respective to their rank.
integer_of_digits
 :: Integer -- ^ Base.
 -> String  -- ^ Digits (MUST be recognised by 'Char.digitToInt').
 -> Integer
integer_of_digits base =
	Foldable.foldl' (\x d ->
		base*x + toInteger (Char.digitToInt d)) 0

decimal :: Stream s m Char => ParsecT s u m Integer
decimal = integer 10 R.digit
hexadecimal :: Stream s m Char => ParsecT s u m Integer
hexadecimal = R.oneOf "xX" >> integer 16 R.hexDigit
octal :: Stream s m Char => ParsecT s u m Integer
octal = R.oneOf "oO" >> integer 8 R.octDigit

-- | Parse an 'Integer'.
integer :: Stream s m t
        => Integer
        -> ParsecT s u m Char
        -> ParsecT s u m Integer
integer base digit = do
	digits <- R.many1 digit
	let n = integer_of_digits base digits
	seq n (return n)