s-cargot 0.1.1.1 → 0.1.2.0

raw patch · 9 files changed

+234/−48 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/SCargot/Atom.hs +40/−0
• Data/SCargot/Comments.hs +2/−2
• Data/SCargot/Common.hs +38/−6
• Data/SCargot/Language/HaskLike.hs +26/−15
• Data/SCargot/Repr/Basic.hs +10/−0
• Data/SCargot/Repr/Rich.hs +10/−0
• Data/SCargot/Repr/WellFormed.hs +8/−0
• s-cargot.cabal +2/−1
• test/SCargotQC.hs +98/−24

@@ -0,0 +1,40 @@+module Data.SCargot.Atom+  ( -- $intro++    atom+  , mkAtomParser+  ) where++import Data.SCargot.Parse (SExprParser, mkParser)+import Data.SCargot.Repr (SExpr)+import Text.Parsec (choice)+import Text.Parsec.Text (Parser)++-- | A convenience function for defining an atom parser from a wrapper+--   function and a parser. This is identical to 'fmap' specialized to+--   operate over 'Parser' values, and is provided as sugar.+atom :: (t -> atom) -> Parser t -> Parser atom+atom = fmap++-- | A convenience function for defining a 'SExprSpec' from a list of+--   possible atom parsers, which will be tried in sequence before failing.+mkAtomParser :: [Parser atom] -> SExprParser atom (SExpr atom)+mkAtomParser = mkParser . choice++{- $intro++This module defines small convenience functions for building an atom+type from several individual parsers. This is easy to do without these+functions, but these functions communicate intent more directly:++> data Atom+>   = Ident Text+>   | Num Integer+>+> myParser :: SExprParser Atom (SExpr Atom)+> myParser = mkAtomParser+>   [ atom Ident parseR7RSIdent+>   , atom Num   signedDecNumber+>   ]++-}

@@ -48,8 +48,8 @@ lineComment :: String -> Comment lineComment s = string s >> skipMany (noneOf "\n") >> return () --- | Given two strings, a begin and an end delimeter, produce a---   parser that matches the beginning delimeter and then ignores+-- | Given two strings, a begin and an end delimiter, produce a+--   parser that matches the beginning delimiter and then ignores --   everything until it finds the end delimiter. This does not --   consider nesting, so, for example, a comment created with --

@@ -22,11 +22,15 @@                            , signedDozNumber                            , hexNumber                            , signedHexNumber+                             -- ** Numeric Literals for Arbitrary Bases+                           , commonLispNumberAnyBase+                           , gnuM4NumberAnyBase                            ) where  #if !MIN_VERSION_base(4,8,0) import Control.Applicative hiding ((<|>), many) #endif+import           Control.Monad (guard) import           Data.Char import           Data.Text (Text) import qualified Data.Text as T@@ -215,16 +219,44 @@ number base digits = foldl go 0 <$> many1 digits   where go x d = base * x + toInteger (value d)         value c-          | c == 'a' || c == 'A' = 0xa-          | c == 'b' || c == 'B' = 0xb-          | c == 'c' || c == 'C' = 0xc-          | c == 'd' || c == 'D' = 0xd-          | c == 'e' || c == 'E' = 0xe-          | c == 'f' || c == 'F' = 0xf+          | c >= 'a' && c <= 'z' = 0xa + (fromEnum c - fromEnum 'a')+          | c >= 'A' && c <= 'Z' = 0xa + (fromEnum c - fromEnum 'A')           | c >= '0' && c <= '9' = fromEnum c - fromEnum '0'           | c == '\x218a' = 0xa           | c == '\x218b' = 0xb           | otherwise = error ("Unknown letter in number: " ++ show c)++digitsFor :: Int -> [Char]+digitsFor n+  | n <= 10   = take n ['0'..'9']+  | n <= 36   = take (n-10) ['A'..'Z'] ++ take (n-10) ['a'..'z'] ++ ['0'..'9']+  | otherwise = error ("Invalid base for parser: " ++ show n)++anyBase :: Integer -> Parser Integer+anyBase n = number n (oneOf (digitsFor (fromIntegral n)))++-- | A parser for Common Lisp's arbitrary-base number syntax, of+--   the form @#[base]r[number]@, where the base is given in+--   decimal. Note that this syntax begins with a @#@, which+--   means it might conflict with defined reader macros.+commonLispNumberAnyBase :: Parser Integer+commonLispNumberAnyBase = do+  _ <- char '#'+  n <- decNumber+  guard (n >= 2 && n <= 36)+  _ <- char 'r'+  signed (anyBase n)++-- | A parser for GNU m4's arbitrary-base number syntax, of+--   the form @0r[base]:[number]@, where the base is given in+--   decimal.+gnuM4NumberAnyBase :: Parser Integer+gnuM4NumberAnyBase = do+  _ <- string "0r"+  n <- decNumber+  guard (n >= 2 && n <= 36)+  _ <- char ':'+  signed (anyBase n)  sign :: Num a => Parser (a -> a) sign =  (pure id     <* char '+')

