module Data.SCargot.Language.HaskLike
(
HaskLikeAtom(..)
, haskLikeParser
, haskLikePrinter
) 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)
data HaskLikeAtom
= HSIdent Text
| HSString Text
| HSInt Integer
| HSFloat Double
deriving (Eq, Show)
instance IsString HaskLikeAtom where
fromString = HSIdent . fromString
pString :: Parser Text
pString = pack . catMaybes <$> between (char '"') (char '"') (many (val <|> esc))
where val = Just <$> satisfy (\ c -> c /= '"' && c /= '\\' && c > '\026')
esc = do _ <- char '\\'
Nothing <$ (gap <|> char '&') <|>
Just <$> code
gap = many1 space >> char '\\'
code = eEsc <|> eNum <|> eCtrl <|> eAscii
eCtrl = char '^' >> unCtrl <$> upper
eNum = (toEnum . fromInteger) <$>
(decNumber <|> (char 'o' >> octNumber)
<|> (char 'x' >> hexNumber))
eEsc = choice [ char a >> return b | (a, b) <- escMap ]
eAscii = choice [ try (string a >> return b)
| (a, b) <- asciiMap ]
unCtrl c = toEnum (fromEnum c fromEnum 'A' + 1)
escMap :: [(Char, Char)]
escMap = zip "abfntv\\\"\'" "\a\b\f\n\r\t\v\\\"\'"
asciiMap :: [(String, Char)]
asciiMap = zip
["BS","HT","LF","VT","FF","CR","SO","SI","EM"
,"FS","GS","RS","US","SP","NUL","SOH","STX","ETX"
,"EOT","ENQ","ACK","BEL","DLE","DC1","DC2","DC3"
,"DC4","NAK","SYN","ETB","CAN","SUB","ESC","DEL"]
("\BS\HT\LF\VT\FF\CR\SO\SI\EM\FS\GS\RS\US\SP\NUL\SOH" ++
"\STX\ETX\EOT\ENQ\ACK\BEL\DLE\DC1\DC2\DC3\DC4\NAK" ++
"\SYN\ETB\CAN\SUB\ESC\DEL")
pFloat :: Parser Double
pFloat = do
n <- decNumber
withDot n <|> noDot n
where withDot n = do
_ <- char '.'
m <- decNumber
e <- option 1.0 expn
return ((fromIntegral n + asDec m 0) * e)
noDot n = do
e <- expn
return (fromIntegral n * e)
expn = do
_ <- oneOf "eE"
s <- power
x <- decNumber
return (10 ** s (fromIntegral x))
asDec 0 k = k
asDec n k =
asDec (n `div` 10) ((fromIntegral (n `rem` 10) + k) * 0.1)
power :: Num a => Parser (a -> a)
power = negate <$ char '-' <|> id <$ char '+' <|> return id
pInt :: Parser Integer
pInt = do
s <- power
n <- pZeroNum <|> decNumber
return (fromIntegral (s n))
pZeroNum :: Parser Integer
pZeroNum = char '0' >>
( (oneOf "xX" >> hexNumber)
<|> (oneOf "oO" >> octNumber)
<|> decNumber
<|> return 0
)
pHaskLikeAtom :: Parser HaskLikeAtom
pHaskLikeAtom
= HSFloat <$> (try pFloat <?> "float")
<|> HSInt <$> (try pInt <?> "integer")
<|> HSString <$> (pString <?> "string literal")
<|> HSIdent <$> (parseR5RSIdent <?> "token")
sHaskLikeAtom :: HaskLikeAtom -> Text
sHaskLikeAtom (HSIdent t) = t
sHaskLikeAtom (HSString s) = pack (show s)
sHaskLikeAtom (HSInt i) = pack (show i)
sHaskLikeAtom (HSFloat f) = pack (show f)
haskLikeParser :: SExprParser HaskLikeAtom (SExpr HaskLikeAtom)
haskLikeParser = mkParser pHaskLikeAtom
haskLikePrinter :: SExprPrinter HaskLikeAtom (SExpr HaskLikeAtom)
haskLikePrinter = flatPrint sHaskLikeAtom