{-|
Lower-level parsers, which avoid overriding the native Attoparsec names.
-}
module Attoparsec.Data.Parsers where

import Attoparsec.Data.Prelude hiding (bool)
import Data.Attoparsec.Text
import qualified GHC.Show
import qualified Data.Text as Text

{-|
Parse the output of the 'show' function applied to 'String' or 'Text'
into what was used for its input.
-}
show :: Parser Text
show :: Parser Text
show =
  Char -> Parser Char
char Char
'"' Parser Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
body Parser Text -> Parser Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'"'
  where
    body :: Parser Text
body =
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text
chunk
      where
        chunk :: Parser Text
chunk =
          Parser Text
escaped Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
nonEscaped
        nonEscaped :: Parser Text
nonEscaped =
          (Char -> Bool) -> Parser Text
takeWhile1 (\ Char
a -> Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"')
        escaped :: Parser Text
escaped =
          Char -> Text
Text.singleton (Char -> Text) -> Parser Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
escapedChar

-- https://hackage.haskell.org/package/base-4.14.0.0/docs/src/GHC.Show.html#showLitChar
escapedChar :: Parser Char
escapedChar :: Parser Char
escapedChar =
  Char -> Parser Char
char Char
'\\' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
escapedCharBody

escapedCharBody :: Parser Char
escapedCharBody :: Parser Char
escapedCharBody =
  Char -> Parser Char
char Char
'\\' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser Char
char Char
'a' Parser Char -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\a' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser Char
char Char
'b' Parser Char -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\b' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser Char
char Char
'f' Parser Char -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\f' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser Char
char Char
'n' Parser Char -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser Char
char Char
'r' Parser Char -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\r' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser Char
char Char
't' Parser Char -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\t' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser Char
char Char
'v' Parser Char -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\v' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Text -> Parser Text
string Text
"DEL" Parser Text -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\DEL' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Char
ordEscapedCharBody Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser Char
asciiTabEscapedCharBody

asciiTabEscapedCharBody :: Parser Char
asciiTabEscapedCharBody :: Parser Char
asciiTabEscapedCharBody =
  (Int -> String -> Parser Char)
-> [Int] -> [String] -> [Parser Char]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> String -> Parser Char
asciiTabChar [Int
0..] [String]
GHC.Show.asciiTab [Parser Char] -> ([Parser Char] -> Parser Char) -> Parser Char
forall a b. a -> (a -> b) -> b
& [Parser Char] -> Parser Char
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
  where
    asciiTabChar :: Int -> String -> Parser Char
asciiTabChar Int
index String
chars =
      Text -> Parser Text
string (String -> Text
forall a. IsString a => String -> a
fromString String
chars) Parser Text -> Char -> Parser Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> Char
chr Int
index

ordEscapedCharBody :: Parser Char
ordEscapedCharBody :: Parser Char
ordEscapedCharBody =
  Int -> Char
chr (Int -> Char) -> Parser Text Int -> Parser Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
forall a. Integral a => Parser a
decimal