--
-- HTTP client for use with io-streams
--
-- Copyright © 2012-2018 Operational Dynamics Consulting, Pty Ltd
--
-- The code in this file, and the program it is a part of, is
-- made available to you by its authors as open source software:
-- you can redistribute it and/or modify it under the terms of
-- the BSD licence.
--
-- This file is essentially a clone of Snap.Internal.Parsing,
-- the HTTP request parser implementation in the Snap Framework;
-- snap-core's src/Snap/Internal/Parsing.hs and snap-server's
-- src/Snap/Internal/Http/Parser.hs, copied here to specialize
-- it to Response parsing. This code replaces the attoparsec
-- based implementation formerly in ResponseParser, but is
-- kept separate to aid syncing changes from snap-core as they
-- become available.
--

{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MagicHash          #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE Rank2Types         #-}
{-# LANGUAGE UnboxedTuples      #-}
{-# OPTIONS_HADDOCK hide, not-home #-}

module Network.Http.Utilities (
    readResponseLine,
    readHeaderFields
) where

------------------------------------------------------------------------------
import Control.Exception (throwIO)
import Control.Monad (when)
import Data.Bits
import qualified Data.ByteString.Char8 as S
import Data.ByteString.Internal (ByteString, w2c)
import qualified Data.ByteString.Unsafe as S
import Data.Char hiding (digitToInt, isDigit, isSpace)
import GHC.Exts (Int (..), Int#, (+#))
import Prelude hiding (head, take, takeWhile)
import System.IO.Streams (InputStream)
import qualified System.IO.Streams as Streams
----------------------------------------------------------------------------

import Network.Http.Types

------------------------------------------------------------------------------

{-
    This is vestigial; originally it was the Request parsing
    code in Snap. Keeping it here until we can use if for
    response parsing.
-}
parseRequest :: InputStream ByteString -> IO (Maybe Request)
parseRequest :: InputStream ByteString -> IO (Maybe Request)
parseRequest InputStream ByteString
input = do
    Bool
eof <- InputStream ByteString -> IO Bool
forall a. InputStream a -> IO Bool
Streams.atEOF InputStream ByteString
input
    if Bool
eof
      then Maybe Request -> IO (Maybe Request)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Request
forall a. Maybe a
Nothing
      else do
        ByteString
line <- InputStream ByteString -> IO ByteString
readResponseLine InputStream ByteString
input
        let (!ByteString
mStr,!ByteString
s)      = ByteString -> (ByteString, ByteString)
bSp ByteString
line
        let (!ByteString
uri, !ByteString
vStr)   = ByteString -> (ByteString, ByteString)
bSp ByteString
s
        let !version :: (Int, Int)
version        = ByteString -> (Int, Int)
forall {a} {b}.
(Enum a, Enum b, Num a, Num b, Bits a, Bits b) =>
ByteString -> (a, b)
pVer ByteString
vStr :: (Int,Int)

--      hdrs    <- readHeaderFields input
        Maybe Request -> IO (Maybe Request)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Request -> IO (Maybe Request))
-> Maybe Request -> IO (Maybe Request)
forall a b. (a -> b) -> a -> b
$! Maybe Request
forall a. Maybe a
Nothing

  where

    pVer :: ByteString -> (a, b)
pVer ByteString
s = if ByteString
"HTTP/" ByteString -> ByteString -> Bool
`S.isPrefixOf` ByteString
s
               then ByteString -> (a, b)
forall {a} {b}.
(Enum a, Enum b, Num a, Num b, Bits a, Bits b) =>
ByteString -> (a, b)
pVers (Int -> ByteString -> ByteString
S.unsafeDrop Int
5 ByteString
s)
               else (a
1, b
0)

    bSp :: ByteString -> (ByteString, ByteString)
bSp   = Char -> ByteString -> (ByteString, ByteString)
splitCh Char
' '

    pVers :: ByteString -> (a, b)
pVers ByteString
s = (a
c, b
d)
      where
        (!ByteString
a, !ByteString
b)   = Char -> ByteString -> (ByteString, ByteString)
splitCh Char
'.' ByteString
s
        !c :: a
c         = ByteString -> a
forall a. (Enum a, Num a, Bits a) => ByteString -> a
unsafeFromNat ByteString
a
        !d :: b
d         = ByteString -> b
forall a. (Enum a, Num a, Bits a) => ByteString -> a
unsafeFromNat ByteString
b


{-
    Read a single line of an HTTP response.
-}
readResponseLine :: InputStream ByteString -> IO ByteString
readResponseLine :: InputStream ByteString -> IO ByteString
readResponseLine InputStream ByteString
input = [ByteString] -> IO ByteString
go []
  where
    throwNoCRLF :: IO a
throwNoCRLF =
        HttpParseException -> IO a
forall e a. Exception e => e -> IO a
throwIO (HttpParseException -> IO a) -> HttpParseException -> IO a
forall a b. (a -> b) -> a -> b
$
        String -> HttpParseException
HttpParseException String
"parse error: expected line ending in crlf"

    throwBadCRLF :: IO a
throwBadCRLF =
        HttpParseException -> IO a
forall e a. Exception e => e -> IO a
throwIO (HttpParseException -> IO a) -> HttpParseException -> IO a
forall a b. (a -> b) -> a -> b
$
        String -> HttpParseException
HttpParseException String
"parse error: got cr without subsequent lf"

    go :: [ByteString] -> IO ByteString
go ![ByteString]
l = do
        !Maybe ByteString
mb <- InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
input
        !ByteString
s  <- IO ByteString
-> (ByteString -> IO ByteString)
-> Maybe ByteString
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ByteString
forall {a}. IO a
throwNoCRLF ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
mb

        case ByteString -> CS
findCRLF ByteString
s of
            FoundCRLF Int#
idx# -> [ByteString] -> ByteString -> Int# -> IO ByteString
foundCRLF [ByteString]
l ByteString
s Int#
idx#
            CS
NoCR           -> [ByteString] -> ByteString -> IO ByteString
noCRLF [ByteString]
l ByteString
s
            LastIsCR Int#
idx#  -> [ByteString] -> ByteString -> Int# -> IO ByteString
lastIsCR [ByteString]
l ByteString
s Int#
idx#
            CS
_              -> IO ByteString
forall {a}. IO a
throwBadCRLF

    foundCRLF :: [ByteString] -> ByteString -> Int# -> IO ByteString
foundCRLF [ByteString]
l ByteString
s Int#
idx# = do
        let !i1 :: Int
i1 = (Int# -> Int
I# Int#
idx#)
        let !i2 :: Int
i2 = (Int# -> Int
I# (Int#
idx# Int# -> Int# -> Int#
+# Int#
2#))
        let !a :: ByteString
a = Int -> ByteString -> ByteString
S.unsafeTake Int
i1 ByteString
s
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
S.length ByteString
s) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            let !b :: ByteString
b = Int -> ByteString -> ByteString
S.unsafeDrop Int
i2 ByteString
s
            ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
Streams.unRead ByteString
b InputStream ByteString
input

        -- Optimize for the common case: dl is almost always "id"
        let !out :: ByteString
out = if [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
l then ByteString
a else [ByteString] -> ByteString
S.concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString
aByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
l))
        ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
out

    noCRLF :: [ByteString] -> ByteString -> IO ByteString
noCRLF [ByteString]
l ByteString
s = [ByteString] -> IO ByteString
go (ByteString
sByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
l)

    lastIsCR :: [ByteString] -> ByteString -> Int# -> IO ByteString
lastIsCR [ByteString]
l ByteString
s Int#
idx# = do
        !ByteString
t <- InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
input IO (Maybe ByteString)
-> (Maybe ByteString -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO ByteString
-> (ByteString -> IO ByteString)
-> Maybe ByteString
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ByteString
forall {a}. IO a
throwNoCRLF ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        if ByteString -> Bool
S.null ByteString
t
          then [ByteString] -> ByteString -> Int# -> IO ByteString
lastIsCR [ByteString]
l ByteString
s Int#
idx#
          else do
            let !c :: Word8
c = ByteString -> Word8
S.unsafeHead ByteString
t
            if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
10
              then IO ByteString
forall {a}. IO a
throwBadCRLF
              else do
                  let !a :: ByteString
a = Int -> ByteString -> ByteString
S.unsafeTake (Int# -> Int
I# Int#
idx#) ByteString
s
                  let !b :: ByteString
b = Int -> ByteString -> ByteString
S.unsafeDrop Int
1 ByteString
t
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
b) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
Streams.unRead ByteString
b InputStream ByteString
input
                  let !out :: ByteString
out = if [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
l then ByteString
a else [ByteString] -> ByteString
S.concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString
aByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
l))
                  ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
out


------------------------------------------------------------------------------
data CS = FoundCRLF !Int#
        | NoCR
        | LastIsCR !Int#
        | BadCR


------------------------------------------------------------------------------
findCRLF :: ByteString -> CS
findCRLF :: ByteString -> CS
findCRLF ByteString
b =
    case Char -> ByteString -> Maybe Int
S.elemIndex Char
'\r' ByteString
b of
      Maybe Int
Nothing         -> CS
NoCR
      Just !i :: Int
i@(I# Int#
i#) ->
          let !i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          in if Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
S.length ByteString
b
               then if ByteString -> Int -> Word8
S.unsafeIndex ByteString
b Int
i' Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10
                      then Int# -> CS
FoundCRLF Int#
i#
                      else CS
BadCR
               else Int# -> CS
LastIsCR Int#
i#
{-# INLINE findCRLF #-}


------------------------------------------------------------------------------
splitCh :: Char -> ByteString -> (ByteString, ByteString)
splitCh :: Char -> ByteString -> (ByteString, ByteString)
splitCh !Char
c !ByteString
s = (ByteString, ByteString)
-> (Int -> (ByteString, ByteString))
-> Maybe Int
-> (ByteString, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString
s, ByteString
S.empty) Int -> (ByteString, ByteString)
f (Char -> ByteString -> Maybe Int
S.elemIndex Char
c ByteString
s)
  where
    f :: Int -> (ByteString, ByteString)
f !Int
i = let !a :: ByteString
a = Int -> ByteString -> ByteString
S.unsafeTake Int
i ByteString
s
               !b :: ByteString
b = Int -> ByteString -> ByteString
S.unsafeDrop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
s
           in (ByteString
a, ByteString
b)
{-# INLINE splitCh #-}


------------------------------------------------------------------------------
breakCh :: Char -> ByteString -> (ByteString, ByteString)
breakCh :: Char -> ByteString -> (ByteString, ByteString)
breakCh !Char
c !ByteString
s = (ByteString, ByteString)
-> (Int -> (ByteString, ByteString))
-> Maybe Int
-> (ByteString, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString
s, ByteString
S.empty) Int -> (ByteString, ByteString)
f (Char -> ByteString -> Maybe Int
S.elemIndex Char
c ByteString
s)
  where
    f :: Int -> (ByteString, ByteString)
f !Int
i = let !a :: ByteString
a = Int -> ByteString -> ByteString
S.unsafeTake Int
i ByteString
s
               !b :: ByteString
b = Int -> ByteString -> ByteString
S.unsafeDrop Int
i ByteString
s
           in (ByteString
a, ByteString
b)
{-# INLINE breakCh #-}


------------------------------------------------------------------------------
splitHeader :: ByteString -> (ByteString, ByteString)
splitHeader :: ByteString -> (ByteString, ByteString)
splitHeader !ByteString
s = (ByteString, ByteString)
-> (Int -> (ByteString, ByteString))
-> Maybe Int
-> (ByteString, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString
s, ByteString
S.empty) Int -> (ByteString, ByteString)
f (Char -> ByteString -> Maybe Int
S.elemIndex Char
':' ByteString
s)
  where
    l :: Int
l = ByteString -> Int
S.length ByteString
s

    f :: Int -> (ByteString, ByteString)
f Int
i = let !a :: ByteString
a = Int -> ByteString -> ByteString
S.unsafeTake Int
i ByteString
s
          in (ByteString
a, Int -> ByteString
skipSp (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

    skipSp :: Int -> ByteString
skipSp !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l    = ByteString
S.empty
              | Bool
otherwise = let c :: Word8
c = ByteString -> Int -> Word8
S.unsafeIndex ByteString
s Int
i
                            in if Char -> Bool
isLWS (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
w2c Word8
c
                                 then Int -> ByteString
skipSp (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                                 else Int -> ByteString -> ByteString
S.unsafeDrop Int
i ByteString
s

{-# INLINE splitHeader #-}



------------------------------------------------------------------------------
isLWS :: Char -> Bool
isLWS :: Char -> Bool
isLWS Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'
{-# INLINE isLWS #-}


------------------------------------------------------------------------------

{-
    Read the remainder of the response message's header section,
    parsing into key/value pairs. Note that this function terminates
    when it hits the "blank" line (ie, CRLF CRLF pair), which it
    consumes.
-}
readHeaderFields :: InputStream ByteString -> IO [(ByteString,ByteString)]
readHeaderFields :: InputStream ByteString -> IO [(ByteString, ByteString)]
readHeaderFields InputStream ByteString
input = do
    [(ByteString, ByteString)] -> [(ByteString, ByteString)]
f <- ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> IO ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
forall {c}.
([(ByteString, ByteString)] -> c)
-> IO ([(ByteString, ByteString)] -> c)
go [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> a
id
    [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ByteString, ByteString)] -> IO [(ByteString, ByteString)])
-> [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$! [(ByteString, ByteString)] -> [(ByteString, ByteString)]
f []

  where
    go :: ([(ByteString, ByteString)] -> c)
-> IO ([(ByteString, ByteString)] -> c)
go ![(ByteString, ByteString)] -> c
dlistSoFar = do
        ByteString
line <- InputStream ByteString -> IO ByteString
readResponseLine InputStream ByteString
input
        if ByteString -> Bool
S.null ByteString
line
          then ([(ByteString, ByteString)] -> c)
-> IO ([(ByteString, ByteString)] -> c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(ByteString, ByteString)] -> c
dlistSoFar
          else do
            let (!ByteString
k,!ByteString
v) = ByteString -> (ByteString, ByteString)
splitHeader ByteString
line
            [ByteString] -> [ByteString]
vf <- ([ByteString] -> [ByteString]) -> IO ([ByteString] -> [ByteString])
forall {c}. ([ByteString] -> c) -> IO ([ByteString] -> c)
pCont [ByteString] -> [ByteString]
forall a. a -> a
id
            let vs :: [ByteString]
vs = [ByteString] -> [ByteString]
vf []
            let !v' :: ByteString
v' = if [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
vs then ByteString
v else [ByteString] -> ByteString
S.concat (ByteString
vByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
vs)
            let !t :: (ByteString, ByteString)
t = (ByteString
k,ByteString
v')
            ([(ByteString, ByteString)] -> c)
-> IO ([(ByteString, ByteString)] -> c)
go ([(ByteString, ByteString)] -> c
dlistSoFar ([(ByteString, ByteString)] -> c)
-> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString)
t(ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
:))

      where
        trimBegin :: ByteString -> ByteString
trimBegin = (Char -> Bool) -> ByteString -> ByteString
S.dropWhile Char -> Bool
isLWS

        pCont :: ([ByteString] -> c) -> IO ([ByteString] -> c)
pCont ![ByteString] -> c
dlist = do
            Maybe ByteString
mbS  <- InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
Streams.peek InputStream ByteString
input
            IO ([ByteString] -> c)
-> (ByteString -> IO ([ByteString] -> c))
-> Maybe ByteString
-> IO ([ByteString] -> c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([ByteString] -> c) -> IO ([ByteString] -> c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString] -> c
dlist)
                  (\ByteString
s -> if ByteString -> Bool
S.null ByteString
s
                           then InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
input IO (Maybe ByteString)
-> IO ([ByteString] -> c) -> IO ([ByteString] -> c)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([ByteString] -> c) -> IO ([ByteString] -> c)
pCont [ByteString] -> c
dlist
                           else if Char -> Bool
isLWS (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
w2c (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ ByteString -> Word8
S.unsafeHead ByteString
s
                                  then ([ByteString] -> c) -> IO ([ByteString] -> c)
procCont [ByteString] -> c
dlist
                                  else ([ByteString] -> c) -> IO ([ByteString] -> c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString] -> c
dlist)
                  Maybe ByteString
mbS

        procCont :: ([ByteString] -> c) -> IO ([ByteString] -> c)
procCont ![ByteString] -> c
dlist = do
            ByteString
line <- InputStream ByteString -> IO ByteString
readResponseLine InputStream ByteString
input
            let !t :: ByteString
t = ByteString -> ByteString
trimBegin ByteString
line
            ([ByteString] -> c) -> IO ([ByteString] -> c)
pCont ([ByteString] -> c
dlist ([ByteString] -> c)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
" "ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
tByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))



                            -----------------------
                            -- utility functions --
                            -----------------------


------------------------------------------------------------------------------
-- | Note: only works for nonnegative naturals
unsafeFromNat :: (Enum a, Num a, Bits a) => ByteString -> a
unsafeFromNat :: forall a. (Enum a, Num a, Bits a) => ByteString -> a
unsafeFromNat = (a -> Char -> a) -> a -> ByteString -> a
forall a. (a -> Char -> a) -> a -> ByteString -> a
S.foldl' a -> Char -> a
forall {a}. (Num a, Enum a) => a -> Char -> a
f a
0
  where
    zero :: Int
zero = Char -> Int
ord Char
'0'
    f :: a -> Char -> a
f !a
cnt !Char
i = a
cnt a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a. Enum a => Int -> a
toEnum (Char -> Int
digitToInt Char
i)

    digitToInt :: Char -> Int
digitToInt Char
c = if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
                     then Int
d
                     else String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"bad digit: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
      where
        !d :: Int
d = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
zero
{-# INLINE unsafeFromNat #-}