{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE QualifiedDo #-}

-- | Format descriptors specialised to the token type 'Char'. See also
-- "Text.Megaparsec.Char".
module Text.Pup.Class.Char
  ( -- * Numbers
    digit,
    digitChar,
    nat,

    -- * Individual characters
    char,
    anyChar,

    -- * Read and show
    read,
    readM,
  )
where

import Control.Monad.Indexed qualified as Indexed
import Control.Monad.Indexed.Cont2 qualified as Cont2
import Data.Char qualified as Char
import Text.Pup.Backend.Megaparsec
import Text.Read qualified as Read
import Prelude hiding (read)
import Prelude qualified

-- | Type constrainted version of 'single'
char :: (Tokens Char chunk m) => Char -> m r r Char
char :: forall chunk (m :: * -> * -> * -> *) r.
Tokens Char chunk m =>
Char -> m r r Char
char = Char -> m r r Char
forall r. Char -> m r r Char
forall tok chunk (m :: * -> * -> * -> *) r.
Tokens tok chunk m =>
tok -> m r r tok
single

-- | Type constrainted version of 'anyChar'
anyChar :: (Tokens Char chunk m) => m (Char -> r) r Char
anyChar :: forall chunk (m :: * -> * -> * -> *) r.
Tokens Char chunk m =>
m (Char -> r) r Char
anyChar = m (Char -> r) r Char
forall tok chunk (m :: * -> * -> * -> *) r.
Tokens tok chunk m =>
m (tok -> r) r tok
anySingle

-- | Decimal digit. To manipulate the raw 'Char' instead, use 'digitChar'.
digit :: (Cont2.Stacked m, Indexed.Monad m, Tokens Char chunk m) => m (Int -> r) r Int
digit :: forall (m :: * -> * -> * -> *) chunk r.
(Stacked m, Monad m, Tokens Char chunk m) =>
m (Int -> r) r Int
digit = Indexed.do
  (((Int -> r) -> Int -> r)
 -> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r))
-> m (Int -> r) (Int -> r) ()
forall r' r r''. ((r' -> r') -> r -> m r r'' r'') -> m r r' ()
forall (m :: * -> * -> * -> *) r' r r''.
Stacked m =>
((r' -> r') -> r -> m r r'' r'') -> m r r' ()
Cont2.shift_ ((((Int -> r) -> Int -> r)
  -> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r))
 -> m (Int -> r) (Int -> r) ())
-> (((Int -> r) -> Int -> r)
    -> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r))
-> m (Int -> r) (Int -> r) ()
forall a b. (a -> b) -> a -> b
$ \(Int -> r) -> Int -> r
k Int -> r
fl -> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r)
forall a i. a -> m i i a
forall {k} (f :: k -> k -> * -> *) a (i :: k).
Applicative f =>
a -> f i i a
Indexed.pure ((Int -> r) -> m (Int -> r) (Int -> r) (Int -> r))
-> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r)
forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 then (Int -> r) -> Int -> r
k Int -> r
fl Int
i else Int -> r
fl Int
i
  (((Char -> r) -> Char -> r)
 -> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r))
-> m (Int -> r) (Char -> r) ()
forall r' r r''. ((r' -> r') -> r -> m r r'' r'') -> m r r' ()
forall (m :: * -> * -> * -> *) r' r r''.
Stacked m =>
((r' -> r') -> r -> m r r'' r'') -> m r r' ()
Cont2.shift_ ((((Char -> r) -> Char -> r)
  -> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r))
 -> m (Int -> r) (Char -> r) ())
-> (((Char -> r) -> Char -> r)
    -> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r))
-> m (Int -> r) (Char -> r) ()
forall a b. (a -> b) -> a -> b
$ \(Char -> r) -> Char -> r
k Int -> r
fl -> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r)
forall a i. a -> m i i a
forall {k} (f :: k -> k -> * -> *) a (i :: k).
Applicative f =>
a -> f i i a
Indexed.pure ((Int -> r) -> m (Int -> r) (Int -> r) (Int -> r))
-> (Int -> r) -> m (Int -> r) (Int -> r) (Int -> r)
forall a b. (a -> b) -> a -> b
$ \Int
i -> (Char -> r) -> Char -> r
k (\Char
_ -> Int -> r
fl Int
i) (Int -> Char
Char.intToDigit Int
i)
  Char
c <- m (Char -> r) r Char
forall chunk (m :: * -> * -> * -> *) r.
Tokens Char chunk m =>
m (Char -> r) r Char
digitChar
  Int -> m r r Int
forall a i. a -> m i i a
forall {k} (f :: k -> k -> * -> *) a (i :: k).
Applicative f =>
a -> f i i a
Indexed.pure (Int -> m r r Int) -> Int -> m r r Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
Char.digitToInt Char
c

-- | A 'Char' standing for a decimal digit. You can return the digit at an 'Int'
-- with 'digit'.
digitChar :: (Tokens Char chunk m) => m (Char -> r) r Char
digitChar :: forall chunk (m :: * -> * -> * -> *) r.
Tokens Char chunk m =>
m (Char -> r) r Char
digitChar =
  (Char -> Bool) -> m (Char -> r) r Char
