{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.SCargot.Language.HaskLike
  ( -- $info
    HaskLikeAtom(..)
  , haskLikeParser
  , haskLikePrinter
  , locatedHaskLikeParser
  , locatedHaskLikePrinter
    -- * Individual Parsers
  , parseHaskellString
  , parseHaskellFloat
  , parseHaskellInt
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<$))
#endif
import           Data.Maybe (catMaybes)
import           Data.String (IsString(..))
import           Data.Text (Text, pack)
import           Text.Parsec
import           Text.Parsec.Text (Parser)

import           Prelude hiding (concatMap)

import Data.SCargot.Common
import Data.SCargot.Repr.Basic (SExpr)
import Data.SCargot (SExprParser, SExprPrinter, mkParser, flatPrint)

{- $info

This module is intended for simple, ad-hoc configuration or data
formats that might not need their on rich structure but might benefit
from a few various kinds of literals. The 'haskLikeParser' understands
identifiers as defined by R5RS, as well as string, integer, and
floating-point literals as defined by the Haskell 2010 spec. It does
__not__ natively understand other data types, such as booleans,
vectors, bitstrings.

-}


-- | An atom type that understands Haskell-like values as well as
--   Scheme-like identifiers.
data HaskLikeAtom
  = HSIdent  Text  -- ^ An identifier, parsed according to the R5RS Scheme
                   --   standard
  | HSString Text  -- ^ A string, parsed according to the syntax for string
                   --   literals in the Haskell report
  | HSInt Integer  -- ^ An arbitrary-sized integer value, parsed according to
                   --   the syntax for integer literals in the Haskell report
  | HSFloat Double -- ^ A double-precision floating-point value, parsed
                   --   according to the syntax for floats in the Haskell
                   --   report
    deriving (HaskLikeAtom -> HaskLikeAtom -> Bool
(HaskLikeAtom -> HaskLikeAtom -> Bool)
-> (HaskLikeAtom -> HaskLikeAtom -> Bool) -> Eq HaskLikeAtom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HaskLikeAtom -> HaskLikeAtom -> Bool
== :: HaskLikeAtom -> HaskLikeAtom -> Bool
$c/= :: HaskLikeAtom -> HaskLikeAtom -> Bool
/= :: HaskLikeAtom -> HaskLikeAtom -> Bool
Eq, Int -> HaskLikeAtom -> ShowS
[HaskLikeAtom] -> ShowS
HaskLikeAtom -> String
(Int -> HaskLikeAtom -> ShowS)
-> (HaskLikeAtom -> String)
-> ([HaskLikeAtom] -> ShowS)
-> Show HaskLikeAtom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HaskLikeAtom -> ShowS
showsPrec :: Int -> HaskLikeAtom -> ShowS
$cshow :: HaskLikeAtom -> String
show :: HaskLikeAtom -> String
$cshowList :: [HaskLikeAtom] -> ShowS
showList :: [HaskLikeAtom] -> ShowS
Show)

instance IsString HaskLikeAtom where
  fromString :: String -> HaskLikeAtom
fromString = Text -> HaskLikeAtom
HSIdent (Text -> HaskLikeAtom)
-> (String -> Text) -> String -> HaskLikeAtom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

instance IsString (Located HaskLikeAtom) where
  fromString :: String -> Located HaskLikeAtom
fromString = (Location -> HaskLikeAtom -> Located HaskLikeAtom
forall a. Location -> a -> Located a
At Location
dLocation) (HaskLikeAtom -> Located HaskLikeAtom)
-> (String -> HaskLikeAtom) -> String -> Located HaskLikeAtom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HaskLikeAtom
HSIdent (Text -> HaskLikeAtom)
-> (String -> Text) -> String -> HaskLikeAtom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | Parse a Haskell string literal as defined by the Haskell 2010
-- language specification.
parseHaskellString :: Parser Text
parseHaskellString :: Parser Text
parseHaskellString = String -> Text
pack (String -> Text)
-> ([Maybe Char] -> String) -> [Maybe Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Char] -> String
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Char] -> Text)
-> ParsecT Text () Identity [Maybe Char] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity [Maybe Char]
-> ParsecT Text () Identity [Maybe Char]
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 (Maybe Char)
-> ParsecT Text () Identity [Maybe Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text () Identity (Maybe Char)
forall {u}. ParsecT Text u Identity (Maybe Char)
val ParsecT Text () Identity (Maybe Char)
-> ParsecT Text () Identity (Maybe Char)
-> ParsecT Text () Identity (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity (Maybe Char)
esc))
  where val :: ParsecT Text u Identity (Maybe Char)
val = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> ParsecT Text u Identity Char
-> ParsecT Text u Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\ 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
'\\' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\026')
        esc :: ParsecT Text () Identity (Maybe Char)
esc = do Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
                 Maybe Char
forall a. Maybe a
Nothing Maybe Char
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (Maybe Char)
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
gap 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 (Maybe Char)
-> ParsecT Text () Identity (Maybe Char)
-> ParsecT Text () Identity (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                   Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
code
        gap :: ParsecT Text u Identity Char
gap  = ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT Text u Identity String
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
        code :: ParsecT Text () Identity Char
code = ParsecT Text () Identity Char
forall {u}. ParsecT Text u Identity Char
eEsc 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
eNum 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 {u}. ParsecT Text u Identity Char
eCtrl 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 {u}. ParsecT Text u Identity Char
eAscii
        eCtrl :: ParsecT Text u Identity Char
eCtrl  = 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
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Char
forall {a} {a}. (Enum a, Enum a) => a -> a
unCtrl (Char -> Char)
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper
        eNum :: ParsecT Text () Identity Char
eNum   = (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger) (Integer -> Char)
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   (ParsecT Text () Identity Integer
decNumber ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity 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
'o' ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity Integer
octNumber)
                              ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity 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
'x' ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity Integer
hexNumber))
        eEsc :: ParsecT Text u Identity Char
eEsc   = [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
a ParsecT Text u Identity Char
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text u Identity Char
forall a. a -> ParsecT Text u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
b | (Char
a, Char
b) <- [(Char, Char)]
escMap ]
        eAscii :: ParsecT Text u Identity Char
eAscii = [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 [ ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
a ParsecT Text u Identity String
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Char
forall a b.
ParsecT Text u Identity a
-> ParsecT Text u Identity b -> ParsecT Text u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text u Identity Char
forall a. a -> ParsecT Text u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
b)
                        | (String
a, Char
b) <- [(String, Char)]
asciiMap ]
        unCtrl :: a -> a
unCtrl a
c = Int -> a
forall a. Enum a => Int -> a
toEnum (a -> Int
forall a. Enum a => a -> Int
fromEnum a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

escMap :: [(Char,  Char)]
escMap :: [(Char, Char)]
escMap = String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
"abfntv\\\"\'" String
"\a\b\f\n\r\t\v\\\"\'"

asciiMap :: [(String, Char)]
asciiMap :: [(String, Char)]
asciiMap = [String] -> String -> [(String, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip
  [String
"BS",String
"HT",String
"LF",String
"VT",String
"FF",String
"CR",String
"SO",String
"SI",String
"EM"
  ,String
"FS",String
"GS",String
"RS",String
"US",String
"SP",String
"NUL",String
"SOH",String
"STX",String
"ETX"
  ,String
"EOT",String
"ENQ",String
"ACK",String
"BEL",String
"DLE",String
"DC1",String
"DC2",String
"DC3"
  ,String
"DC4",String
"NAK",String
"SYN",String
"ETB",String
"CAN",String
"SUB",String
"ESC",String
"DEL"]
  (String
"\BS\HT\LF\VT\FF\CR\SO\SI\EM\FS\GS\RS\US\SP\NUL\SOH" String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String
"\STX\ETX\EOT\ENQ\ACK\BEL\DLE\DC1\DC2\DC3\DC4\NAK" String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String
"\SYN\ETB\CAN\SUB\ESC\DEL")

-- | Parse a Haskell floating-point number as defined by the Haskell
-- 2010 language specification.
parseHaskellFloat :: Parser Double
parseHaskellFloat :: Parser Double
parseHaskellFloat = do
  Integer
n <- ParsecT Text () Identity Integer
decNumber
  Integer -> Parser Double
forall {a}. Integral a => a -> Parser Double
withDot Integer
n Parser Double -> Parser Double -> Parser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> Parser Double
forall {a}. Integral a => a -> Parser Double
noDot Integer
n
  where withDot :: a -> Parser Double
withDot a
n = do
          Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
          Integer
m <- ParsecT Text () Identity Integer
decNumber
          Double
e <- Double -> Parser Double -> Parser Double
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Double
1.0 Parser Double
expn
          Double -> Parser Double
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Integer -> Double -> Double
forall {a} {t}. (Integral a, Fractional t) => a -> t -> t
asDec Integer
m Double
0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
e)
        noDot :: a -> Parser Double
noDot a
n = do
          Double
e <- Parser Double
expn
          Double -> Parser Double
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
e)
        expn :: Parser Double
expn = do
          Char
_ <- String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"eE"
          Double -> Double
s <- Parser (Double -> Double)
forall a. Num a => Parser (a -> a)
power
          Integer
x <- ParsecT Text () Identity Integer
decNumber
          Double -> Parser Double
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double -> Double
s (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x))
        asDec :: a -> t -> t