@@ -5,6 +5,10 @@     HaskLikeAtom(..)   , haskLikeParser   , haskLikePrinter+    -- * Individual Parsers+  , parseHaskellString+  , parseHaskellFloat+  , parseHaskellInt   ) where  #if !MIN_VERSION_base(4,8,0)@@ -24,12 +28,13 @@  {- $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 spec. It does __not__ natively understand other-data types, such as booleans, vectors, bitstrings.+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.  -} @@ -51,8 +56,10 @@ instance IsString HaskLikeAtom where   fromString = HSIdent . fromString -pString :: Parser Text-pString = pack . catMaybes <$> between (char '"') (char '"') (many (val <|> esc))+-- | Parse a Haskell string literal as defined by the Haskell 2010+-- language specification.+parseHaskellString :: Parser Text+parseHaskellString = pack . catMaybes <$> between (char '"') (char '"') (many (val <|> esc))   where val = Just <$> satisfy (\ c -> c /= '"' && c /= '\\' && c > '\026')         esc = do _ <- char '\\'                  Nothing <$ (gap <|> char '&') <|>@@ -81,8 +88,10 @@    "\STX\ETX\EOT\ENQ\ACK\BEL\DLE\DC1\DC2\DC3\DC4\NAK" ++    "\SYN\ETB\CAN\SUB\ESC\DEL") -pFloat :: Parser Double-pFloat = do+-- | Parse a Haskell floating-point number as defined by the Haskell+-- 2010 language specification.+parseHaskellFloat :: Parser Double+parseHaskellFloat = do   n <- decNumber   withDot n <|> noDot n   where withDot n = do@@ -105,8 +114,10 @@ power :: Num a => Parser (a -> a) power = negate <$ char '-' <|> id <$ char '+' <|> return id -pInt :: Parser Integer-pInt = do+-- | Parse a Haskell integer literal as defined by the Haskell 2010+-- language specification.+parseHaskellInt :: Parser Integer+parseHaskellInt = do   s <- power   n <- pZeroNum <|> decNumber   return (fromIntegral (s n))@@ -121,9 +132,9 @@  pHaskLikeAtom :: Parser HaskLikeAtom pHaskLikeAtom-   =  HSFloat   <$> (try pFloat     <?> "float")-  <|> HSInt     <$> (try pInt       <?> "integer")-  <|> HSString  <$> (pString        <?> "string literal")+   =  HSFloat   <$> (try parseHaskellFloat <?> "float")+  <|> HSInt     <$> (try parseHaskellInt   <?> "integer")+  <|> HSString  <$> (parseHaskellString    <?> "string literal")   <|> HSIdent   <$> (parseR5RSIdent <?> "token")  sHaskLikeAtom :: HaskLikeAtom -> Text

@@ -88,28 +88,36 @@ -- -- >>> A "pachy" ::: A "derm" -- SCons (SAtom "pachy") (SAtom "derm")+#if MIN_VERSION_base(4,8,0) pattern (:::) :: SExpr a -> SExpr a -> SExpr a+#endif pattern x ::: xs = SCons x xs  -- | A shorter alias for `SAtom` -- -- >>> A "elephant" -- SAtom "elephant"+#if MIN_VERSION_base(4,8,0) pattern A :: a -> SExpr a+#endif pattern A x = SAtom x  -- | A (slightly) shorter alias for `SNil` -- -- >>> Nil -- SNil+#if MIN_VERSION_base(4,8,0) pattern Nil :: SExpr a+#endif pattern Nil = SNil  -- | An alias for matching a proper list. -- -- >>> L [A "pachy", A "derm"] -- SExpr (SAtom "pachy") (SExpr (SAtom "derm") SNil)+#if MIN_VERSION_base(4,8,0) pattern L :: [SExpr a] -> SExpr a+#endif pattern L xs <- (gatherList -> Right xs) #if MIN_VERSION_base(4,8,0)   where L []     = SNil@@ -121,7 +129,9 @@ -- -- >>> DL [A "pachy"] A "derm" -- SExpr (SAtom "pachy") (SAtom "derm")+#if MIN_VERSION_base(4,8,0) pattern DL :: [SExpr a] -> a -> SExpr a+#endif pattern DL xs x <- (gatherDList -> Just (xs, x)) #if MIN_VERSION_base(4,8,0)   where DL []     a = SAtom a

