atto-lisp 0.1 → 0.2

raw patch · 2 files changed

+248/−43 lines, 2 filesdep +containersdep ~attoparsecdep ~blaze-textualPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependency ranges changed: attoparsec, blaze-textual

API changes (from Hackage documentation)

Files

• Data/AttoLisp.hs +244/−40
• atto-lisp.cabal +4/−3

@@ -1,5 +1,6 @@-{-# LANGUAGE OverloadedStrings, Rank2Types, DeriveDataTypeable, BangPatterns,-             MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances,+{-# LANGUAGE OverloadedStrings, Rank2Types, DeriveDataTypeable, BangPatterns #-}+-- The following is for the ParseList stuff+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances,              UndecidableInstances #-} -- | Efficient parsing and serialisation of S-Expressions (as used by Lisp). --@@ -11,7 +12,7 @@   ( -- * Core Lisp Types     Lisp(..), nil, isNull,     -- * Type Conversion-    FromLisp(..), Result(..),+    FromLisp(..), Result(..), fromLisp,     Failure, Success, Parser,     parse, parseMaybe, parseEither, typeMismatch, @@ -21,7 +22,7 @@     mkStruct,  struct,      -- * Encoding and parsing-    encode, fromLisp,+    encode, fromLispExpr,          lisp, atom,   )@@ -35,10 +36,12 @@ import Control.Monad import Data.Attoparsec.Char8 hiding ( Parser, Result, parse, string, double ) import Data.Data+import Data.Int  ( Int8, Int16, Int32, Int64 ) import Data.List ( foldl' )+import Data.Ratio ( Ratio ) import Data.Monoid import Data.String-import Data.Word ( Word8 )+import Data.Word ( Word, Word8, Word16, Word32, Word64 ) import Numeric (showHex) import qualified Data.Attoparsec as A import qualified Data.Text as T@@ -49,6 +52,7 @@ import qualified Data.Attoparsec.Zepto as Z import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze+import qualified Data.Map as M -- | A Lisp expression (S-expression). -- -- Symbols are case-sensitive.@@ -273,6 +277,9 @@ class FromLisp a where   parseLisp :: Lisp -> Parser a +fromLisp :: FromLisp a => Lisp -> Result a+fromLisp = parse parseLisp+ parseIntegral :: Integral a => Lisp -> Parser a parseIntegral (Number n) = pure (floor n) parseIntegral v          = typeMismatch "Integral" v@@ -328,18 +335,47 @@   parseList (T.unpack tag) f rest struct tag _ e = typeMismatch (T.unpack tag ++ " object") e +instance ToLisp Lisp where+  toLisp = id+  {-# INLINE toLisp #-} +instance FromLisp Lisp where+  parseLisp = pure+  {-# INLINE parseLisp #-}++instance ToLisp Bool where+  toLisp b = if b then Symbol "t" else nil+  {-# INLINE toLisp #-}++instance FromLisp Bool where+  parseLisp e = if isNull e then pure False else pure True+  {-# INLINE parseLisp #-}++instance ToLisp Char where+  toLisp c = String (T.singleton c)+  {-# INLINE toLisp #-}++instance FromLisp Char where+  parseLisp (String t)+    | T.compareLength t 1 == EQ = pure (T.head t)+  parseLisp e = typeMismatch "String" e+  {-# INLINE parseLisp #-}+ instance ToLisp Integer where   toLisp n = Number (fromInteger n)+  {-# INLINE toLisp #-}  instance FromLisp Integer where   parseLisp = parseIntegral+  {-# INLINE parseLisp #-}  instance ToLisp Int where   toLisp n = Number (fromIntegral n)+  {-# INLINE toLisp #-}  instance FromLisp Int where   parseLisp = parseIntegral+  {-# INLINE parseLisp #-}  instance ToLisp T.Text where   toLisp = String@@ -347,53 +383,210 @@ instance FromLisp T.Text where   parseLisp (String t) = pure t   parseLisp e = typeMismatch "Text" e+  {-# INLINE parseLisp #-}  instance ToLisp () where   toLisp () = List []+  {-# INLINE toLisp #-}  instance FromLisp () where   parseLisp e | isNull e = pure ()               | otherwise = typeMismatch "()" e+  {-# INLINE parseLisp #-}  instance ToLisp a => ToLisp (Maybe a) where   toLisp Nothing = nil   toLisp (Just a) = toLisp a+  {-# INLINE toLisp #-}  instance FromLisp a => FromLisp (Maybe a) where   parseLisp e | isNull e = pure Nothing   parseLisp e = Just <$> parseLisp e+  {-# INLINE parseLisp #-} -{- --- TESTS -----------------------------------------------------data Msg = Msg T.Text Integer-  deriving (Eq, Show)+-- | No tag is used, hence type @a@ and @b@ must be different.+instance (ToLisp a, ToLisp b) => ToLisp (Either a b) where+  toLisp (Left a) = toLisp a+  toLisp (Right b) = toLisp b+  {-# INLINE toLisp #-} -instance ToLisp Msg where-  toLisp (Msg t n) = mkStruct "msg" [toLisp t, toLisp n]+-- | Tries to parse @a@ or, if that fails, parses a @b@.+instance (FromLisp a, FromLisp b) => FromLisp (Either a b) where+  parseLisp e = Left <$> parseLisp e <|> Right <$> parseLisp e+  {-# INLINE parseLisp #-} -instance FromLisp Msg where-  parseLisp e = struct "msg" Msg e+instance ToLisp [Char] where+  toLisp s = String (T.pack s)+  {-# INLINE toLisp #-} +instance FromLisp [Char] where+  parseLisp (String t) = pure (T.unpack t)+  parseLisp e = typeMismatch "String" e+  {-# INLINE parseLisp #-} -test_sexp1 = -  show (List [Number 42.2, Symbol "foo", "blah"]) == "(42.2 foo \"blah\")"+instance ToLisp Double where+  toLisp = Number . D+  {-# INLINE toLisp #-} -test_msg1 = toLisp (Msg "foo" 42)-test_msg2 = List [Symbol "msg"]-test_msg3 = List [Symbol "msg", "bar", "baz"]+instance FromLisp Double where+  parseLisp (Number n) =+    case n of+      D d -> pure d+      I i -> pure (fromIntegral i)+  parseLisp e | isNull e = pure (0/0)  -- useful?+  parseLisp e = typeMismatch "Double" e+  {-# INLINE parseLisp #-} -test_parse :: IO ()-test_parse = do-  mapM_ (\inp ->-           putStrLn $ show inp ++ " => " ++ show (A.parseOnly (lisp <* A.endOfInput) inp))-    inputs- where-  inputs = ["()", "42", "(4 5 6)", "(3 (4))", "(3(4))",-            "\"foo\"", "foo", "(foo \"bar\" 23)"]+instance ToLisp Float where+  toLisp = Number . fromRational . toRational+  {-# INLINE toLisp #-} +instance FromLisp Float where+  parseLisp (Number n) =+    case n of+      D d -> pure (fromRational (toRational d))+      I i -> pure (fromIntegral i)+  parseLisp e | isNull e = pure (0/0)  -- useful?+  parseLisp e = typeMismatch "Float" e+  {-# INLINE parseLisp #-} +instance ToLisp Number where+  toLisp = Number+  {-# INLINE toLisp #-} --- -}+instance FromLisp Number where+  parseLisp (Number n) = pure n+  parseLisp e | isNull e = pure (D (0/0))  -- useful?+  parseLisp e = typeMismatch "Number" e+  {-# INLINE parseLisp #-} +instance ToLisp (Ratio Integer) where+  toLisp = Number . fromRational+  {-# INLINE toLisp #-}++instance FromLisp (Ratio Integer) where+  parseLisp (Number n) =+    case n of+      D d -> pure (toRational d)+      I i -> pure (fromIntegral i)+  parseLisp e = typeMismatch "Ratio Integer" e+  {-# INLINE parseLisp #-}++instance ToLisp Int8 where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Int8 where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp Int16 where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Int16 where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp Int32 where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Int32 where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp Int64 where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Int64 where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp Word where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Word where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp Word8 where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Word8 where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp Word16 where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Word16 where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp Word32 where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Word32 where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp Word64 where+  toLisp = Number . fromIntegral+  {-# INLINE toLisp #-}++instance FromLisp Word64 where+  parseLisp = parseIntegral+  {-# INLINE parseLisp #-}++instance ToLisp a => ToLisp [a] where+  toLisp l = List (map toLisp l)+  {-# INLINE toLisp #-}++instance FromLisp a => FromLisp [a] where+  parseLisp (List l) = mapM parseLisp l+  parseLisp e = typeMismatch "list" e+  {-# INLINE parseLisp #-}++instance (ToLisp a, ToLisp b) => ToLisp (a, b) where+  toLisp (a, b) = List [toLisp a, toLisp b]  -- TODO: could use dotted list+  {-# INLINE toLisp #-}++instance (FromLisp a, FromLisp b) => FromLisp (a, b) where+  parseLisp (List l) =+    case l of+      [a, b] -> (,) <$> parseLisp a <*> parseLisp b+      _ -> fail $ "Cannot unpack list into a pair"+  parseLisp (DotList hds b) =+    case hds of+      [a] -> (,) <$> parseLisp a <*> parseLisp b+      _ -> fail $ "Cannot unpack dotted list into a pair"+  parseLisp e = typeMismatch "pair" e+  {-# INLINE parseLisp #-}++instance (ToLisp a, ToLisp b, ToLisp c) => ToLisp (a, b, c) where+  toLisp (a, b, c) = List [toLisp a, toLisp b, toLisp c]+  {-# INLINE toLisp #-}++instance (FromLisp a, FromLisp b, FromLisp c) => FromLisp (a, b, c) where+  parseLisp (List l) =+    case l of+      [a, b, c] -> (,,) <$> parseLisp a <*> parseLisp b <*> parseLisp c+      _ -> fail $ "Cannot unpack list into a 3-tuple"+  parseLisp e = typeMismatch "3-tuple" e+  {-# INLINE parseLisp #-}++instance (ToLisp a, ToLisp b) => ToLisp (M.Map a b) where+  toLisp mp = toLisp [ (toLisp k, toLisp v) | (k,v) <- M.toList mp ]++instance (Ord a, FromLisp a, FromLisp b) => FromLisp (M.Map a b) where+  parseLisp e = M.fromList <$> parseLisp e+ {-  We are using the standard Common Lisp read table.@@ -413,10 +606,13 @@  -- | Parse an arbitrary lisp expression. lisp :: A.Parser Lisp-lisp = skipSpace *>+lisp = skipLispSpace *>   (char '(' *> list_ <|>+   quoted <$> (char '\'' *> char '(' *> list_) <|>    String <$> (char '"' *> lstring_) <|>    atom)+ where+  quoted l = List [Symbol "quote", l]  -- | Parse a symbol or a number.  Symbols are expected to be utf8. --@@ -441,8 +637,8 @@  list_ :: A.Parser Lisp list_ = do-  skipSpace-  elems <- (lisp `sepBy` skipSpace) <* char ')'+  skipLispSpace+  elems <- (lisp `sepBy` skipLispSpace) <* skipLispSpace <* char ')'   return (List elems)  doubleQuote :: Word8@@ -453,7 +649,15 @@ backslash = 92 {-# INLINE backslash #-} +skipLispSpace :: A.Parser ()+skipLispSpace = skipSpace >> optional comment >> skipSpace +comment :: A.Parser ()+comment = do+  _ <- char ';' >> A.many (notChar '\n')+  end <- atEnd+  if end then char '\n' >> return () else return ()+ -- | Parse a string without a leading quote. lstring_ :: A.Parser T.Text lstring_ = {-# SCC "jstring_" #-} do@@ -494,8 +698,8 @@       else rest   mapping = "\"\\/\n\t\b\r\f" -fromLisp :: Lisp -> Blaze.Builder-fromLisp (String str) = string str+fromLispExpr :: Lisp -> Blaze.Builder+fromLispExpr (String str) = string str  where    string s = fromChar '"' `mappend` quote s `mappend` fromChar '"'    quote q =@@ -513,22 +717,22 @@         | c < '\x20' = Blaze.fromString $ "\\x" ++ replicate (2 - length h) '0' ++ h         | otherwise  = fromChar c         where h = showHex (fromEnum c) "" -fromLisp (Symbol t) = Blaze.fromText t-fromLisp (Number n) = fromNumber n-fromLisp (List []) = Blaze.fromByteString "nil"-fromLisp (List l) = enc_list l (fromChar ')')-fromLisp (DotList l t) =-  enc_list l (Blaze.fromByteString " . " `mappend` fromLisp t `mappend` fromChar ')')+fromLispExpr (Symbol t) = Blaze.fromText t+fromLispExpr (Number n) = fromNumber n+fromLispExpr (List []) = Blaze.fromByteString "nil"+fromLispExpr (List l) = enc_list l (fromChar ')')+fromLispExpr (DotList l t) =+  enc_list l (Blaze.fromByteString " . " `mappend` fromLispExpr t `mappend` fromChar ')')  enc_list :: [Lisp] -> Blaze.Builder -> Blaze.Builder enc_list [] tl = fromChar '(' `mappend` tl-enc_list (x:xs) tl = fromChar '(' `mappend` fromLisp x `mappend` foldr f tl xs- where f e t = fromChar ' ' `mappend` fromLisp e `mappend` t+enc_list (x:xs) tl = fromChar '(' `mappend` fromLispExpr x `mappend` foldr f tl xs+ where f e t = fromChar ' ' `mappend` fromLispExpr e `mappend` t  fromNumber :: Number -> Blaze.Builder fromNumber (I i) = integral i fromNumber (D d) = double d  encode :: ToLisp a => a -> Lazy.ByteString-encode = Blaze.toLazyByteString . fromLisp . toLisp+encode = Blaze.toLazyByteString . fromLispExpr . toLisp {-# INLINE encode #-}

@@ -1,5 +1,5 @@ name:                   atto-lisp-version:                0.1+version:                0.2 license:                BSD3 license-file:           LICENSE author:                 Thomas Schilling <nominolo@googlemail.com>@@ -15,11 +15,12 @@  library   build-depends:-    attoparsec    >= 0.8.5.1 && < 0.9,+    attoparsec    >= 0.8.5.1 && < 0.10,     base          >= 4.2     && < 5,     blaze-builder >= 0.3     && < 0.4,-    blaze-textual >= 0.1     && < 0.2,+    blaze-textual >= 0.1     && < 0.3,     bytestring    >= 0.9     && < 0.10,+    containers    >= 0.3     && < 0.5,     deepseq       >= 1.1     && < 1.2,     text          >= 0.10    && < 0.12