asDec a
0 t
k = t
k
        asDec a
n t
k =
          a -> t -> t
asDec (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
10) ((a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
10) t -> t -> t
forall a. Num a => a -> a -> a
+ t
k) t -> t -> t
forall a. Num a => a -> a -> a
* t
0.1)

power :: Num a => Parser (a -> a)
power :: forall a. Num a => Parser (a -> a)
power = a -> a
forall a. Num a => a -> a
negate (a -> a)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (a -> a)
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f 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 (a -> a)
-> ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity (a -> a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> a -> a
forall a. a -> a
id (a -> a)
-> ParsecT Text () Identity Char
-> ParsecT Text () Identity (a -> a)
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f 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 (a -> a)
-> ParsecT Text () Identity (a -> a)
-> ParsecT Text () Identity (a -> a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (a -> a) -> ParsecT Text () Identity (a -> a)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. a -> a
id

-- | Parse a Haskell integer literal as defined by the Haskell 2010
-- language specification.
parseHaskellInt :: Parser Integer
parseHaskellInt :: ParsecT Text () Identity Integer
parseHaskellInt = do
  Integer -> Integer
s <- Parser (Integer -> Integer)
forall a. Num a => Parser (a -> a)
power
  Integer
n <- ParsecT Text () Identity Integer
pZeroNum ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Integer
decNumber
  Integer -> ParsecT Text () Identity Integer
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Integer
s Integer
n))

pZeroNum :: Parser Integer
pZeroNum :: ParsecT Text () Identity Integer
pZeroNum = Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  (  (String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"xX" ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity Integer
hexNumber)
 ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
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
oneOf String
"oO" ParsecT Text () Identity Char
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text () Identity Integer
octNumber)
 ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Integer
decNumber
 ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> ParsecT Text () Identity Integer
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
  )

pHaskLikeAtom :: Parser HaskLikeAtom
pHaskLikeAtom :: Parser HaskLikeAtom
pHaskLikeAtom
   =  Double -> HaskLikeAtom
HSFloat   (Double -> HaskLikeAtom) -> Parser Double -> Parser HaskLikeAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Double -> Parser Double
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Double
parseHaskellFloat Parser Double -> String -> Parser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float")
  Parser HaskLikeAtom -> Parser HaskLikeAtom -> Parser HaskLikeAtom
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Integer -> HaskLikeAtom
HSInt     (Integer -> HaskLikeAtom)
-> ParsecT Text () Identity Integer -> Parser HaskLikeAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text () Identity Integer
parseHaskellInt   ParsecT Text () Identity Integer
-> String -> ParsecT Text () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"integer")
  Parser HaskLikeAtom -> Parser HaskLikeAtom -> Parser HaskLikeAtom
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> HaskLikeAtom
HSString  (Text -> HaskLikeAtom) -> Parser Text -> Parser HaskLikeAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text
parseHaskellString    Parser Text -> String -> Parser Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"string literal")
  Parser HaskLikeAtom -> Parser HaskLikeAtom -> Parser HaskLikeAtom
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> HaskLikeAtom
HSIdent   (Text -> HaskLikeAtom) -> Parser Text -> Parser HaskLikeAtom
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text
parseR5RSIdent Parser Text -> String -> Parser Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"token")

sHaskLikeAtom :: HaskLikeAtom -> Text
sHaskLikeAtom :: HaskLikeAtom -> Text
sHaskLikeAtom (HSIdent Text
t)  = Text
t
sHaskLikeAtom (HSString Text
s) = String -> Text
pack (Text -> String
forall a. Show a => a -> String
show Text
s)
sHaskLikeAtom (HSInt Integer
i)    = String -> Text
pack (Integer -> String
forall a. Show a => a -> String
show Integer
i)
sHaskLikeAtom (HSFloat Double
f)  = String -> Text
pack (Double -> String
forall a. Show a => a -> String
show Double
f)

