-- | Erlang term parser and pretty printer.
module B9.Artifact.Content.ErlTerms
  ( parseErlTerm,
    erlTermParser,
    renderErlTerm,
    SimpleErlangTerm (..),
    arbitraryErlSimpleAtom,
    arbitraryErlString,
    arbitraryErlNumber,
    arbitraryErlNatural,
    arbitraryErlFloat,
    arbitraryErlNameChar,
  )
where

import B9.QCUtil
import B9.Text
import Control.Monad
import Control.Parallel.Strategies
import Data.Binary
import Data.Data
import Data.Function
import Data.Hashable
import GHC.Generics (Generic)
import Test.QuickCheck
import Text.Parsec
  ( (<|>),
    alphaNum,
    anyChar,
    between,
    char,
    choice,
    digit,
    hexDigit,
    lower,
    many,
    many1,
    noneOf,
    octDigit,
    option,
    parse,
    spaces,
    string,
    try,
  )
import Text.Parsec.Text
import qualified Text.PrettyPrint as PP
import Text.Printf
import Text.Show.Pretty

-- | Simplified Erlang term representation.
data SimpleErlangTerm
  = ErlString String
  | ErlFloat Double
  | ErlNatural Integer
  | ErlAtom String
  | ErlChar Char
  | ErlBinary String
  | ErlList [SimpleErlangTerm]
  | ErlTuple [SimpleErlangTerm]
  deriving (SimpleErlangTerm -> SimpleErlangTerm -> Bool
(SimpleErlangTerm -> SimpleErlangTerm -> Bool)
-> (SimpleErlangTerm -> SimpleErlangTerm -> Bool)
-> Eq SimpleErlangTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
$c/= :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
== :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
$c== :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
Eq, Eq SimpleErlangTerm
Eq SimpleErlangTerm
-> (SimpleErlangTerm -> SimpleErlangTerm -> Ordering)
-> (SimpleErlangTerm -> SimpleErlangTerm -> Bool)
-> (SimpleErlangTerm -> SimpleErlangTerm -> Bool)
-> (SimpleErlangTerm -> SimpleErlangTerm -> Bool)
-> (SimpleErlangTerm -> SimpleErlangTerm -> Bool)
-> (SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm)
-> (SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm)
-> Ord SimpleErlangTerm
SimpleErlangTerm -> SimpleErlangTerm -> Bool
SimpleErlangTerm -> SimpleErlangTerm -> Ordering
SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
$cmin :: SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
max :: SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
$cmax :: SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
>= :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
$c>= :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
> :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
$c> :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
<= :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
$c<= :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
< :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
$c< :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
compare :: SimpleErlangTerm -> SimpleErlangTerm -> Ordering
$ccompare :: SimpleErlangTerm -> SimpleErlangTerm -> Ordering
$cp1Ord :: Eq SimpleErlangTerm
Ord, ReadPrec [SimpleErlangTerm]
ReadPrec SimpleErlangTerm
Int -> ReadS SimpleErlangTerm
ReadS [SimpleErlangTerm]
(Int -> ReadS SimpleErlangTerm)
-> ReadS [SimpleErlangTerm]
-> ReadPrec SimpleErlangTerm
-> ReadPrec [SimpleErlangTerm]
-> Read SimpleErlangTerm
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SimpleErlangTerm]
$creadListPrec :: ReadPrec [SimpleErlangTerm]
readPrec :: ReadPrec SimpleErlangTerm
$creadPrec :: ReadPrec SimpleErlangTerm
readList :: ReadS [SimpleErlangTerm]
$creadList :: ReadS [SimpleErlangTerm]
readsPrec :: Int -> ReadS SimpleErlangTerm
$creadsPrec :: Int -> ReadS SimpleErlangTerm
Read, Int -> SimpleErlangTerm -> ShowS
[SimpleErlangTerm] -> ShowS
SimpleErlangTerm -> String
(Int -> SimpleErlangTerm -> ShowS)
-> (SimpleErlangTerm -> String)
-> ([SimpleErlangTerm] -> ShowS)
-> Show SimpleErlangTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleErlangTerm] -> ShowS
$cshowList :: [SimpleErlangTerm] -> ShowS
show :: SimpleErlangTerm -> String
$cshow :: SimpleErlangTerm -> String
showsPrec :: Int -> SimpleErlangTerm -> ShowS
$cshowsPrec :: Int -> SimpleErlangTerm -> ShowS
Show, Typeable SimpleErlangTerm
DataType
Constr
Typeable SimpleErlangTerm
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SimpleErlangTerm -> c SimpleErlangTerm)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SimpleErlangTerm)
-> (SimpleErlangTerm -> Constr)
-> (SimpleErlangTerm -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SimpleErlangTerm))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SimpleErlangTerm))
-> ((forall b. Data b => b -> b)
    -> SimpleErlangTerm -> SimpleErlangTerm)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SimpleErlangTerm -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SimpleErlangTerm -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SimpleErlangTerm -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SimpleErlangTerm -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SimpleErlangTerm -> m SimpleErlangTerm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SimpleErlangTerm -> m SimpleErlangTerm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SimpleErlangTerm -> m SimpleErlangTerm)
