atto-lisp 0.2.1.1 → 0.2.1.2
raw patch · 3 files changed
+244/−22 lines, 3 filesdep +HUnitdep +atto-lispdep +test-frameworkdep ~attoparsecdep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, atto-lisp, test-framework, test-framework-hunit
Dependency ranges changed: attoparsec, base, bytestring, containers, text
API changes (from Hackage documentation)
Files
- Data/AttoLisp.hs +89/−18
- atto-lisp.cabal +19/−4
- test/test-attolisp.hs +136/−0
Data/AttoLisp.hs view
@@ -34,7 +34,7 @@ import Control.Applicative import Control.DeepSeq (NFData(..)) import Control.Monad-import Data.Attoparsec.Char8 hiding ( Parser, Result, parse, string, double )+import Data.Attoparsec.Char8 hiding ( Parser, Result, parse, string, double, number ) import Data.Data import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.List ( foldl' )@@ -44,6 +44,7 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 ) import Numeric (showHex) import qualified Data.Attoparsec as A+import qualified Data.Attoparsec.Char8 as AC import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.ByteString.Unsafe as B@@ -648,22 +649,87 @@ quoted l = List [Symbol "quote", l] -- | Parse a symbol or a number. Symbols are expected to be utf8.------ TODO: support escapes in symbols atom :: A.Parser Lisp-atom = do- sym <- takeWhile1 (\c -> not (terminatingChar c))- -- If it looks like a number it is parsed as a number.- let !w = B.unsafeIndex sym 0- if (w >= 48 && w <= 57) || -- digit- w == 43 || w == 45 -- '+' or '-'- then do- case A.parseOnly number sym of- Left _ -> pure (Symbol (T.decodeUtf8 sym))- Right n -> pure (Number n)- else- pure (Symbol (T.decodeUtf8 sym))- +atom = number <|> symbol++number :: A.Parser Lisp+number = do+ sym <- takeWhile1 (not . terminatingChar)+ case A.parseOnly AC.number sym of+ Left _ -> fail "Not a number"+ Right n -> return (Number n)++symbol :: A.Parser Lisp+symbol = Symbol <$> sym+ where+ sym = suffix+ <|> do { p1 <- part; option p1 (T.append p1 <$> suffix) }+ suffix = T.append <$> psep <*> part+ psep = do+ c <- char ':'+ c2 <- option [] (pure <$> char ':')+ pure $ T.pack (c:c2)+ part = multiEscPart <|> basicPart++-- | Parse a multi-escaped symbol part (the part could either be the+-- package name or the symbol itself), that is, anything between unescaped+-- vertical bars, e.g.+--+-- * |foo|+--+-- * |foo ) bar|+--+-- * |foo \| bar|+--+-- We return the whole thing unadulterated, vertical bars and all.+-- Symbols are expected to be utf8.+multiEscPart :: A.Parser T.Text+multiEscPart = do+ vb <- char8 '|'+ (T.decodeUtf8 . B.cons vb) <$> chunk+ where+ stop c = c == backslash || c == verticalBar+ chunk = do+ p1 <- A.takeWhile (not . stop)+ p2 <- Data.Attoparsec.Char8.take 1+ case p2 of+ "|" -> return (p1 `B.append` p2)+ "\\" -> do { p3 <- Data.Attoparsec.Char8.take 1+ ; B.append (p1 `B.append` p2 `B.append` p3) <$> chunk+ }+ _ -> error "Data.AttoLisp: should be impossible to have gotten something other than '\\' or | here"++-- | Parse a non-multi-escaped symbol part (the part could either be the+-- package name or the symbol itself)+-- Symbols are expected to be utf8.+basicPart :: A.Parser T.Text+basicPart = do+ sym <- takeWhile1 (not . stop)+ let !lst = B.last sym+ if isSingleEsc lst+ then -- single-escaped symbol: read more stuff+ (decodeSym . B.append sym) <$> chunk+ else -- other cases, eg. foo, |bar|+ pure (decodeSym sym)+ where+ stop c = terminatingChar c || c == '|' || c == ':'+ isSingleEsc w = w == backslash+ -- parts of an atom that follow a single escape+ -- so given something like x\yz, this handles the+ -- parsing of yz+ chunk = do+ escapee <- A.take 1+ done <- atEnd+ if done then pure escapee else do+ rest <- takeWhile1 (not . terminatingChar)+ let !lst = B.last rest+ !pref = escapee `B.append` rest+ if lst == backslash+ then B.append pref <$> chunk+ else pure pref+ --+ decodeSym = T.decodeUtf8+ terminatingChar :: Char -> Bool terminatingChar c = c == ',' || c == '(' || c == ')' || c == '\'' || c == ';' || c == '`' || isSpace c@@ -682,12 +748,17 @@ backslash = 92 {-# INLINE backslash #-} +verticalBar :: Word8+verticalBar = 124+{-# INLINE verticalBar #-}+ skipLispSpace :: A.Parser ()-skipLispSpace = skipSpace >> optional comment >> skipSpace+skipLispSpace =+ skipSpace >> many (comment >> skipSpace) >> return () comment :: A.Parser () comment = do- _ <- char ';' >> Control.Applicative.many (notChar '\n')+ _ <- char ';' >> many (notChar '\n') end <- atEnd if end then char '\n' >> return () else return ()
atto-lisp.cabal view
@@ -1,5 +1,5 @@ name: atto-lisp-version: 0.2.1.1+version: 0.2.1.2 license: BSD3 license-file: LICENSE author: Thomas Schilling <nominolo@googlemail.com>@@ -11,7 +11,7 @@ category: Text, Data stability: provisional build-type: Simple-cabal-version: >= 1.6+cabal-version: >= 1.10 library build-depends:@@ -19,8 +19,8 @@ base >= 4.2 && < 5, blaze-builder >= 0.3 && < 0.4, blaze-textual >= 0.1 && < 0.3,- bytestring >= 0.9 && < 0.10,- containers >= 0.3 && < 0.5,+ bytestring >= 0.9 && < 0.11,+ containers >= 0.3 && < 0.6, deepseq >= 1.1 && < 1.4, text >= 0.10 && < 0.12 @@ -28,3 +28,18 @@ Data.AttoLisp ghc-options: -Wall+ default-language: Haskell2010++Test-Suite test+ Type: exitcode-stdio-1.0+ Main-is: test-attolisp.hs+ Hs-Source-Dirs: test + Build-depends: atto-lisp+ , attoparsec+ , base+ , bytestring+ , text + , HUnit+ , test-framework+ , test-framework-hunit+ Default-language: Haskell2010
+ test/test-attolisp.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE OverloadedStrings, Rank2Types, DeriveDataTypeable, BangPatterns,+ MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances,+ UndecidableInstances #-}++module Main where++import Control.Applicative+import Data.AttoLisp+import qualified Data.Attoparsec as A+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import Test.HUnit+import Test.Framework.Providers.HUnit+import Test.Framework++data Msg = Msg T.Text Integer+ deriving (Eq, Show)++instance ToLisp Msg where+ toLisp (Msg t n) = mkStruct "msg" [toLisp t, toLisp n]++instance FromLisp Msg where+ parseLisp e = struct "msg" Msg e+++test_sexp1 = + show (List [Number 42.2, Symbol "foo", "blah"]) == "(42.2 foo \"blah\")"++test_msg1 = toLisp (Msg "foo" 42)+test_msg2 = List [Symbol "msg"]+test_msg3 = List [Symbol "msg", "bar", "baz"]++data T = T { tin :: B.ByteString+ , tout :: Maybe Lisp+ }++main :: IO ()+main = defaultMain+ [ testSimple+ , testTokens+ ]++tcase :: T -> Test.Framework.Test+tcase (T inp out) = testCase inpStr $ assertParse inpStr out out2+ where+ inpStr = BC.unpack inp+ out2 = A.parseOnly (lisp <* A.endOfInput) inp++assertParse _ Nothing (Left _) = return ()+assertParse _ Nothing (Right v2) = assertFailure $ "expected parse error\n but got: " ++ show v2+assertParse _ (Just v) (Left e) = assertFailure $ "expected succesful parse: " ++ show v ++ "\n but got error: " ++ e+assertParse desc (Just v) (Right v2) = assertEqual desc v v2++testSimple = testGroup "simple" $ map tcase+ [ T "()" (Just $ List [])+ , T "42" (Just $ Number 42)+ , T ";;foo\n42" (Just $ Number 42)+ , T ";;foo\n;;bar\n42" (Just $ Number 42)+ , T "(4 5 6)" (Just $ List [Number 4, Number 5, Number 6])+ , T "(4 5 6 )" (Just $ List [Number 4, Number 5, Number 6])+ , T "(3 (4))" (Just $ List [Number 3, List [Number 4]])+ , T "'(3 4)" (Just $ List [Symbol "quote", List [Number 3, Number 4]])+ , T "\"a; however, b\"" (Just $ String "a; however, b")+ , T "(x ;comment\ny)" (Just $ List [Symbol "x", Symbol "y"]) , T "\"foo\"" (Just (String "foo"))+ , T "foo" (Just (Symbol "foo"))+ , T "(foo \"bar\" 23)" (Just $ List [Symbol "foo", String "bar", Number 23])+ -- this will have to do for now; no proper support/representation for escapes+ -- so the idea is that we try to return it completely unprocessed+ ]++testTokens = testGroup "tokens"+ [ testGroup "bare" $ map tcase symbols+ , testGroup "KEYWORD" $ map (tcase . addPkg "" ) symbols+ , testGroup "intern" $ map (tcase . addPkg "foo") symbols+ , testGroup "extern" $ map (tcase . addPkg "foo:") symbols+ , testGroup "intern-esc" $ map (tcase . addPkg "|foo|") symbols+ -- TODO: what's the right behaviour when we have package prefixes here?+ , tcase $ T "+1" (Just (Number 1)) -- This is the integer 1, not a symbol.+ ]++symbols =+ [ T "xyz\\," (Just (Symbol "xyz\\,")) -- ideally, something more like 'xyz',+ , T "\\n" (Just (Symbol "\\n")) -- NB: actually backslash-n, not newline!+ -- ideally, something more like 'n',+ , T "|foO|" (Just (Symbol "|foO|")) -- ideally, something more like 'foO'+ , T "|f,o|" (Just (Symbol "|f,o|")) -- ideally, something more like 'f,o'+ , T "|f\\|x|" (Just (Symbol "|f\\|x|")) -- ideally, something more like 'f|x'+ , T "|f\\|" Nothing+ -- From the HyperSpec+ -- Note that instead of interpreting case, we aim here to preserve all the+ -- characters in the token (including the escapes)+ -- http://www.lispworks.com/documentation/HyperSpec/Body/02_cd.htm+ , T "FROBBOZ" (Just (Symbol "FROBBOZ")) -- The symbol whose name is FROBBOZ.+ , T "frobboz" (Just (Symbol "frobboz")) -- Another way to notate the same symbol.+ , T "fRObBoz" (Just (Symbol "fRObBoz")) -- Yet another way to notate it.+ , T "unwind-protect" (Just (Symbol "unwind-protect")) -- A symbol with a hyphen in its name.+ , T "+$" (Just (Symbol "+$")) -- The symbol named +$.+ -- TODO: :-(; tricky!+ -- , T "1+" (Just (Symbol "1+")) -- The symbol named 1+.+ , T "pascal_style" (Just (Symbol "pascal_style")) -- This symbol has an underscore in its name.+ , T "file.rel.43" (Just (Symbol "file.rel.43")) -- This symbol has periods in its name.+ , T "\\(" (Just (Symbol "\\(")) -- The symbol whose name is (.+ , T "\\+1" (Just (Symbol "\\+1")) -- The symbol whose name is +1.+ , T "+\\1" (Just (Symbol "+\\1")) -- Also the symbol whose name is +1.+ , T "\\frobboz" (Just (Symbol "\\frobboz")) -- The symbol whose name is fROBBOZ.+ -- TODO: :-( tricky!+ -- , T "3.14159265\\s0" (Just (Symbol "3.14159265\\s0")) -- The symbol whose name is 3.14159265s0.+ -- , T "3.14159265\\S0" (Just (Symbol "3.14159265\\S0")) -- A different symbol, whose name is 3.14159265S0.+ -- , T "3.14159265s0" (Just (Symbol "3.14159265s0")) -- A possible short float approximation to <PI>.+ , T "APL\\\\360" (Just (Symbol "APL\\\\360")) -- The symbol whose name is APL\360.+ , T "apl\\\\360" (Just (Symbol "apl\\\\360")) -- Also the symbol whose name is APL\360.+ , T "\\(b^2\\)\\-\\4*a*c" (Just (Symbol "\\(b^2\\)\\-\\4*a*c")) -- The name is (B^2) - 4*A*C.+ -- Parentheses and two spaces in it.+ , T "\\(\\b^2\\)\\-\\4*\\a*\\c" (Just (Symbol "\\(\\b^2\\)\\-\\4*\\a*\\c")) -- The name is (b^2) - 4*a*c.+ -- Letters explicitly lowercase.+ , T "|\"|" (Just (Symbol "|\"|")) -- The same as writing \".+ , T "|(b^2) - 4*a*c|" (Just (Symbol "|(b^2) - 4*a*c|")) -- The name is (b^2) - 4*a*c.+ , T "|frobboz|" (Just (Symbol "|frobboz|")) -- The name is frobboz, not FROBBOZ.+ , T "|APL\\360|" (Just (Symbol "|APL\\360|")) -- The name is APL360.+ , T "|APL\\\\360|" (Just (Symbol "|APL\\\\360|")) -- The name is APL\360.+ , T "|apl\\\\360|" (Just (Symbol "|apl\\\\360|")) -- The name is apl\360.+ , T "|\\|\\||" (Just (Symbol "|\\|\\||")) -- Same as \|\| ---the name is ||.+ , T "|(B^2) - 4*A*C|" (Just (Symbol "|(B^2) - 4*A*C|")) -- The name is (B^2) - 4*A*C.+ -- Parentheses and two spaces in it.+ , T "|(b^2) - 4*a*c|" (Just (Symbol "|(b^2) - 4*a*c|")) -- The name is (b^2) - 4*a*c.+ ]++addPkg p t = t { tin = BC.concat [ p, ":", tin t ]+ , tout = tweak (tout t)+ }+ where+ tweak Nothing = Nothing+ tweak (Just (Symbol x)) = Just . Symbol $ T.concat [T.decodeUtf8 p, ":", x]+ tweak (Just x) = Nothing