@@ -107,7 +107,9 @@ -- -- >>> A "one" ::: L [A "two", A "three"] -- RSList [RSAtom "one",RSAtom "two",RSAtom "three"]+#if MIN_VERSION_base(4,8,0) pattern (:::) :: RichSExpr a -> RichSExpr a -> RichSExpr a+#endif pattern x ::: xs <- (uncons -> Just (x, xs)) #if MIN_VERSION_base(4,8,0)   where x ::: xs = cons x xs@@ -117,28 +119,36 @@ -- -- >>> A "elephant" -- RSAtom "elephant"+#if MIN_VERSION_base(4,8,0) pattern A :: a -> RichSExpr a+#endif pattern A a = R.RSAtom a  -- | A shorter alias for `RSList` -- -- >>> L [A "pachy", A "derm"] -- RSList [RSAtom "pachy",RSAtom "derm"]+#if MIN_VERSION_base(4,8,0) pattern L :: [RichSExpr a] -> RichSExpr a+#endif pattern L xs = R.RSList xs  -- | A shorter alias for `RSDotted` -- -- >>> DL [A "pachy"] "derm" -- RSDotted [RSAtom "pachy"] "derm"+#if MIN_VERSION_base(4,8,0) pattern DL :: [RichSExpr a] -> a -> RichSExpr a+#endif pattern DL xs x = R.RSDotted xs x  -- | A shorter alias for `RSList` @[]@ -- -- >>> Nil -- RSList []+#if MIN_VERSION_base(4,8,0) pattern Nil :: RichSExpr a+#endif pattern Nil = R.RSList []  -- | Utility function for parsing a pair of things: this parses a two-element list,

@@ -59,28 +59,36 @@ --   instead. -- -- >>> let sum (x ::: xs) = x + sum xs; sum Nil = 0+#if MIN_VERSION_base(4,8,0) pattern (:::) :: WellFormedSExpr a -> WellFormedSExpr a -> WellFormedSExpr a+#endif pattern x ::: xs <- (uncons -> Just (x, xs))  -- | A shorter alias for `WFSList` -- -- >>> L [A "pachy", A "derm"] -- WFSList [WFSAtom "pachy",WFSAtom "derm"]+#if MIN_VERSION_base(4,8,0) pattern L :: [WellFormedSExpr t] -> WellFormedSExpr t+#endif pattern L xs = R.WFSList xs  -- | A shorter alias for `WFSAtom` -- -- >>> A "elephant" -- WFSAtom "elephant"+#if MIN_VERSION_base(4,8,0) pattern A :: t -> WellFormedSExpr t+#endif pattern A a  = R.WFSAtom a  -- | A shorter alias for `WFSList` @[]@ -- -- >>> Nil -- WFSList []+#if MIN_VERSION_base(4,8,0) pattern Nil :: WellFormedSExpr t+#endif pattern Nil = R.WFSList []  getShape :: WellFormedSExpr a -> String

@@ -1,5 +1,5 @@ name:                s-cargot-version:             0.1.1.1+version:             0.1.2.0 synopsis:            A flexible, extensible s-expression library. homepage:            https://github.com/aisamanra/s-cargot description:         S-Cargot is a library for working with s-expressions in@@ -35,6 +35,7 @@                        Data.SCargot.Repr.WellFormed,                        Data.SCargot.Parse,                        Data.SCargot.Print,+                       Data.SCargot.Atom,                        Data.SCargot.Comments,                        Data.SCargot.Common,                        Data.SCargot.Language.Basic,