-> Data SimpleErlangTerm
SimpleErlangTerm -> DataType
SimpleErlangTerm -> Constr
(forall b. Data b => b -> b)
-> SimpleErlangTerm -> SimpleErlangTerm
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleErlangTerm -> c SimpleErlangTerm
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleErlangTerm
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SimpleErlangTerm -> u
forall u. (forall d. Data d => d -> u) -> SimpleErlangTerm -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleErlangTerm -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleErlangTerm -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SimpleErlangTerm -> m SimpleErlangTerm
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleErlangTerm -> m SimpleErlangTerm
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleErlangTerm
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleErlangTerm -> c SimpleErlangTerm
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleErlangTerm)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleErlangTerm)
$cErlTuple :: Constr
$cErlList :: Constr
$cErlBinary :: Constr
$cErlChar :: Constr
$cErlAtom :: Constr
$cErlNatural :: Constr
$cErlFloat :: Constr
$cErlString :: Constr
$tSimpleErlangTerm :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SimpleErlangTerm -> m SimpleErlangTerm
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleErlangTerm -> m SimpleErlangTerm
gmapMp :: (forall d. Data d => d -> m d)
-> SimpleErlangTerm -> m SimpleErlangTerm
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleErlangTerm -> m SimpleErlangTerm
gmapM :: (forall d. Data d => d -> m d)
-> SimpleErlangTerm -> m SimpleErlangTerm
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SimpleErlangTerm -> m SimpleErlangTerm
gmapQi :: Int -> (forall d. Data d => d -> u) -> SimpleErlangTerm -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SimpleErlangTerm -> u
gmapQ :: (forall d. Data d => d -> u) -> SimpleErlangTerm -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SimpleErlangTerm -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleErlangTerm -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleErlangTerm -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleErlangTerm -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleErlangTerm -> r
gmapT :: (forall b. Data b => b -> b)
-> SimpleErlangTerm -> SimpleErlangTerm
$cgmapT :: (forall b. Data b => b -> b)
-> SimpleErlangTerm -> SimpleErlangTerm
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleErlangTerm)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleErlangTerm)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SimpleErlangTerm)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleErlangTerm)
dataTypeOf :: SimpleErlangTerm -> DataType
$cdataTypeOf :: SimpleErlangTerm -> DataType
toConstr :: SimpleErlangTerm -> Constr
$ctoConstr :: SimpleErlangTerm -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleErlangTerm
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleErlangTerm
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleErlangTerm -> c SimpleErlangTerm
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleErlangTerm -> c SimpleErlangTerm
$cp1Data :: Typeable SimpleErlangTerm
Data, Typeable, (forall x. SimpleErlangTerm -> Rep SimpleErlangTerm x)
-> (forall x. Rep SimpleErlangTerm x -> SimpleErlangTerm)
-> Generic SimpleErlangTerm
forall x. Rep SimpleErlangTerm x -> SimpleErlangTerm
forall x. SimpleErlangTerm -> Rep SimpleErlangTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleErlangTerm x -> SimpleErlangTerm
$cfrom :: forall x. SimpleErlangTerm -> Rep SimpleErlangTerm x
Generic)

instance Hashable SimpleErlangTerm

instance Binary SimpleErlangTerm

instance NFData SimpleErlangTerm

-- | Parse a subset of valid Erlang terms. It parses no maps and binaries are
-- restricted to either empty binaries or binaries with a string. The input
-- encoding must be restricted to ascii compatible 8-bit characters
-- (e.g. latin-1 or UTF8).
parseErlTerm :: String -> Text -> Either String SimpleErlangTerm
parseErlTerm :: String -> Text -> Either String SimpleErlangTerm
parseErlTerm String
src Text
content =
  (ParseError -> Either String SimpleErlangTerm)