-- | This `SExprParser` understands s-expressions that contain
--   Scheme-like tokens, as well as string literals, integer
--   literals, and floating-point literals. Each of these values
--   is parsed according to the lexical rules in the Haskell
--   report, so the same set of string escapes, numeric bases,
--   and floating-point options are available. This spec does
--   not parse comments and does not understand any reader
--   macros.
--
-- >>> decode haskLikeParser "(0x01 \"\\x65lephant\")"
-- Right [SCons (SAtom (HSInt 1)) (SCons (SAtom (HSString "elephant")) SNil)]
haskLikeParser :: SExprParser HaskLikeAtom (SExpr HaskLikeAtom)
haskLikeParser :: SExprParser HaskLikeAtom (SExpr HaskLikeAtom)
haskLikeParser = Parser HaskLikeAtom
-> SExprParser HaskLikeAtom (SExpr HaskLikeAtom)
forall atom. Parser atom -> SExprParser atom (SExpr atom)
mkParser Parser HaskLikeAtom
pHaskLikeAtom

-- | A 'haskLikeParser' which produces 'Located' values
--
-- >>> decode locatedHaskLikeParser $ pack "(0x01 \"\\x65lephant\")"
-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 6)) (HSInt 1))) (SCons (SAtom (At (Span (line 1, column 7) (line 1, column 20)) (HSString "elephant"))) SNil)]
--
-- >>> decode locatedHaskLikeParser $ pack "(1 elephant)"
-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) (HSInt 1))) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) (HSIdent "elephant"))) SNil)]
locatedHaskLikeParser :: SExprParser (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
locatedHaskLikeParser :: SExprParser (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
locatedHaskLikeParser = Parser (Located HaskLikeAtom)
-> SExprParser
     (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
forall atom. Parser atom -> SExprParser atom (SExpr atom)
mkParser (Parser (Located HaskLikeAtom)
 -> SExprParser
      (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom)))
-> Parser (Located HaskLikeAtom)
-> SExprParser
     (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
forall a b. (a -> b) -> a -> b
$ Parser HaskLikeAtom -> Parser (Located HaskLikeAtom)
forall a. Parser a -> Parser (Located a)
located Parser HaskLikeAtom
pHaskLikeAtom

-- | This 'SExprPrinter' emits s-expressions that contain Scheme-like
--   tokens as well as string literals, integer literals, and floating-point
--   literals, which will be emitted as the literals produced by Haskell's
--   'show' function. This printer will produce a flat s-expression with
--   no indentation of any kind.
--
-- >>> encode haskLikePrinter [L [A (HSInt 1), A (HSString "elephant")]]
-- "(1 \"elephant\")"
haskLikePrinter :: SExprPrinter HaskLikeAtom (SExpr HaskLikeAtom)
haskLikePrinter :: SExprPrinter HaskLikeAtom (SExpr HaskLikeAtom)
haskLikePrinter = (HaskLikeAtom -> Text)
-> SExprPrinter HaskLikeAtom (SExpr HaskLikeAtom)
forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
flatPrint HaskLikeAtom -> Text
sHaskLikeAtom

-- | Ignore location tags when packing values into text
sLocatedHasklikeAtom :: Located HaskLikeAtom -> Text
sLocatedHasklikeAtom :: Located HaskLikeAtom -> Text
sLocatedHasklikeAtom (At Location
_loc HaskLikeAtom
e) = HaskLikeAtom -> Text
sHaskLikeAtom HaskLikeAtom
e

-- | A 'SExprPrinter' for 'Located' values. Works exactly like 'haskLikePrinter'
--   It ignores the location tags when printing the result.
--
-- >>> let (Right dec) = decode locatedHaskLikeParser $ pack "(1 elephant)"
-- [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) (HSInt 1))) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) (HSIdent "elephant"))) SNil)]
--
-- >>> encode locatedHaskLikePrinter dec
-- "(1 elephant)"
locatedHaskLikePrinter :: SExprPrinter (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
locatedHaskLikePrinter :: SExprPrinter (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
locatedHaskLikePrinter = (Located HaskLikeAtom -> Text)
-> SExprPrinter
     (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
forall atom. (atom -> Text) -> SExprPrinter atom (SExpr atom)
flatPrint Located HaskLikeAtom -> Text
sLocatedHasklikeAtom