forall r. (Char -> Bool) -> m (Char -> r) r Char
forall tok chunk (m :: * -> * -> * -> *) r.
Tokens tok chunk m =>
(tok -> Bool) -> m (tok -> r) r tok
satisfy Char -> Bool
Char.isDigit m (Char -> r) r Char -> String -> m (Char -> r) r Char
forall chunk tok (m :: * -> * -> * -> *) r r' a.
Tokens chunk tok m =>
m r r' a -> String -> m r r' a
<?> String
"decimal digit"

-- | A (maximal) sequence of decimal digits interpreted as a natural number
nat :: (Cont2.Stacked m, Indexed.Alternative m, Tokens Char chunk m) => m (Int -> r) r Int
nat :: forall (m :: * -> * -> * -> *) chunk r.
(Stacked m, Alternative m, Tokens Char chunk m) =>
m (Int -> r) r Int
nat =
  m (Int -> r) (String -> r) (String -> Int)
forall (m :: * -> * -> * -> *) a r.
(Applicative m, Stacked m, Read a, Show a) =>
m (a -> r) (String -> r) (String -> a)
read m (Int -> r) (String -> r) (String -> Int)
-> m (String -> r) r String -> m (Int -> r) r Int
forall i j a b k1. m i j (a -> b) -> m j k1 a -> m i k1 b
forall {k} (f :: k -> k -> * -> *) (i :: k) (j :: k) a b (k1 :: k).
Applicative f =>
f i j (a -> b) -> f j k1 a -> f i k1 b
Indexed.<*> (forall r'. m (Char -> r') r' Char) -> m (String -> r) r String
forall (m :: * -> * -> * -> *) a b r.
(Alternative m, Stacked m) =>
(forall r'. m (a -> r') r' b) -> m ([a] -> r) r [b]
Cont2.some m (Char -> r') r' Char
forall r'. m (Char -> r') r' Char
forall chunk (m :: * -> * -> * -> *) r.
Tokens Char chunk m =>
m (Char -> r) r Char
digitChar

-- | A total lead based using 'Prelude.read' and 'show' for the respective directions.
-- It is the responsibility of the parser to ensure that the input is the domain
-- of 'Prelude.read' (the printer, on the other hand always succeeds). Otherwise
-- the 'read' descriptor will fail with 'error'.
--
-- For a format descriptor capable of failing with a parse error, see 'readM'.
read :: (Indexed.Applicative m, Cont2.Stacked m, Read a, Show a) => m (a -> r) (String -> r) (String -> a)
read :: forall (m :: * -> * -> * -> *) a r.
(Applicative m, Stacked m, Read a, Show a) =>
m (a -> r) (String -> r) (String -> a)
read = Indexed.do
  ((a -> r) -> (String -> r) -> a -> r)
-> ((a -> r) -> String -> r) -> m (a -> r) (String -> r) ()
forall (m :: * -> * -> * -> *) i j.
(Applicative m, Stacked m) =>
(i -> j -> i) -> (i -> j) -> m i j ()
Cont2.stack (\a -> r
_fl String -> r
k a
a -> String -> r
k (a -> String
forall a. Show a => a -> String
show a
a)) (\a -> r
k String
s -> a -> r
k (String -> a
forall a. Read a => String -> a
Prelude.read String
s))
  (String -> a) -> m (String -> r) (String -> r) (String -> a)
forall a i. a -> m i i a
forall {k} (f :: k -> k -> * -> *) a (i :: k).
Applicative f =>
a -> f i i a
Indexed.pure String -> a
forall a. Read a => String -> a
Prelude.read

-- | A format descriptor using 'Prelude.read' and 'show' for the respective
-- directions. If 'read' fails, then a parse error is reported (with the same
-- message as 'readEither'). In exchange 'readM', compared to 'read', must use a
-- monadic control flow.
readM :: (Indexed.MonadFail m, Cont2.Stacked m, Read a, Show a) => String -> m (a -> r) (String -> r) a
readM :: forall (m :: * -> * -> * -> *) a r.
(MonadFail m, Stacked m, Read a, Show a) =>
String -> m (a -> r) (String -> r) a
readM String
s = Indexed.do
  ((a -> r) -> (String -> r) -> a -> r)
-> ((a -> r) -> String -> r) -> m (a -> r) (String -> r) ()
forall (m :: * -> * -> * -> *) i j.
(Applicative m, Stacked m) =>
(i -> j -> i) -> (i -> j) -> m i j ()
Cont2.stack (\a -> r
_fl String -> r
k a
a -> String -> r
k (a -> String
forall a. Show a => a -> String
show a
a)) (\a -> r
k String
s' -> a -> r
k (String -> a
forall a. Read a => String -> a
Prelude.read String
s'))
  case String -> Either String a
forall a. Read a => String -> Either String a
Read.readEither String
s of
    Right a
a -> a -> m (String -> r) (String -> r) a
forall a i. a -> m i i a
forall {k} (f :: k -> k -> * -> *) a (i :: k).
Applicative f =>
a -> f i i a
Indexed.pure a
a
    Left String
err -> String -> m (String -> r) (String -> r) a
forall i j a. String -> m i j a
forall {k} {k1} {k2} (m :: k -> k1 -> k2 -> *) (i :: k) (j :: k1)
       (a :: k2).
Fail m =>
String -> m i j a
Indexed.fail String
err