-> (SimpleErlangTerm -> Either String SimpleErlangTerm)
-> Either ParseError SimpleErlangTerm
-> Either String SimpleErlangTerm
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String SimpleErlangTerm
forall a b. a -> Either a b
Left (String -> Either String SimpleErlangTerm)
-> (ParseError -> String)
-> ParseError
-> Either String SimpleErlangTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
ppShow) SimpleErlangTerm -> Either String SimpleErlangTerm
forall a b. b -> Either a b
Right (Parsec Text () SimpleErlangTerm
-> String -> Text -> Either ParseError SimpleErlangTerm
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () SimpleErlangTerm
erlTermParser String
src Text
content)

-- | Convert an abstract Erlang term to a pretty byte string preserving the
-- encoding.
renderErlTerm :: SimpleErlangTerm -> Text
renderErlTerm :: SimpleErlangTerm -> Text
renderErlTerm SimpleErlangTerm
s =
  String -> Text
forall a. (Textual a, HasCallStack) => a -> Text
unsafeRenderToText (Doc -> String
PP.render (SimpleErlangTerm -> Doc
prettyPrintErlTerm SimpleErlangTerm
s Doc -> Doc -> Doc
PP.<> Char -> Doc
PP.char Char
'.'))

prettyPrintErlTerm :: SimpleErlangTerm -> PP.Doc
prettyPrintErlTerm :: SimpleErlangTerm -> Doc
prettyPrintErlTerm (ErlString String
str) =
  Doc -> Doc
PP.doubleQuotes (String -> Doc
PP.text (ShowS
toErlStringString String
str))
prettyPrintErlTerm (ErlNatural Integer
n) = Integer -> Doc
PP.integer Integer
n
prettyPrintErlTerm (ErlFloat Double
f) = Double -> Doc
PP.double Double
f
prettyPrintErlTerm (ErlChar Char
c) = String -> Doc
PP.text (String
"$" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
toErlAtomChar Char
c)
prettyPrintErlTerm (ErlAtom String
a) = String -> Doc
PP.text String
quotedAtom
  where
    quotedAtom :: String
quotedAtom = case ShowS
toErlAtomString String
a of
      String
"" -> String
"''"
      a' :: String
a'@(Char
firstChar : String
rest)
        | Char
firstChar
            Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'a' .. Char
'z']
            Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
atomCharsThatDontNeedQuoting) String
rest ->
          String
a'
      String
a' -> String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
    atomCharsThatDontNeedQuoting :: String
atomCharsThatDontNeedQuoting =
      [Char
'a' .. Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@_"
prettyPrintErlTerm (ErlBinary []) = String -> Doc
PP.text String
"<<>>"
prettyPrintErlTerm (ErlBinary String
b) =
  String -> Doc
PP.text (String
"<<\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
toErlStringString String
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\">>")
prettyPrintErlTerm (ErlList [SimpleErlangTerm]
xs) =
  Doc -> Doc
PP.brackets ([Doc] -> Doc
PP.sep (Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma (SimpleErlangTerm -> Doc
prettyPrintErlTerm (SimpleErlangTerm -> Doc) -> [SimpleErlangTerm] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SimpleErlangTerm]
xs)))
prettyPrintErlTerm (ErlTuple [SimpleErlangTerm]
xs) =
  Doc -> Doc
PP.braces ([Doc] -> Doc
PP.sep (Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma (SimpleErlangTerm -> Doc
prettyPrintErlTerm (SimpleErlangTerm -> Doc) -> [SimpleErlangTerm] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SimpleErlangTerm]
xs)))

toErlStringString :: String -> String
toErlStringString :: ShowS
toErlStringString = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
toErlStringChar

toErlStringChar :: Char -> String
toErlStringChar :: Char -> String
toErlStringChar = ([String]
table [String] -> Int -> String
forall a. [a] -> Int -> a
!!) (Int -> String) -> (Char -> Int) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum
  where
    table :: [String]
table =
      [String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\x{%x}" Int
c | Int
c <- [Int
0 .. (Int
31 :: Int)]]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
32 .. Int
33])
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"\\\""]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
35 .. Int
91])
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"\\\\"]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
93 .. Int
126])
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\x{%x}" Int
c | Int
c <- [(Int
127 :: Int) ..]]

toErlAtomString :: String -> String
toErlAtomString :: ShowS
toErlAtomString = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
toErlAtomChar

