-- |
-- Module      : Data.Text.Internal.Read
-- Copyright   : (c) 2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Common internal functions for reading textual data.
module Data.Text.Internal.Read
    (
      IReader
    , IParser(..)
    , T(..)
    , digitToInt
    , hexDigitToInt
    , perhaps
    ) where

import Control.Applicative as App (Applicative(..))
import Control.Arrow (first)
import Control.Monad (ap)
import Data.Char (ord)

type IReader t a = t -> Either String (a,t)

newtype IParser t a = P {
      forall t a. IParser t a -> IReader t a
runP :: IReader t a
    }

instance Functor (IParser t) where
    fmap :: forall a b. (a -> b) -> IParser t a -> IParser t b
fmap a -> b
f IParser t a
m = IReader t b -> IParser t b
forall t a. IReader t a -> IParser t a
P (IReader t b -> IParser t b) -> IReader t b -> IParser t b
forall a b. (a -> b) -> a -> b
$ ((a, t) -> (b, t)) -> Either String (a, t) -> Either String (b, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, t) -> (b, t)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f) (Either String (a, t) -> Either String (b, t))
-> (t -> Either String (a, t)) -> IReader t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IParser t a -> t -> Either String (a, t)
forall t a. IParser t a -> IReader t a
runP IParser t a
m

instance Applicative (IParser t) where
    pure :: forall a. a -> IParser t a
pure a
a = IReader t a -> IParser t a
forall t a. IReader t a -> IParser t a
P (IReader t a -> IParser t a) -> IReader t a -> IParser t a
forall a b. (a -> b) -> a -> b
$ \t
t -> (a, t) -> Either String (a, t)
forall a b. b -> Either a b
Right (a
a,t
t)
    {-# INLINE pure #-}
    <*> :: forall a b. IParser t (a -> b) -> IParser t a -> IParser t b
(<*>) = IParser t (a -> b) -> IParser t a -> IParser t b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (IParser t) where
    return :: forall a. a -> IParser t a
return = a -> IParser t a
forall (f :: * -> *) a. Applicative f => a -> f a
App.pure
    IParser t a
m >>= :: forall a b. IParser t a -> (a -> IParser t b) -> IParser t b
>>= a -> IParser t b
k  = IReader t b -> IParser t b
forall t a. IReader t a -> IParser t a
P (IReader t b -> IParser t b) -> IReader t b -> IParser t b
forall a b. (a -> b) -> a -> b
$ \t
t -> case IParser t a -> IReader t a
forall t a. IParser t a -> IReader t a
runP IParser t a
m t
t of
                           Left String
err     -> String -> Either String (b, t)
forall a b. a -> Either a b
Left String
err
                           Right (a
a,t
t') -> IParser t b -> IReader t b
forall t a. IParser t a -> IReader t a
runP (a -> IParser t b
k a
a) t
t'
    {-# INLINE (>>=) #-}

-- If we ever need a `MonadFail` instance the definition below can be used
--
-- > instance MonadFail (IParser t) where
-- >   fail msg = P $ \_ -> Left msg
--
-- But given the code compiles fine with a post-MFP GHC 8.6+ we don't need
-- one just yet.

data T = T !Integer !Int

perhaps :: a -> IParser t a -> IParser t a
perhaps :: forall a t. a -> IParser t a -> IParser t a
perhaps a
def IParser t a
m = IReader t a -> IParser t a
forall t a. IReader t a -> IParser t a
P (IReader t a -> IParser t a) -> IReader t a -> IParser t a
forall a b. (a -> b) -> a -> b
$ \t
t -> case IParser t a -> IReader t a
forall t a. IParser t a -> IReader t a
runP IParser t a
m t
t of
                            Left String
_      -> (a, t) -> Either String (a, t)
forall a b. b -> Either a b
Right (a
def,t
t)
                            r :: Either String (a, t)
r@(Right (a, t)
_) -> Either String (a, t)
r

hexDigitToInt :: Char -> Int
hexDigitToInt :: Char -> Int
hexDigitToInt Char
c
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f' = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
    | Bool
otherwise            = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)

digitToInt :: Char -> Int
digitToInt :: Char -> Int
digitToInt Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'