@@ -1,29 +1,20 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -module Data.SCargot.ReprQC (reprQC) where+module Main where -import Data.SCargot ( SExprParser-                    , SExprPrinter-                    , mkParser-                    , flatPrint-                    , encodeOne-                    , decodeOne-                    , asRich-                    , asWellFormed-                    )-import Data.SCargot.Repr ( SExpr(..)-                         , RichSExpr-                         , fromRich-                         , toRich-                         , WellFormedSExpr(..)-                         , fromWellFormed-                         , toWellFormed-                         )-import Test.QuickCheck-import Test.QuickCheck.Arbitrary-import Text.Parsec (char)-import Text.Parsec.Text (Parser)+import Data.SCargot+import Data.SCargot.Comments+import Data.SCargot.Repr +import           Data.Monoid ((<>))+import           Data.Text (Text)+import qualified Data.Text as T+import           Test.QuickCheck+import           Test.QuickCheck.Arbitrary+import           Text.Parsec (char)+import           Text.Parsec.Text (Parser)+ instance Arbitrary a => Arbitrary (SExpr a) where   arbitrary = sized $ \n ->     if n <= 0@@ -54,12 +45,35 @@                 ]           ] +data EncodedSExpr = EncodedSExpr+  { encoding :: Text+  , original :: SExpr ()+  } deriving (Eq, Show)++instance Arbitrary EncodedSExpr where+  arbitrary = do+    sexpr :: SExpr () <- arbitrary+    let chunks = T.words (encodeOne printer sexpr)+    whitespace <- sequence [ mkWs | _ <- chunks ]+    pure (EncodedSExpr { encoding = T.concat (zipWith (<>) chunks whitespace)+                       , original = sexpr+                       })+    where mkWs = do+            n :: Int <- choose (1, 10)+            T.pack <$> sequence [ elements " \t\r\n"+                                | _ <- [0..n]+                                ]+ parser :: SExprParser () (SExpr ()) parser = mkParser (() <$ char 'X')  printer :: SExprPrinter () (SExpr ()) printer = flatPrint (const "X") +prettyPrinter :: SExprPrinter () (SExpr ())+prettyPrinter = basicPrint (const "X")++ richIso :: SExpr () -> Bool richIso s = fromRich (toRich s) == s @@ -79,23 +93,83 @@ encDec :: SExpr () -> Bool encDec s = decodeOne parser (encodeOne printer s) == Right s +encDecPretty :: SExpr () -> Bool+encDecPretty s = decodeOne parser (encodeOne prettyPrinter s) == Right s++decEnc :: EncodedSExpr -> Bool+decEnc s = decodeOne parser (encoding s) == Right (original s)++ encDecRich :: RichSExpr () -> Bool encDecRich s = decodeOne (asRich parser) (encodeOne printer (fromRich s))                 == Right s +encDecRichPretty :: RichSExpr () -> Bool+encDecRichPretty s = decodeOne (asRich parser)+                               (encodeOne prettyPrinter (fromRich s))+                       == Right s++decEncRich :: EncodedSExpr -> Bool+decEncRich s = decodeOne (asRich parser) (encoding s) == Right (toRich (original s))++ encDecWF :: WellFormedSExpr () -> Bool encDecWF s = decodeOne (asWellFormed parser) (encodeOne printer (fromWellFormed s))                == Right s -reprQC :: IO ()-reprQC = do+encDecWFPretty :: WellFormedSExpr () -> Bool+encDecWFPretty s =+  decodeOne (asWellFormed parser) (encodeOne prettyPrinter (fromWellFormed s))+    == Right s++decEncWF :: EncodedSExpr -> Bool+decEncWF s = decodeOne (asWellFormed parser) (encoding s) == toWellFormed (original s)+++insertComments :: Text -> Text -> Text -> Text+insertComments lc rc sexpr =+  T.replace " " (" " <> lc <> "blahblahblah" <> rc <> " ") sexpr++encDecLineComments :: SExpr () -> Bool+encDecLineComments s =+  decodeOne (withLispComments parser)+            (insertComments ";" "\n" (encodeOne printer s)) == Right s++encDecBlockComments :: SExpr () -> Bool+encDecBlockComments s =+  decodeOne (withHaskellBlockComments parser)+            (insertComments "{-" "-}" (encodeOne printer s)) == Right s++-- Sometimes we generate really huge test cases, which can take a really+-- long time to process---especially when we're modifying the whitespace+-- to produce weird anomalous S-expressions. So, we make the size parameter+-- a bit smaller for good measure.+reallyQuickCheck :: Testable prop => prop -> IO ()+reallyQuickCheck = quickCheckWith stdArgs { maxSize = 25 }++main :: IO ()+main = do   putStrLn "The SExpr <--> Rich translation should be isomorphic"   quickCheck richIso   quickCheck richIsoBk+   putStrLn "The SExpr <--> WF translation should be near-isomorphic"   quickCheck wfIso   quickCheck wfIsoBk+   putStrLn "This should be true when parsing, as well"   quickCheck encDec+  reallyQuickCheck decEnc   quickCheck encDecRich+  reallyQuickCheck decEncRich   quickCheck encDecWF+  reallyQuickCheck decEncWF++  putStrLn "And it should be true if pretty-printed"+  reallyQuickCheck encDecPretty+  reallyQuickCheck encDecRichPretty+  reallyQuickCheck encDecWFPretty++  putStrLn "Comments should not affect parsing"+  reallyQuickCheck encDecLineComments+  reallyQuickCheck encDecBlockComments