toErlAtomChar :: Char -> String
toErlAtomChar :: Char -> String
toErlAtomChar = ([String]
table [String] -> Int -> String
forall a. [a] -> Int -> a
!!) (Int -> String) -> (Char -> Int) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum
  where
    table :: [String]
table =
      [String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\x{%x}" Int
c | Int
c <- [Int
0 .. (Int
31 :: Int)]]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
32 .. Int
38])
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"\\'"]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
40 .. Int
91])
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"\\\\"]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
93 .. Int
126])
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\x{%x}" Int
c | Int
c <- [(Int
127 :: Int) ..]]

instance Arbitrary SimpleErlangTerm where
  arbitrary :: Gen SimpleErlangTerm
arbitrary =
    [Gen SimpleErlangTerm] -> Gen SimpleErlangTerm
forall a. [Gen a] -> Gen a
oneof
      [ (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlString,
        (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlNatural,
        (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlFloat,
        (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlChar,
        (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlAtomUnquoted,
        (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlAtomQuoted,
        (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlBinary,
        (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlList,
        (Int -> Gen SimpleErlangTerm) -> Gen SimpleErlangTerm
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen SimpleErlangTerm
aErlTuple
      ]
    where
      decrSize :: Int -> Gen a -> Gen a
decrSize Int
0 = Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize Int
0
      decrSize Int
n = Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      aErlString :: Int -> Gen SimpleErlangTerm
aErlString Int
n =
        String -> SimpleErlangTerm
ErlString (String -> SimpleErlangTerm) -> Gen String -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String -> Gen String
forall a. Int -> Gen a -> Gen a
decrSize Int
n (Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf ((Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
0, Int -> Char
forall a. Enum a => Int -> a
toEnum Int
255)))
      aErlFloat :: Int -> Gen SimpleErlangTerm
aErlFloat Int
n = do
        Float
f <- Int -> Gen Float -> Gen Float
forall a. Int -> Gen a -> Gen a
decrSize Int
n Gen Float
forall a. Arbitrary a => Gen a
arbitrary :: Gen Float
        let d :: Double
d = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Float -> Rational
forall a. Real a => a -> Rational
toRational Float
f)
        SimpleErlangTerm -> Gen SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> SimpleErlangTerm
ErlFloat Double
d)
      aErlNatural :: Int -> Gen SimpleErlangTerm
aErlNatural Int
n = Integer -> SimpleErlangTerm
ErlNatural (Integer -> SimpleErlangTerm)
-> Gen Integer -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
decrSize Int
n Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
      aErlChar :: Int -> Gen SimpleErlangTerm
aErlChar Int
n = Char -> SimpleErlangTerm
ErlChar (Char -> SimpleErlangTerm) -> Gen Char -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen Char
forall a. Int -> Gen a -> Gen a
decrSize Int
n ((Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
0, Int -> Char
forall a. Enum a => Int -> a
toEnum Int
255))
      aErlAtomUnquoted :: Int -> Gen SimpleErlangTerm
aErlAtomUnquoted Int
n = do
        Char
f <- (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'z')
        String
rest <- Int -> Gen String -> Gen String
forall a. Int -> Gen a -> Gen a
decrSize Int
n Gen String
aErlNameString
        SimpleErlangTerm -> Gen SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SimpleErlangTerm
ErlAtom (Char
f Char -> ShowS
forall a. a -> [a] -> [a]
: String
rest))
      aErlAtomQuoted :: Int -> Gen SimpleErlangTerm
aErlAtomQuoted Int
n = do
        String
cs <- Int -> Gen String -> Gen String
forall a. Int -> Gen a -> Gen a
decrSize Int
n Gen String
aParsableErlString
        SimpleErlangTerm -> Gen SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SimpleErlangTerm
ErlAtom (String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"))
      aErlBinary :: Int -> Gen SimpleErlangTerm
aErlBinary Int
n =
        String -> SimpleErlangTerm
ErlBinary (String -> SimpleErlangTerm) -> Gen String -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String -> Gen String
forall a. Int -> Gen a -> Gen a
decrSize Int
n (Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf ((Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
0, Int -> Char
forall a. Enum a => Int -> a
toEnum Int
255)))
      aParsableErlString :: Gen String
aParsableErlString =
        [Gen String] -> Gen String
forall a. [Gen a] -> Gen a
oneof
          [ Gen String
aErlNameString,
            Gen String
aErlEscapedCharString,
            Gen String
aErlControlCharString,
            Gen String
aErlOctalCharString,
            Gen String
aErlHexCharString
          ]
      aErlNameString :: Gen String
aErlNameString =
        Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf (String -> Gen Char
forall a. [a] -> Gen a
elements ([Char
'a' .. Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@_"))
      aErlEscapedCharString :: Gen String
aErlEscapedCharString = [String] -> Gen String
forall a. [a] -> Gen a
elements ((String
"\\" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Char -> String) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
"0bdefnrstv\\\"\'")
      aErlControlCharString :: Gen String
aErlControlCharString =
        [String] -> Gen String
forall a. [a] -> Gen a
elements ((String
"\\^" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Char -> String) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char
'a' .. Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z']))
      aErlOctalCharString :: Gen String
aErlOctalCharString = do
        Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
3)
        [Int]
os <- Int -> Gen Int -> Gen [Int]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
7))
        String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (String
"\\" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Int]
os :: [Int]))))
      aErlHexCharString :: Gen String
aErlHexCharString = [Gen String] -> Gen String
forall a. [Gen a] -> Gen a
oneof [Gen String
twoDigitHex, Gen String
nDigitHex]
        where
          twoDigitHex :: Gen String
twoDigitHex = do
            Int
d1 <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
15) :: Gen Int
            Int
d2 <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
15) :: Gen Int
            String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\x%x%X" Int
d1 Int
d2)
          nDigitHex :: Gen String
nDigitHex = do
            String
zs <- Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf (String -> Gen Char
forall a. [a] -> Gen a
elements String
"0")
            Int
v <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
255) :: Gen Int
            String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\x{%s%x}" String
zs Int
v)
      aErlList :: Int -> Gen SimpleErlangTerm
aErlList Int
n = [SimpleErlangTerm] -> SimpleErlangTerm
ErlList ([SimpleErlangTerm] -> SimpleErlangTerm)
-> Gen [SimpleErlangTerm] -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [SimpleErlangTerm] -> Gen [SimpleErlangTerm]
forall a. Int -> Gen a -> Gen a
resize (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Gen SimpleErlangTerm -> Gen [SimpleErlangTerm]
forall a. Gen a -> Gen [a]
listOf Gen SimpleErlangTerm
forall a. Arbitrary a => Gen a
arbitrary)
      aErlTuple :: Int -> Gen SimpleErlangTerm
aErlTuple Int
n = [SimpleErlangTerm] -> SimpleErlangTerm
ErlTuple ([SimpleErlangTerm] -> SimpleErlangTerm)
-> Gen [SimpleErlangTerm] -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [SimpleErlangTerm] -> Gen [SimpleErlangTerm]
forall a. Int -> Gen a -> Gen a
resize (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Gen SimpleErlangTerm -> Gen [SimpleErlangTerm]
forall a. Gen a -> Gen [a]
listOf Gen SimpleErlangTerm
forall a. Arbitrary a => Gen a
arbitrary)

erlTermParser :: Parser SimpleErlangTerm
erlTermParser :: Parsec Text () SimpleErlangTerm
erlTermParser = ParsecT Text () Identity ()
-> ParsecT Text () Identity Char
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.') Parsec Text () SimpleErlangTerm
erlExpressionParser

erlExpressionParser :: Parser SimpleErlangTerm
erlExpressionParser :: Parsec Text () SimpleErlangTerm
erlExpressionParser =
  Parsec Text () SimpleErlangTerm
erlAtomParser
    Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () SimpleErlangTerm
erlCharParser
    Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () SimpleErlangTerm
erlStringParser
    Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () SimpleErlangTerm
erlBinaryParser
    Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () SimpleErlangTerm
erlListParser
    Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () SimpleErlangTerm
erlTupleParser
    Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () SimpleErlangTerm -> Parsec Text () SimpleErlangTerm
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () SimpleErlangTerm
erlFloatParser
    Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () SimpleErlangTerm
erlNaturalParser

erlAtomParser :: Parser SimpleErlangTerm
erlAtomParser :: Parsec Text () SimpleErlangTerm
erlAtomParser =
  String -> SimpleErlangTerm
ErlAtom
    (String -> SimpleErlangTerm)
-> ParsecT Text () Identity String
-> Parsec Text () SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ParsecT Text () Identity Char
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') (ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text () Identity Char
erlCharEscaped ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"'"))
            ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) (Char -> ShowS)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower ParsecT Text () Identity ShowS
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
erlNameChar)
        )

erlNameChar :: Parser Char
erlNameChar :: ParsecT Text () Identity Char
erlNameChar = ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'

erlCharParser :: Parser SimpleErlangTerm
erlCharParser :: Parsec Text () SimpleErlangTerm
erlCharParser = Char -> SimpleErlangTerm
ErlChar (Char -> SimpleErlangTerm)
-> ParsecT Text () Identity Char -> Parsec Text () SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsecT Text () Identity Char
erlCharEscaped ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar))

erlFloatParser :: Parser SimpleErlangTerm
erlFloatParser :: Parsec Text () SimpleErlangTerm
erlFloatParser = do
  -- Parse a float as string, then use read :: Double to 'parse' the floating
  -- point value. Calculating by hand is complicated because of precision
  -- issues.
  String
sign <- String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ((Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT Text () Identity Char
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"-") ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT Text () Identity Char
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""))
  String
s1 <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  String
s2 <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  String
e <-
    do
      Char
expSym <- [ParsecT Text () Identity Char] -> ParsecT Text () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e', Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'E']
      String
expSign <-
        String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option
          String
""
          ((Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT Text () Identity Char
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"-") ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT Text () Identity Char
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Text () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"+"))
      String
expAbs <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      String -> ParsecT Text () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char
expSym] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expSign String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expAbs)
      ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
  SimpleErlangTerm -> Parsec Text () SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> SimpleErlangTerm
ErlFloat (String -> Double
forall a. Read a => String -> a
read (String
sign String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)))

erlNaturalParser :: Parser SimpleErlangTerm
erlNaturalParser :: Parsec Text () SimpleErlangTerm
erlNaturalParser = do
  Integer
sign <- Parser Integer
signParser
  Integer
dec <- Parser Integer
decimalLiteral
  SimpleErlangTerm -> Parsec Text () SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleErlangTerm -> Parsec Text () SimpleErlangTerm)
-> SimpleErlangTerm -> Parsec Text () SimpleErlangTerm
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleErlangTerm
ErlNatural (Integer -> SimpleErlangTerm) -> Integer -> SimpleErlangTerm
forall a b. (a -> b) -> a -> b
$ Integer
sign Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
dec

signParser :: Parser Integer
signParser :: Parser Integer
signParser = (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT Text () Identity Char -> Parser Integer -> Parser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Parser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1)) Parser Integer -> Parser Integer -> Parser Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT Text () Identity Char -> Parser Integer -> Parser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Parser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1) Parser Integer -> Parser Integer -> Parser Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> Parser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1

decimalLiteral :: Parser Integer
decimalLiteral :: Parser Integer
decimalLiteral =
  (Int -> Parser Integer -> Parser Integer)
-> Parser Integer -> [Int] -> Parser Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    ( \Int
radix Parser Integer
acc ->
        ( ParsecT Text () Identity String -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Int -> String
forall a. Show a => a -> String
show Int
radix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"#")) ParsecT Text () Identity String -> Parser Integer -> Parser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => a -> t a -> a
calcBE (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
radix)
            ([Integer] -> Integer)
-> ParsecT Text () Identity [Integer] -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer -> ParsecT Text () Identity [Integer]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1
              (Int -> Parser Integer
erlDigits Int
radix)
        )
          Parser Integer -> Parser Integer -> Parser Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Integer
acc
    )
    (Integer -> [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => a -> t a -> a
calcBE Integer
10 ([Integer] -> Integer)
-> ParsecT Text () Identity [Integer] -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer -> ParsecT Text () Identity [Integer]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Int -> Parser Integer
erlDigits Int
10))
    [Int
2 .. Int
36]
  where
    calcBE :: a -> t a -> a
calcBE a
a = (a -> a -> a) -> a -> t a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
acc a
d -> a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ a
d) a
0
    erlDigits :: Int -> Parser Integer
erlDigits Int
k = [Parser Integer] -> Parser Integer
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (Int -> [Parser Integer] -> [Parser Integer]
forall a. Int -> [a] -> [a]
take Int
k [Parser Integer]
forall u. [ParsecT Text u Identity Integer]
digitParsers)
    digitParsers :: [ParsecT Text u Identity Integer]
digitParsers =
      -- create parsers that consume/match '0' .. '9' and "aA" .. "zZ" and return 0 .. 35
      ((String, Integer) -> ParsecT Text u Identity Integer)
-> [(String, Integer)] -> [ParsecT Text u Identity Integer]
forall a b. (a -> b) -> [a] -> [b]
map
        (\(String
cs, Integer
v) -> [ParsecT Text u Identity Char] -> ParsecT Text u Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> ParsecT Text u Identity Char)
-> String -> [ParsecT Text u Identity Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
cs) ParsecT Text u Identity Char
-> ParsecT Text u Identity Integer
-> ParsecT Text u Identity Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> ParsecT Text u Identity Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v)
        ( ( (Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'0' .. Char
'9'])
              [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> Char -> String) -> String -> String -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> (Char -> String) -> Char -> Char -> String
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [Char
'a' .. Char
'z'] [Char
'A' .. Char
'Z']
          )
            [String] -> [Integer] -> [(String, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Integer
0 ..]
        )

erlStringParser :: Parser SimpleErlangTerm
erlStringParser :: Parsec Text () SimpleErlangTerm
erlStringParser = do
  Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
  String
str <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text () Identity Char
erlCharEscaped ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"")
  Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
  SimpleErlangTerm -> Parsec Text () SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SimpleErlangTerm
ErlString String
str)

erlCharEscaped :: Parser Char
erlCharEscaped :: ParsecT Text () Identity Char
erlCharEscaped =
  Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
    ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( do
           Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^'
           [ParsecT Text () Identity Char] -> ParsecT Text () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ((Char -> Char -> ParsecT Text () Identity Char)
-> String -> String -> [ParsecT Text () Identity Char]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) b u.
Stream s m Char =>
Char -> b -> ParsecT s u m b
escapedChar String
ccodes String
creplacements)
           ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
             Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'x'
             do
               [Int]
ds <-
                 ParsecT Text () Identity Char
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [Int]
-> ParsecT Text () Identity [Int]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between
                   (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{')
                   (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
                   ((Char -> Int) -> String -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Int
hexVal (String -> [Int])
-> ParsecT Text () Identity String
-> ParsecT Text () Identity [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit)
               let val :: Int
val = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc Int
v -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v) Int
0 [Int]
ds
               Char -> ParsecT Text () Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
val)
               ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
                 Int
x1 <- Char -> Int
hexVal (Char -> Int)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
                 Int
x2 <- Char -> Int
hexVal (Char -> Int)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
                 Char -> ParsecT Text () Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
forall a. Enum a => Int -> a
toEnum ((Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2))
           ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
             Int
o1 <- Char -> Int
octVal (Char -> Int)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit
             do
               Int
o2 <- Char -> Int
octVal (Char -> Int)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit
               do
                 Int
o3 <- Char -> Int
octVal (Char -> Int)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit
                 Char -> ParsecT Text () Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
forall a. Enum a => Int -> a
toEnum ((((Int
o1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o3))
                 ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
forall a. Enum a => Int -> a
toEnum ((Int
o1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o2))
               ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text () Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
o1)
           ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [ParsecT Text () Identity Char] -> ParsecT Text () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ((Char -> Char -> ParsecT Text () Identity Char)
-> String -> String -> [ParsecT Text () Identity Char]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) b u.
Stream s m Char =>
Char -> b -> ParsecT s u m b
escapedChar String
codes String
replacements)
       )
  where
    escapedChar :: Char -> b -> ParsecT s u m b
escapedChar Char
code b
replacement = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
code ParsecT s u m Char -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
replacement
    codes :: String
codes = String
"0bdefnrstv\\\"'"
    replacements :: String
replacements = String
"\NUL\b\DEL\ESC\f\n\r \t\v\\\"'"
    ccodes :: String
ccodes = [Char
'a' .. Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z']
    creplacements :: String
creplacements = ShowS
forall a. [a] -> [a]
cycle [Char
'\^A' .. Char
'\^Z']
    hexVal :: Char -> Int
hexVal Char
v
      | Char
v Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'a' .. Char
'z'] = Int
0xA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'a')
      | Char
v Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'A' .. Char
'Z'] = Int
0xA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'A')
      | Bool
otherwise = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0'
    octVal :: Char -> Int
octVal = Char -> Int
hexVal

erlBinaryParser :: Parser SimpleErlangTerm
erlBinaryParser :: Parsec Text () SimpleErlangTerm
erlBinaryParser = do
  String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<<"
  ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ErlString String
str <- SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
-> Parsec Text () SimpleErlangTerm
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (String -> SimpleErlangTerm
ErlString String
"") Parsec Text () SimpleErlangTerm
erlStringParser
  String
_ <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">>"
  ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  SimpleErlangTerm -> Parsec Text () SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SimpleErlangTerm
ErlBinary String
str)

erlListParser :: Parser SimpleErlangTerm
erlListParser :: Parsec Text () SimpleErlangTerm
erlListParser = [SimpleErlangTerm] -> SimpleErlangTerm
ErlList ([SimpleErlangTerm] -> SimpleErlangTerm)
-> ParsecT Text () Identity [SimpleErlangTerm]
-> Parsec Text () SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [SimpleErlangTerm]
forall a b.
Parser a -> Parser b -> ParsecT Text () Identity [SimpleErlangTerm]
erlNestedParser (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')

erlTupleParser :: Parser SimpleErlangTerm
erlTupleParser :: Parsec Text () SimpleErlangTerm
erlTupleParser = [SimpleErlangTerm] -> SimpleErlangTerm
ErlTuple ([SimpleErlangTerm] -> SimpleErlangTerm)
-> ParsecT Text () Identity [SimpleErlangTerm]
-> Parsec Text () SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [SimpleErlangTerm]
forall a b.
Parser a -> Parser b -> ParsecT Text () Identity [SimpleErlangTerm]
erlNestedParser (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{') (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')

erlNestedParser :: Parser a -> Parser b -> Parser [SimpleErlangTerm]
erlNestedParser :: Parser a -> Parser b -> ParsecT Text () Identity [SimpleErlangTerm]
erlNestedParser Parser a
open Parser b
close =
  ParsecT Text () Identity ()
-> ParsecT Text () Identity ()
-> ParsecT Text () Identity [SimpleErlangTerm]
-> ParsecT Text () Identity [SimpleErlangTerm]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Parser a
open Parser a
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces) (Parser b
close Parser b
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces) (Parsec Text () SimpleErlangTerm
-> ParsecT Text () Identity [SimpleErlangTerm]
forall a. Parser a -> Parser [a]
commaSep Parsec Text () SimpleErlangTerm
erlExpressionParser)

commaSep :: Parser a -> Parser [a]
commaSep :: Parser a -> Parser [a]
commaSep Parser a
p =
  do
    a
r <- Parser a
p
    ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    [a]
rest <- [a] -> Parser [a] -> Parser [a]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity () -> Parser [a] -> Parser [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
commaSep Parser a
p)
    [a] -> Parser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest)
    Parser [a] -> Parser [a] -> Parser [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [a] -> Parser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

arbitraryErlSimpleAtom :: Gen SimpleErlangTerm
arbitraryErlSimpleAtom :: Gen SimpleErlangTerm
arbitraryErlSimpleAtom =
  String -> SimpleErlangTerm
ErlAtom (String -> SimpleErlangTerm) -> Gen String -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> ShowS) -> Gen Char -> Gen ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char
arbitraryLetterLower Gen ShowS -> Gen String -> Gen String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf Gen Char
arbitraryErlNameChar)

arbitraryErlString :: Gen SimpleErlangTerm
arbitraryErlString :: Gen SimpleErlangTerm
arbitraryErlString =
  String -> SimpleErlangTerm
ErlString (String -> SimpleErlangTerm) -> Gen String -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf ([Gen Char] -> Gen Char
forall a. [Gen a] -> Gen a
oneof [Gen Char
arbitraryLetter, Gen Char
arbitraryDigit])

arbitraryErlNumber :: Gen SimpleErlangTerm
arbitraryErlNumber :: Gen SimpleErlangTerm
arbitraryErlNumber = [Gen SimpleErlangTerm] -> Gen SimpleErlangTerm
forall a. [Gen a] -> Gen a
oneof [Gen SimpleErlangTerm
arbitraryErlNatural, Gen SimpleErlangTerm
arbitraryErlFloat]

arbitraryErlNatural :: Gen SimpleErlangTerm
arbitraryErlNatural :: Gen SimpleErlangTerm
arbitraryErlNatural = Integer -> SimpleErlangTerm
ErlNatural (Integer -> SimpleErlangTerm)
-> Gen Integer -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary

arbitraryErlFloat :: Gen SimpleErlangTerm
arbitraryErlFloat :: Gen SimpleErlangTerm
arbitraryErlFloat = Double -> SimpleErlangTerm
ErlFloat (Double -> SimpleErlangTerm) -> Gen Double -> Gen SimpleErlangTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
arbitrary

arbitraryErlNameChar :: Gen Char
arbitraryErlNameChar :: Gen Char
arbitraryErlNameChar =
  [Gen Char] -> Gen Char
forall a. [Gen a] -> Gen a
oneof [Gen Char
arbitraryLetter, Gen Char
arbitraryDigit, Char -> Gen Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'_', Char -> Gen Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'@']