s-cargot 0.1.2.0 → 0.1.3.0
raw patch · 9 files changed
+871/−58 lines, 9 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Data.SCargot: unconstrainedPrint :: (atom -> Text) -> SExprPrinter atom (SExpr atom)
+ Data.SCargot.Common: At :: !Location -> a -> Located a
+ Data.SCargot.Common: Span :: !SourcePos -> !SourcePos -> Location
+ Data.SCargot.Common: dLocation :: Location
+ Data.SCargot.Common: data Located a
+ Data.SCargot.Common: data Location
+ Data.SCargot.Common: instance GHC.Classes.Eq Data.SCargot.Common.Location
+ Data.SCargot.Common: instance GHC.Classes.Eq a => GHC.Classes.Eq (Data.SCargot.Common.Located a)
+ Data.SCargot.Common: instance GHC.Classes.Ord Data.SCargot.Common.Location
+ Data.SCargot.Common: instance GHC.Classes.Ord a => GHC.Classes.Ord (Data.SCargot.Common.Located a)
+ Data.SCargot.Common: instance GHC.Show.Show Data.SCargot.Common.Location
+ Data.SCargot.Common: instance GHC.Show.Show a => GHC.Show.Show (Data.SCargot.Common.Located a)
+ Data.SCargot.Common: located :: Parser a -> Parser (Located a)
+ Data.SCargot.Language.Basic: locatedBasicParser :: SExprParser (Located Text) (SExpr (Located Text))
+ Data.SCargot.Language.Basic: locatedBasicPrinter :: SExprPrinter (Located Text) (SExpr (Located Text))
+ Data.SCargot.Language.HaskLike: instance Data.String.IsString (Data.SCargot.Common.Located Data.SCargot.Language.HaskLike.HaskLikeAtom)
+ Data.SCargot.Language.HaskLike: locatedHaskLikeParser :: SExprParser (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
+ Data.SCargot.Language.HaskLike: locatedHaskLikePrinter :: SExprPrinter (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
+ Data.SCargot.Print: unconstrainedPrint :: (atom -> Text) -> SExprPrinter atom (SExpr atom)
- Data.SCargot: type Reader atom = Parser (SExpr atom) -> Parser (SExpr atom)
+ Data.SCargot: type Reader atom = (Parser (SExpr atom) -> Parser (SExpr atom))
- Data.SCargot.Parse: type Reader atom = Parser (SExpr atom) -> Parser (SExpr atom)
+ Data.SCargot.Parse: type Reader atom = (Parser (SExpr atom) -> Parser (SExpr atom))
Files
- CHANGELOG.md +39/−0
- Data/SCargot.hs +1/−0
- Data/SCargot/Common.hs +27/−0
- Data/SCargot/Language/Basic.hs +30/−1
- Data/SCargot/Language/HaskLike.hs +31/−0
- Data/SCargot/Print.hs +248/−49
- README.md +464/−0
- s-cargot.cabal +6/−4
- test/SCargotQC.hs +25/−4
+ CHANGELOG.md view
@@ -0,0 +1,39 @@+v0.1.3.0+=======++Features:++* Added the `Located` type for source location tracking for `atom`+ values (thanks ckoparkar!)+* Added `unconstrainedPrint`, which does not try to restrict a printed+ s-expression to a fixed width but will attempt to indent it in a+ reasonable way nonetheless.++Fixes:++* Pretty-printing configurations created with `flatPrint` now use a+ _much_ more efficient pretty-printer.+* Internally, pretty-printers use a richer type which improves+ performance somewhat by cutting down on repeated intermediate+ printing, and future work will build on this to make printing even+ more efficient.++v0.1.2.0+=======++* Added `atom` and `mkAtomParser` helper functions for new+ user-defined atom types.+* New parsers for various atom types:+ * Exported parsers for individual Haskell literals, to allow+ building new variations on the `HaskLike` atom type.+ * Added syntaxes for arbitrary-base numeric literals in the style of+ Common Lisp and M4+* Added a suite of basic QuickCheck tests+* Compatibility fix: GHC 7.8 didn't allow type signatures on pattern+ synonyms.+++v0.1.1.0+=======++* Strongly considered but did not keep a changelog. …sorry.
Data/SCargot.hs view
@@ -26,6 +26,7 @@ , Indent(..) , basicPrint , flatPrint+ , unconstrainedPrint , setFromCarrier , setMaxWidth , removeMaxWidth
Data/SCargot/Common.hs view
@@ -25,6 +25,8 @@ -- ** Numeric Literals for Arbitrary Bases , commonLispNumberAnyBase , gnuM4NumberAnyBase+ -- ** Source locations+ , Location(..), Located(..), located, dLocation ) where #if !MIN_VERSION_base(4,8,0)@@ -35,6 +37,7 @@ import Data.Text (Text) import qualified Data.Text as T import Text.Parsec+import Text.Parsec.Pos (newPos) import Text.Parsec.Text (Parser) -- | Parse an identifier according to the R5RS Scheme standard. This@@ -331,6 +334,30 @@ -- | A parser for signed hexadecimal numbers, with an optional leading @+@ or @-@. signedHexNumber :: Parser Integer signedHexNumber = ($) <$> sign <*> hexNumber+++-- |+data Location = Span !SourcePos !SourcePos+ deriving (Eq, Ord, Show)++-- | Add support for source locations while parsing S-expressions, as described in this+-- <https://www.reddit.com/r/haskell/comments/4x22f9/labelling_ast_nodes_with_locations/d6cmdy9/ Reddit>+-- thread.+data Located a = At !Location a+ deriving (Eq, Ord, Show)++-- | Adds a source span to a parser.+located :: Parser a -> Parser (Located a)+located parser = do+ begin <- getPosition+ result <- parser+ end <- getPosition+ return $ At (Span begin end) result++-- | A default location value+dLocation :: Location+dLocation = Span dPos dPos+ where dPos = newPos "" 0 0 {- $intro
Data/SCargot/Language/Basic.hs view
@@ -5,13 +5,18 @@ -- $descr basicParser , basicPrinter+ , locatedBasicParser+ , locatedBasicPrinter ) where import Control.Applicative ((<$>)) import Data.Char (isAlphaNum) import Text.Parsec (many1, satisfy) import Data.Text (Text, pack)+import Data.Functor.Identity (Identity)+import Text.Parsec.Prim (ParsecT) +import Data.SCargot.Common (Located(..), located) import Data.SCargot.Repr.Basic (SExpr) import Data.SCargot ( SExprParser , SExprPrinter@@ -25,6 +30,9 @@ || c == '+' || c == '<' || c == '>' || c == '=' || c == '!' || c == '?' +pToken :: ParsecT Text a Identity Text+pToken = pack <$> many1 (satisfy isAtomChar)+ -- $descr -- The 'basicSpec' describes S-expressions whose atoms are simply -- text strings that contain alphanumeric characters and a small@@ -43,8 +51,17 @@ -- Right [SCons (SAtom "1") (SCons (SAtom "elephant") SNil)] basicParser :: SExprParser Text (SExpr Text) basicParser = mkParser pToken- where pToken = pack <$> many1 (satisfy isAtomChar) +-- | A 'basicParser' which produces 'Located' values+--+-- >>> decode locatedBasicParser $ pack "(1 elephant)"+-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) "1")) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) "elephant")) SNil)]+--+-- >>> decode locatedBasicParser $ pack "(let ((x 1))\n x)"+-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 5)) "let")) (SCons (SCons (SCons (SAtom (At (Span (line 1, column 8) (line 1, column 9)) "x")) (SCons (SAtom (At (Span (line 1, column 10) (line 1, column 11)) "1")) SNil)) SNil) (SCons (SAtom (At (Span (line 2, column 3) (line 2, column 4)) "x")) SNil))]+locatedBasicParser :: SExprParser (Located Text) (SExpr (Located Text))+locatedBasicParser = mkParser $ located pToken+ -- | A 'SExprPrinter' that prints textual atoms directly (without quoting -- or any other processing) onto a single line. --@@ -52,3 +69,15 @@ -- "(1 elephant)" basicPrinter :: SExprPrinter Text (SExpr Text) basicPrinter = flatPrint id++-- | A 'SExprPrinter' for 'Located' values. Works exactly like 'basicPrinter'+-- It ignores the location tags when printing the result.+--+-- >>> let (Right dec) = decode locatedBasicParser $ pack "(1 elephant)"+-- [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) "1")) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) "elephant")) SNil)]+--+-- >>> encode locatedBasicPrinter dec+-- "(1 elephant)"+locatedBasicPrinter :: SExprPrinter (Located Text) (SExpr (Located Text))+locatedBasicPrinter = flatPrint unLoc+ where unLoc (At _loc e) = e
Data/SCargot/Language/HaskLike.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Data.SCargot.Language.HaskLike@@ -5,6 +6,8 @@ HaskLikeAtom(..) , haskLikeParser , haskLikePrinter+ , locatedHaskLikeParser+ , locatedHaskLikePrinter -- * Individual Parsers , parseHaskellString , parseHaskellFloat@@ -56,6 +59,9 @@ instance IsString HaskLikeAtom where fromString = HSIdent . fromString +instance IsString (Located HaskLikeAtom) where+ fromString = (At dLocation) . HSIdent . fromString+ -- | Parse a Haskell string literal as defined by the Haskell 2010 -- language specification. parseHaskellString :: Parser Text@@ -157,6 +163,16 @@ haskLikeParser :: SExprParser HaskLikeAtom (SExpr HaskLikeAtom) haskLikeParser = mkParser 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 = mkParser $ located 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@@ -167,3 +183,18 @@ -- "(1 \"elephant\")" haskLikePrinter :: SExprPrinter HaskLikeAtom (SExpr HaskLikeAtom) haskLikePrinter = flatPrint sHaskLikeAtom++-- | Ignore location tags when packing values into text+sLocatedHasklikeAtom :: Located HaskLikeAtom -> Text+sLocatedHasklikeAtom (At _loc e) = sHaskLikeAtom 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 = flatPrint sLocatedHasklikeAtom
Data/SCargot/Print.hs view
@@ -17,14 +17,21 @@ -- * Default Printing Strategies , basicPrint , flatPrint+ , unconstrainedPrint ) where +import qualified Data.Foldable as F import Data.Monoid ((<>))+import qualified Data.Sequence as Seq import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as B+import qualified Data.Traversable as T import Data.SCargot.Repr + -- | The 'Indent' type is used to determine how to indent subsequent -- s-expressions in a list, after printing the head of the list. data Indent@@ -52,6 +59,7 @@ -- > quux) deriving (Eq, Show) + -- | A 'SExprPrinter' value describes how to print a given value as an -- s-expression. The @carrier@ type parameter indicates the value -- that will be printed, and the @atom@ parameter indicates the type@@ -67,12 +75,16 @@ , indentAmount :: Int -- ^ How much to indent after a swung indentation. , maxWidth :: Maybe Int- -- ^ The maximum width (if any) If this is 'None' then- -- the resulting s-expression will always be printed- -- on a single line.+ -- ^ The maximum width (if any) If this is 'None' then the+ -- resulting s-expression might be printed on one line (if+ -- 'indentPrint' is 'False') and might be pretty-printed in+ -- the most naive way possible (if 'indentPrint' is 'True').+ , indentPrint :: Bool+ -- ^ Whether to indent or not. This has been retrofitted onto } --- | A default 'LayoutOptions' struct that will always print a 'SExpr'++-- | A default 'SExprPrinter' struct that will always print a 'SExpr' -- as a single line. flatPrint :: (atom -> Text) -> SExprPrinter atom (SExpr atom) flatPrint printer = SExprPrinter@@ -81,11 +93,12 @@ , swingIndent = const Swing , indentAmount = 2 , maxWidth = Nothing+ , indentPrint = False } --- | A default 'LayoutOptions' struct that will always swing subsequent+-- | A default 'SExprPrinter' struct that will always swing subsequent -- expressions onto later lines if they're too long, indenting them--- by two spaces.+-- by two spaces, and uses a soft maximum width of 80 characters basicPrint :: (atom -> Text) -> SExprPrinter atom (SExpr atom) basicPrint printer = SExprPrinter { atomPrinter = printer@@ -93,8 +106,144 @@ , swingIndent = const Swing , indentAmount = 2 , maxWidth = Just 80+ , indentPrint = True } +-- | A default 'SExprPrinter' struct that will always swing subsequent+-- expressions onto later lines if they're too long, indenting them by+-- two spaces, but makes no effort to keep the pretty-printed sources+-- inside a maximum width. In the case that we want indented printing+-- but don't care about a "maximum" width, we can print more+-- efficiently than in other situations.+unconstrainedPrint :: (atom -> Text) -> SExprPrinter atom (SExpr atom)+unconstrainedPrint printer = SExprPrinter+ { atomPrinter = printer+ , fromCarrier = id+ , swingIndent = const Swing+ , indentAmount = 2+ , maxWidth = Nothing+ , indentPrint = True+ }++-- | This is an intermediate representation which is like (but not+-- identical to) a RichSExpr representation. In particular, it has a+-- special case for empty lists, and it also keeps a single piece of+-- indent information around for each list+data Intermediate+ = IAtom Text+ | IList Indent Intermediate (Seq.Seq Intermediate) (Maybe Text)+ | IEmpty+++toIntermediate :: SExprPrinter a (SExpr a) -> SExpr a -> Intermediate+toIntermediate+ SExprPrinter { atomPrinter = printAtom+ , swingIndent = swing+ } = headOf+ where+ headOf (SAtom a) = IAtom (printAtom a)+ headOf SNil = IEmpty+ headOf (SCons x xs) =+ gather (swing x) (headOf x) (Seq.empty) xs+ gather sw hd rs SNil =+ IList sw hd rs Nothing+ gather sw hd rs (SAtom a) =+ IList sw hd rs (Just (printAtom a))+ gather sw hd rs (SCons x xs) =+ gather sw hd (rs Seq.|> headOf x) xs+++unboundIndentPrintSExpr :: SExprPrinter a (SExpr a) -> SExpr a -> TL.Text+unboundIndentPrintSExpr spec = finalize . go . toIntermediate spec+ where+ finalize = B.toLazyText . F.foldMap (<> B.fromString "\n")++ go :: Intermediate -> Seq.Seq B.Builder+ go (IAtom t) = Seq.singleton (B.fromText t)+ go IEmpty = Seq.singleton (B.fromString "()")+ -- this case should never be called with an empty argument to+ -- @values@, as that should have been translated to @IEmpty@+ -- instead.+ go (IList iv initial values rest)+ -- if we're looking at an s-expression that has no nested+ -- s-expressions, then we might as well consider it flat and let+ -- it take the whole line+ | Just strings <- T.traverse ppBasic (initial Seq.<| values) =+ Seq.singleton (B.fromString "(" <> buildUnwords strings <> pTail rest)++ -- it's not "flat", so we might want to swing after the first thing+ | Swing <- iv =+ -- if this match fails, then it means we've failed to+ -- convert to an Intermediate correctly!+ let butLast = insertParen (go initial) <> fmap doIndent (F.foldMap go values)+ in handleTail rest butLast++ -- ...or after several things+ | SwingAfter n <- iv =+ let (hs, xs) = Seq.splitAt n (initial Seq.<| values)+ hd = B.fromString "(" <> buildUnwords (F.foldMap go hs)+ butLast = hd Seq.<| fmap doIndent (F.foldMap go xs)+ in handleTail rest butLast++ -- the 'align' choice is clunkier because we need to know how+ -- deep to indent, so we have to force the first builder to grab its size+ | otherwise =+ let -- so we grab that and figure out its length plus two (for+ -- the leading paren and the following space). This uses a+ -- max because it's possible the first thing is itself a+ -- multi-line s-expression (in which case it seems like+ -- using the Align strategy is a terrible idea, but who am+ -- I to quarrel with the wild fruits upon the Tree of+ -- Life?)+ len = 2 + F.maximum (fmap (TL.length . B.toLazyText) (go initial))+ in case Seq.viewl values of+ -- if there's nothing after the head of the expression, then+ -- we simply close it+ Seq.EmptyL -> insertParen (insertCloseParen (go initial))+ -- otherwise, we put the first two things on the same line+ -- with spaces and everything else gets indended the+ -- forementioned length+ y Seq.:< ys ->+ let hd = B.fromString "(" <> buildUnwords (F.foldMap go (Seq.fromList [initial, y]))+ butLast = hd Seq.<| fmap (doIndentOf (fromIntegral len)) (F.foldMap go ys)+ in handleTail rest butLast+ -- B.fromString "(" <> buildUnwords (F.foldMap go (Seq.fromList [x, y]))+ -- Seq.<| fmap (doIndentOf (fromIntegral len)) (handleTail rest (F.foldMap go ys))++ doIndent :: B.Builder -> B.Builder+ doIndent = doIndentOf (indentAmount spec)++ doIndentOf :: Int -> B.Builder -> B.Builder+ doIndentOf n b = B.fromText (T.replicate n " ") <> b++ insertParen :: Seq.Seq B.Builder -> Seq.Seq B.Builder+ insertParen s = case Seq.viewl s of+ Seq.EmptyL -> s+ x Seq.:< xs -> (B.fromString "(" <> x) Seq.<| xs++ handleTail :: Maybe Text -> Seq.Seq B.Builder -> Seq.Seq B.Builder+ handleTail Nothing = insertCloseParen+ handleTail (Just t) =+ (Seq.|> (B.fromString "." <> B.fromText t <> B.fromString ")"))++ insertCloseParen :: Seq.Seq B.Builder -> Seq.Seq B.Builder+ insertCloseParen s = case Seq.viewr s of+ Seq.EmptyR -> Seq.singleton (B.fromString ")")+ xs Seq.:> x -> xs Seq.|> (x <> B.fromString ")")++ buildUnwords sq =+ case Seq.viewl sq of+ Seq.EmptyL -> mempty+ t Seq.:< ts -> t <> F.foldMap (\ x -> B.fromString " " <> x) ts++ pTail Nothing = B.fromString ")"+ pTail (Just t) = B.fromString ". " <> B.fromText t <> B.fromString ")"++ ppBasic (IAtom t) = Just (B.fromText t)+ ppBasic (IEmpty) = Just (B.fromString "()")+ ppBasic _ = Nothing++ -- | Modify the carrier type of a 'SExprPrinter' by describing how -- to convert the new type back to the previous type. For example, -- to pretty-print a well-formed s-expression, we can modify the@@ -106,6 +255,7 @@ setFromCarrier :: (c -> b) -> SExprPrinter a b -> SExprPrinter a c setFromCarrier fc pr = pr { fromCarrier = fromCarrier pr . fc } + -- | Dictate a maximum width for pretty-printed s-expressions. -- -- >>> let printer = setMaxWidth 8 (basicPrint id)@@ -114,6 +264,7 @@ setMaxWidth :: Int -> SExprPrinter atom carrier -> SExprPrinter atom carrier setMaxWidth n pr = pr { maxWidth = Just n } + -- | Allow the serialized s-expression to be arbitrarily wide. This -- makes all pretty-printing happen on a single line. --@@ -123,6 +274,7 @@ removeMaxWidth :: SExprPrinter atom carrier -> SExprPrinter atom carrier removeMaxWidth pr = pr { maxWidth = Nothing } + -- | Set the number of spaces that a subsequent line will be indented -- after a swing indentation. --@@ -134,6 +286,7 @@ setIndentAmount :: Int -> SExprPrinter atom carrier -> SExprPrinter atom carrier setIndentAmount n pr = pr { indentAmount = n } + -- | Dictate how to indent subsequent lines based on the leading -- subexpression in an s-expression. For details on how this works, -- consult the documentation of the 'Indent' type.@@ -147,27 +300,47 @@ setIndentStrategy :: (SExpr atom -> Indent) -> SExprPrinter atom carrier -> SExprPrinter atom carrier setIndentStrategy st pr = pr { swingIndent = st } --- Sort of like 'unlines' but without the trailing newline-joinLines :: [Text] -> Text-joinLines = T.intercalate "\n" -- Indents a line by n spaces indent :: Int -> Text -> Text indent n ts = T.replicate n " " <> ts ++-- Sort of like 'unlines' but without the trailing newline+joinLinesS :: Seq.Seq Text -> Text+joinLinesS s = case Seq.viewl s of+ Seq.EmptyL -> ""+ t Seq.:< ts+ | F.null ts -> t+ | otherwise -> t <> "\n" <> joinLinesS ts+++-- Sort of like 'unlines' but without the trailing newline+unwordsS :: Seq.Seq Text -> Text+unwordsS s = case Seq.viewl s of+ Seq.EmptyL -> ""+ t Seq.:< ts+ | F.null ts -> t+ | otherwise -> t <> " " <> joinLinesS ts++ -- Indents every line n spaces, and adds a newline to the beginning -- used in swung indents-indentAll :: Int -> [Text] -> Text-indentAll n = ("\n" <>) . joinLines . map (indent n)+indentAllS :: Int -> Seq.Seq Text -> Text+indentAllS n = ("\n" <>) . joinLinesS . fmap (indent n) + -- Indents every line but the first by some amount -- used in aligned indents-indentSubsequent :: Int -> [Text] -> Text-indentSubsequent _ [] = ""-indentSubsequent _ [t] = t-indentSubsequent n (t:ts) = joinLines (t : go ts)- where go = map (indent n)+indentSubsequentS :: Int -> Seq.Seq Text -> Text+indentSubsequentS n s = case Seq.viewl s of+ Seq.EmptyL -> ""+ t Seq.:< ts+ | F.null ts -> t+ | otherwise -> joinLinesS (t Seq.<| fmap (indent n) ts)+-- where go = fmap (indent n) + -- oh god this code is so disgusting -- i'm sorry to everyone i let down by writing this -- i swear i'll do better in the future i promise i have to@@ -176,39 +349,65 @@ -- | Pretty-print a 'SExpr' according to the options in a -- 'LayoutOptions' value. prettyPrintSExpr :: SExprPrinter a (SExpr a) -> SExpr a -> Text-prettyPrintSExpr SExprPrinter { .. } = pHead 0- where pHead _ SNil = "()"- pHead _ (SAtom a) = atomPrinter a- pHead ind (SCons x xs) = gather ind x xs id- gather ind h (SCons x xs) k = gather ind h xs (k . (x:))- gather ind h end k = "(" <> hd <> body <> tl <> ")"- where tl = case end of- SNil -> ""- SAtom a -> " . " <> atomPrinter a- SCons _ _ -> error "[unreachable]"- hd = indentSubsequent ind [pHead (ind+1) h]- lst = k []- flat = T.unwords (map (pHead (ind+1)) lst)- headWidth = T.length hd + 1- indented =- case swingIndent h of- SwingAfter n ->- let (l, ls) = splitAt n lst- t = T.unwords (map (pHead (ind+1)) l)- ts = indentAll (ind + indentAmount)- (map (pHead (ind + indentAmount)) ls)- in t <> ts- Swing ->- indentAll (ind + indentAmount)- (map (pHead (ind + indentAmount)) lst)- Align ->- indentSubsequent (ind + headWidth + 1)- (map (pHead (ind + headWidth + 1)) lst)- body- | length lst == 0 = ""- | Just maxAmt <- maxWidth- , T.length flat + ind > maxAmt = " " <> indented- | otherwise = " " <> flat+prettyPrintSExpr pr@SExprPrinter { .. } expr = case maxWidth of+ Nothing+ | indentPrint -> TL.toStrict (unboundIndentPrintSExpr pr (fromCarrier expr))+ | otherwise -> flatPrintSExpr (fmap atomPrinter (fromCarrier expr))+ Just _ -> indentPrintSExpr' pr expr+++indentPrintSExpr' :: SExprPrinter a (SExpr a) -> SExpr a -> Text+indentPrintSExpr' pr@SExprPrinter { .. } = pp 0 . toIntermediate pr+ where+ pp _ IEmpty = "()"+ pp _ (IAtom t) = t+ pp ind (IList i h values end) = "(" <> hd <> body <> tl <> ")"+ where+ tl = case end of+ Nothing -> ""+ Just x -> " . " <> x+ hd = pp (ind+1) h+ flat = unwordsS (fmap (pp (ind + 1)) values)+ headWidth = T.length hd + 1+ indented =+ case i of+ SwingAfter n ->+ let (l, ls) = Seq.splitAt n values+ t = unwordsS (fmap (pp (ind+1)) l)+ ts = indentAllS (ind + indentAmount)+ (fmap (pp (ind + indentAmount)) ls)+ in t <> ts+ Swing ->+ indentAllS (ind + indentAmount)+ (fmap (pp (ind + indentAmount)) values)+ Align ->+ indentSubsequentS (ind + headWidth + 1)+ (fmap (pp (ind + headWidth + 1)) values)+ body+ | length values == 0 = ""+ | Just maxAmt <- maxWidth+ , T.length flat + ind > maxAmt = " " <> indented+ | otherwise = " " <> flat+++-- if we don't indent anything, then we can ignore a bunch of the+-- details above+flatPrintSExpr :: SExpr Text -> Text+flatPrintSExpr = TL.toStrict . B.toLazyText . pHead+ where+ pHead (SCons x xs) =+ B.fromString "(" <> pHead x <> pTail xs+ pHead (SAtom t) =+ B.fromText t+ pHead SNil =+ B.fromString "()"++ pTail (SCons x xs) =+ B.fromString " " <> pHead x <> pTail xs+ pTail (SAtom t) =+ B.fromString " . " <> B.fromText t <> B.fromString ")"+ pTail SNil =+ B.fromString ")" -- | Turn a single s-expression into a string according to a given -- 'SExprPrinter'.
+ README.md view
@@ -0,0 +1,464 @@+[](https://hackage.haskell.org/package/s-cargot)++S-Cargot is a library for parsing and emitting S-expressions, designed to be flexible, customizable, and extensible. Different uses of S-expressions often understand subtly different variations on what an S-expression is. The goal of S-Cargot is to create several reusable components that can be repurposed to nearly any S-expression variant.++S-Cargot does _not_ aim to be the fastest or most efficient s-expression library. If you need speed, then it would probably be best to roll your own [AttoParsec]() parser. Wherever there's a choice, S-Cargot errs on the side of maximum flexibility, which means that it should be easy to plug together components to understand various existing flavors of s-expressions or to extend it in various ways to accomodate new flavors.++## What Are S-Expressions?++S-expressions were originally the data representation format in Lisp implementations, but have found broad uses outside of that as a data representation and storage format. S-expressions are often understood as a representation for binary trees with optional values in the leaf nodes: an empty leaf is represented with empty parens `()`, a non-empty leaf is represented as the scalar value it contains (often tokens like `x` or other programming language literals), and an internal node is represented as `(x . y)` where `x` and `y` are standing in for other s-expressions. In Lisp parlance, an internal node is called a _cons cell_, and the first and second elements inside it are called the _car_ and the _cdr_, for historical reasons. Non-empty lef nodes are referred to in the s-cargot library as _atoms_.++Often, s-expressions are used to represent lists, in which case the list is treated as a right-branching tree with an empty leaf as the far right child of the tree. S-expression languages have a shorthand way of representing these lists: instead of writing successsively nested pairs, as in `(1 . (2 . (3 . ()))`, they allow the sugar `(1 2 3)`. This is the most common way of writing s-expressions, even in languages that allow raw cons cells (or "dotted pairs") to be written.++The s-cargot library refers to expressions where every right-branching sequence ends in an empty leaf as _well-formed s-expressions_. Note that any s-expression which can be written without using a dotted pair is necessarily well-formed.++Unfortunately, while in common use, s-expressions do not have a single formal standard. They are often defined in an ad-hoc way, which means that s-expressions used in different contexts will, despite sharing a common parentheses-delimited structure, differ in various respects. Additionally, because s-expressions are used as the concrete syntax for languages of the Lisp family, they often have conveniences (such as comment syntaxes) and other bits of syntactic sugar (such as _reader macros_, which are described more fully later) that make parsing them much more complicated. Even ignoring those features, the _atoms_ recognized by a given s-expression variation can differ widely.++The s-cargot library was designed to accomodate several different kinds of s-expression formats, so that an s-expression format can be easily expressed as a combination of existing features. It includes a few basic variations on s-expression languages as well as the tools for parsing and emitting more elaborate s-expressions variations without having to reimplement the basic plumbing yourself.++## Using the Library++The central way of interacting with the S-Cargot library is by creating and modifying datatypes which represent specifications for parsing and printing s-expressions. Each of those types has two type parameters, which are often called `atom` and `carrier`:++~~~~+ +------ the type that represents an atom or value+ |+ | +- the Haskell representation of the SExpr itself+ | |+parser :: SExprParser atom carrier+printer :: SExprPrinter atom carrier+~~~~++Various functions will be provided that modify the carrier type (i.e. the output type of parsing or input type of serialization) or the language recognized by the parsing.++## Representing S-expressions++There are three built-in representations of S-expression lists: two of them are isomorphic, as one or the other might be convenient for working with S-expression data in a particular circumstance, while the third represents only the "well-formed" subset of possible S-expressions, which is often convenient when using s-expressions for configuration or data storage.++~~~~.haskell+-- cons-based representation+data SExpr atom+ = SCons (SExpr atom) (SExpr atom)+ | SNil+ | SAtom atom++-- list-based representation+data RichSExpr atom+ = RSList [RichSExpr atom]+ | RSDotList [RichSExpr atom] atom+ | RSAtom atom++-- well-formed representation+data WellFormedSExpr atom+ = WFSList [WellFormedSExpr atom]+ | WFSAtom atom+~~~~++The `WellFormedSExpr` representation should be structurally identical to the `RichSExpr` representation in all cases where no improper lists appear in the source. Both of those representations are often more convenient than writing multiple nested `SCons` constructors, in the same way that the `[1,2,3]` syntax in Haskell is often less tedious than writing `1:2:3:[]`.++Functions for converting back and forth between representations are provided, but you can also modify a `SExprSpec` to parse to or serialize from a particular representation using the `asRich` and `asWellFormed` functions.++~~~~.haskell+>>> decode basicParser "(a b)"+Right [SCons (SAtom "a") (SCons (SAtom "b") SNil)]+>>> decode (asRich basicParser) "(a b)"+Right [RSList [RSAtom "a",RSAtom "b"]]+>>> decode (asWellFormed basicParser) "(a b)"+Right [WFSList [WFSAtom "a",WFSAtom "b"]]+>>> decode basicParser "(a . b)"+Right [SCons (SAtom "a") (SAtom "b")]+>>> decode (asRich basicParser) "(a . b)"+Right [RSDotted [RSAtom "a"] "b"]+>>> decode (asWellFormed basicParser) "(a . b)"+Left "Found atom in cdr position"+~~~~++These names and patterns can be quite long, especially when you're constructing or matching on S-expression representations in Haskell source, so S-Cargot also exports several pattern synonyms that can be used both as expressions and in pattern-matching. These are each contained in their own module, as their names conflict with each other, so it's recommended to only import the module corresponding to the type that you plan on working with:++~~~~.haskell+>>> import Data.SCargot.Repr.Basic+>>> A 2 ::: A 3 ::: A 4 ::: Nil+SCons (SAtom 2) (SCons (SAtom 3) (SCons (SAtom 4) SNil))+~~~~++~~~~.haskell+>>> import Data.SCargot.Repr.WellFormed+>>> L [A 1,A 2,A 3]+WFSList [WFSAtom 1,WFSAtom 2,WFSAtom 3]+>>> let sexprSum (L xs) = sum (map sexprSum xs); sexprSum (A n) = n+>>> :t sexprSum+sexprSum :: Num a => WellFormedSExpr a -> a+>>> sexprSum (L [A 2, L [A 3, A 4]])+9+~~~~++If you are using GHC 7.10 or later, several of these will be powerful bidirectional pattern synonyms that allow both constructing and pattern-matching on s-expressions in non-trivial ways:++~~~~.haskell+>>> import Data.SCargot.Repr.Basic+>>> L [ A 2, A 3, A 4 ]+SCons (SAtom 2) (SCons (SAtom 3) (SCons (SAtom 4) SNil))+~~~~++## Atom Types++Any type can serve as an underlying atom type in an S-expression parser or serializer, provided that it has a Parsec parser or a serializer (i.e. a way of turning it into `Text`.) For these examples, I'm going to use a very simple serializer that is roughly like the one found in `Data.SCargot.Basic`, which parses symbolic tokens of letters, numbers, and some punctuation characters. This means that the 'serializer' here is just the identity function which returns the relevant `Text` value:++~~~~.haskell+parser :: SExprParser Text (SExpr Text)+parser = mkParser (pack <$> many1 (alphaNum <|> oneOf "+-*/!?"))++printer :: SExprPrinter Text (SExpr Text)+printer = flatPrint id+~~~~++A more elaborate atom type might distinguish between different varieties of token. A small example (that understands just alphabetic identifiers and decimal numbers) would look like this:++~~~~.haskell+import Data.Text (Text, pack)++data Atom = Ident Text | Num Int deriving (Eq, Show)++pAtom :: Parser Atom+pAtom = ((Num . read) <$> many1 digit)+ <|> (Ident . pack) <$> takeWhile1 isAlpha)++sAtom :: Atom -> Text+sAtom (Ident t) = t+sAtom (Num n) = pack (show n)++myParser :: SExprParser Atom (SExpr Atom)+myParser = mkParser pAtom++myPrinter :: SExprPrinter Atom (SExpr Atom)+myPrinter = flatPrint sAtom+~~~~++We can then use this newly created atom type within an S-expression for both parsing and serialization:++~~~~.haskell+>>> decode myParser "(foo 1)"+Right [SCons (SAtom (Ident "foo")) (SCons (SAtom (Num 1)) SNil)]+>>> encode mySpec [L [A (Num 0), A (Ident "bar")]]+"(0 bar)"+~~~~++Several common atom types appear in the module [`Data.SCargot.Common`](https://hackage.haskell.org/package/s-cargot-0.1.0.0/docs/Data-SCargot-Common.html), including various kinds of identifiers and number literals. The long-term plan for S-Cargot is to include more and more kinds of built-in atoms, in order to make putting together an S-Expression parser even easier. If you have a common syntax for an atom type that you think should be represented there, please [suggest it in an issue](https://github.com/aisamanra/s-cargot/issues)!++To make it easier to build up parsers for atom types without having to use Parsec manually, S-Cargot also exports `Data.SCargot.Atom`, which provides a shorthand way of building up a `SExprParser` from a list of parser-constructor pairs:++~~~~.haskell+import Data.SCargot.Atom (atom, mkParserFromAtoms)+import Data.SCargot.Common (parseR7RSIdent, signedDecNumber)++-- we want our atom type to understand R7RS identifiers and+-- signed decimal numbers+data Atom+ = Ident Text+ | Num Integer+ deriving (Eq, Show)++myParser :: SExprParser Atom (SExpr Atom)+myParser = mkAtomParser+ [ atom Ident parseR7RSIdent+ , atom Num signedDecNumber+ ]+~~~~++## Carrier Types++As pointed out above, there are three different "carrier" types that are used to represent S-expressions by the library, but you can use any type as a carrier type for a spec. This is particularly useful when you want to parse into your own custom tree-like type. For example, if we wanted to parse a small S-expression-based arithmetic language, we could define a data type and transformations from and to an S-expression type:++~~~~.haskell+import Data.Char (isDigit)+import Data.Text (Text)+import qualified Data.Text as T+++data Expr = Add Expr Expr | Num Int deriving (Eq, Show)++toExpr :: RichSExpr Text -> Either String Expr+toExpr (L [A "+", l, r]) = Add <$> toExpr l <*> toExpr r+toExpr (A c)+ | T.all isDigit c = pure (Num (read (T.unpack c)))+ | otherwise = Left "Non-numeric token as argument"+toExpr _ = Left "Unrecognized s-expr"++fromExpr :: Expr -> RichSExpr Text+fromExpr (Add x y) = L [A "+", fromExpr x, fromExpr y]+fromExpr (Num n) = A (T.pack (show n))+~~~~++then we could use the `convertSpec` function to add this directly to the `SExprSpec`:++~~~~.haskell+>>> let parser' = setCarrier toExpr (asRich myParser)+>>> :t parser'+SExprParser Atom Expr+>>> decode parser' "(+ 1 2)"+Right [Add (Num 1) (Num 2)]+>>> decode parser' "(0 1 2)"+Left "Unrecognized s-expr"+~~~~++## Comments++By default, an S-expression parser does not include a comment syntax, but the provided `withLispComments` function will cause it to understand traditional Lisp line-oriented comments that begin with a semicolon:++~~~~.haskell+>>> decode basicParser "(this ; has a comment\n inside)\n"+Left "(line 1, column 7):\nunexpected \";\"\nexpecting space or atom"+>>> decode (withLispComments basicParser) "(this ; has a comment\n inside)\n"+Right [SCons (SAtom "this") (SCons (SAtom "inside") SNil)]+~~~~++Additionally, you can provide your own comment syntax in the form of an Parsec parser. Any Parsec parser can be used, so long as it meets the following criteria:+- it is capable of failing (as is called until SCargot believes that there are no more comments)+- it does not consume any input in the case of failure, which may involve wrapping the parser in a call to `try`++For example, the following adds C++-style comments to an S-expression format:++~~~~.haskell+>>> let cppComment = string "//" >> manyTill newline >> return ()+>>> decode (setComment cppComment basicParser) "(a //comment\n b)\n"+Right [SCons (SAtom "a") (SCons (SAtom "b") SNil)]+~~~~++The [`Data.SCargot.Comments`](https://hackage.haskell.org/package/s-cargot/docs/Data-SCargot-Comments.html) module defines some helper functions for creating comment syntaxes, so the `cppComment` parser above could be defined as simply++~~~~.haskell+>>> let cppComment = lineComment "//"+>>> decode (setComment cppComment basicParser) "(a //comment\n b)\n"+Right [SCons (SAtom "a") (SCons (SAtom "b") SNil)]+~~~~++Additionally, a handful of common comment syntaxes are defined in [`Data.SCargot.Comments`](https://hackage.haskell.org/package/s-cargot/docs/Data-SCargot-Comments.html), including C-style, Haskell-style, and generic scripting-language-style comments, so in practice, we could write the above example as++~~~~.haskell+>>> decode (withCLikeLineComments basicParser) "(a //comment\n b)\n"+Right [SCons (SAtom "a") (SCons (SAtom "b") SNil)]+~~~~++## Reader Macros++In Lisp variants, a _reader macro_ is a macro---a function that operates on syntactic structures---which is invoked during the _scanning_, or lexing, phase of a Lisp parser. This allows the _lexical_ syntax of a Lisp to be modified. A very common reader macro in most Lisp variants is the single quote, which allows the syntax `'expr` to stand as sugar for the literal s-expression `(quote expr)`. The S-Cargot library accomodates this by keeping a map from characters to Haskell functions that can be used analogously to reader macros. This is a common enough special case that there are shorthand ways of writing this, but we could support the `'expr` syntax by creating a Haskell function to turn `expr` into `(quote expr)` and adding that as a reader macro associated with the character `'`:++~~~~.haskell+>>> let quote expr = SCons (SAtom "quote") (SCons expr SNil)+>>> :t quote+quote :: IsString atom => SExpr atom -> SExpr atom+>>> let addQuoteReader = addReader '\'' (\ parse -> fmap quote parse)+>>> addQuoteReader :: IsString atom => SExprParser atom c -> SExprParser atom c+>>> decode (addQuoteReader basicParser) "'foo"+Right [SCons (SAtom "quote") (SCons (SAtom "foo") SNil)]+~~~~++A reader macro is passed the an s-expression parser so that it can perform recursive parse calls, and it can return any `SExpr` it would like. It may also take as much or as little of the remaining parse stream as it would like. For example, the following reader macro does not bother parsing anything else and merely returns a new token:++~~~~.haskell+>>> let qmReader = addReader '?' (\ _ -> pure (SAtom "huh"))+>>> decode (qmReader basicParser) "(?1 2)"+Right [SCons (SAtom "huh") (SCons (SAtom "1") (SCons (SAtom "2") SNil))]+~~~~++We can define a similar reader macro directly in Common Lisp, although it's important to note that Common Lisp converts all identifiers to uppercase, and also that the quote in line `[3]` is necessary so that the Common Lisp REPL doesn't attempt to evaluate `(huh 1 2)` as code:++~~~~.lisp+[1]> (defun qm-reader (stream char) 'huh)+QM-READER+[2]> (set-macro-character #\? #'qm-reader)+T+[3]> '(?1 2)+(HUH 1 2)+~~~~++Reader macros in S-Cargot can be used to define bits of Lisp syntax that are not typically considered the purview of S-expression parsers. For example, some Lisp-derived languages allow square brackets as a subsitute for proper lists, and to support this we could define a reader macro that is indicated by the `[` character and repeatedly calls the parser until a `]` character is reached:++~~~~.haskell+>>> let vec p = (char ']' *> pure SNil) <|> (SCons <$> p <*> vec p)+>>> :t vec+vec+ :: Stream s m Char =>+ ParsecT s u m (SExpr atom) -> ParsecT s u m (SExpr atom)+>>> let withVecReader = addReader '[' vec+>>> decode (asRich (withVecReader basicParser)) "(1 [2 3])"+Right [RSList [RSAtom "1",RSList [RSAtom "2",RSAtom "3"]]]+~~~~++## Pretty-Printing and Indentation++The s-cargot library also includes a simple but often adequate pretty-printing system for S-expressions. A printer that prints a single-line s-expression is created with `flatPrint`:++~~~~.haskell+>>> let printer = flatPrint id+>>> :t printer+SExprPrinter Text (SCargot Text)+>>> Text.putStrLn $ encode printer [L [A "foo", A "bar"]]+(foo bar)+~~~~++A printer that tries to pretty-print an s-expression to fit attractively within an 80-character limit can be created with `basicPrint`:++~~~~.haskell+>>> let printer = basicPrint id+>>> let sentence = "this stupendously preposterously supercalifragilisticexpialidociously long s-expression"+>>> let longSexpr = L [A word | word <- Text.words sentence ]+>>> Text.putStrLn $ encodeOne printer longSexpr+(this+ stupendously+ preposterously+ supercalifragilisticexpialidociously+ long+ s-expression)+~~~~++A printer created with `basicPrint` will "swing" things that are too long onto the subsequent line, indenting it a fixed number of spaces. We can modify the number of spaces with `setIndentAmount`:++~~~~.haskell+>>> let printer = setIndentAmount 4 (basicPrint id)+>>> Text.putStrLn $ encodeOne printer longSexpr+(this+ stupendously+ preposterously+ supercalifragilisticexpialidociously+ long+ s-expression)+~~~~++We can also modify what counts as the 'maximum width', which for a `basicPrint` printer is 80 by default:++~~~~.haskell+>>> let printer = setMaxWidth 8 (basicPrint id)+>>> Text.putStrLn $ encodeOne printer (L [A "one", A "two", A "three"])+(one+ two+ three)+~~~~++Or remove the maximum, which will always put the whole s-expression onto one line, regardless of its length:++~~~~.haskell+>>> let printer = removeMaxWidth (basicPrint id)+>>> Text.putStrLn $ encodeOne printer longSexpr+(this stupendously preposterously supercalifragilisticexpialidociously long s-expression)+~~~~++We can also specify an _indentation strategy_, which decides how to indent subsequent expressions based on the head of a given expression. The default is to always "swing" subsequent expressions to the next line, but we could also specify the `Align` constructor, which will print the first two expressions on the same line and then any subsequent expressions horizontally aligned with the second one, like so:++~~~~.haskell+>>> let printer = setIndentStrategy (\ _ -> Align) (setMaxWidth 8 (basicPrint id))+>>> Text.putStrLn $ encodeOne printer (L [A "one", A "two", A "three", A "four"])+(one two+ three+ four)+~~~~++Or we could choose to keep some number of expressions on the same line and afterwards swing the subsequent ones:++~~~~.haskell+>>> let printer = setIndentStrategy (\ _ -> SwingAfter 1) (setMaxWidth 8 (basicPrint id))+>>> Text.putStrLn $ encodeOne printer (L [A "one", A "two", A "three", A "four"])+(one two+ three+ four)+~~~~++In many situations, we might want to choose a different indentation strategy based on the first expression within a proper list: for example, Common Lisp source code is often formatted so that, following a `defun` token, the function name and arguments are on the same line, and then the body of the function is indented a fixed amount. We can express an approximation of that strategy like this:++~~~~.haskell+>>> let strategy (A ident) | "def" `Text.isPrefixOf` ident = SwingAfter 2; strategy _ = Align+>>> let printer = setIndentStrategy strategy (setMaxWidth 20 (basicPrint id))+>>> let fact = L [A "defun", A "fact", L [A "x"], L [A "product", L [A "range", A "1", A "x"]]]+>>> Text.putStrLn $ encodeOne printer fact+(defun fact (x)+ (product (range 1 x)))+>>> let app = L [A "apply", L [A "lambda", L [A "y"], L [A "fact", A "y"]], L [A "+", A "2", A "3"]]+(apply (lambda (y) (fact y)+ (+ 2 3))+~~~~++## Putting It All Together++Here is a final example which implements a limited arithmetic language with Haskell-style line comments and a special reader macro to understand hex literals:++~~~~.haskell+{-# LANGUAGE OverloadedStrings #-}++module SCargotExample where++import Control.Applicative ((<|>))+import Data.Char (isDigit)+import Data.SCargot+import Data.SCargot.Repr.Basic+import Data.Text (Text, pack)+import Numeric (readHex)+import Text.Parsec (anyChar, char, digit, many1, manyTill, newline, satisfy, string)+import Text.Parsec.Text (Parser)++-- Our operators are going to represent addition, subtraction, or+-- multiplication+data Op = Add | Sub | Mul deriving (Eq, Show)++-- The atoms of our language are either one of the aforementioned+-- operators, or positive integers+data Atom = AOp Op | ANum Int deriving (Eq, Show)++-- Once parsed, our language will consist of the applications of+-- binary operators with literal integers at the leaves+data Expr = EOp Op Expr Expr | ENum Int deriving (Eq, Show)++-- Conversions to and from our Expr type+toExpr :: SExpr Atom -> Either String Expr+toExpr (A (AOp op) ::: l ::: r ::: Nil) = EOp op <$> toExpr l <*> toExpr r+toExpr (A (ANum n)) = pure (ENum n)+toExpr sexpr = Left ("Unable to parse expression: " ++ show sexpr)++fromExpr :: Expr -> SExpr Atom+fromExpr (EOp op l r) = A (AOp op) ::: fromExpr l ::: fromExpr r ::: Nil+fromExpr (ENum n) = A (ANum n) ::: Nil++-- Parser and serializer for our Atom type+pAtom :: Parser Atom+pAtom = ((ANum . read) <$> many1 digit)+ <|> (char '+' *> pure (AOp Add))+ <|> (char '-' *> pure (AOp Sub))+ <|> (char '*' *> pure (AOp Mul))++sAtom :: Atom -> Text+sAtom (AOp Add) = "+"+sAtom (AOp Sub) = "-"+sAtom (AOp Mul) = "*"+sAtom (ANum n) = pack (show n)++-- Our comment syntax is going to be Haskell-like:+hsComment :: Parser ()+hsComment = string "--" >> manyTill anyChar newline >> return ()++-- Our custom reader macro: grab the parse stream and read a+-- hexadecimal number from it:+hexReader :: Reader Atom+hexReader _ = (A . ANum . rd) <$> many1 (satisfy isHexDigit)+ where isHexDigit c = isDigit c || c `elem` hexChars+ rd = fst . head . readHex+ hexChars :: String+ hexChars = "AaBbCcDdEeFf"++-- Our final s-expression parser and printer:+myLangParser :: SExprParser Atom Expr+myLangParser+ = setComment hsComment -- set comment syntax to be Haskell-style+ $ addReader '#' hexReader -- add hex reader+ $ setCarrier toExpr -- convert final repr to Expr+ $ mkParser pAtom -- create spec with Atom type++mkLangPrinter :: SExprPrinter Atom Expr+mkLangPrinter+ = setFromCarrier fromExpr+ $ setIndentStrategy (const Align)+ $ basicPrint sAtom++>>> decode myLangParser "(+ (* 2 20) 10) (* 10 10)"+[EOp Add (EOp Mul (ENum 2) (ENum 20)) (ENum 10),EOp Mul (ENum 10) (ENum 10)]+~~~~++Keep in mind that you often won't need to write all this by hand, as you can often use a variety of built-in atom types, reader macros, comment types, and representations, but it's a useful illustration of all the options that are available to you should you need them!
s-cargot.cabal view
@@ -1,5 +1,5 @@ name: s-cargot-version: 0.1.2.0+version: 0.1.3.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@@ -12,12 +12,14 @@ control over indentation in pretty-printing. license: BSD3 license-file: LICENSE-author: Getty Ritter-maintainer: gettyritter@gmail.com-copyright: 2015 Getty Ritter+author: Getty Ritter <s-cargot@infinitenegativeutility.com>+maintainer: Getty Ritter <s-cargot@infinitenegativeutility.com>+copyright: ©2018 Getty Ritter category: Data build-type: Simple cabal-version: >=1.10+bug-reports: https://github.com/aisamanra/s-cargot/issues+extra-source-files: README.md, CHANGELOG.md source-repository head type: git
test/SCargotQC.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Main where @@ -11,9 +12,7 @@ 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 ->@@ -25,10 +24,10 @@ elems <- sequence [ resize (n-k) arbitrary | _ <- [0..k] ]- tail <- oneof [ SAtom <$> arbitrary+ rest <- oneof [ SAtom <$> arbitrary , pure SNil ]- pure (foldr SCons tail elems)+ pure (foldr SCons rest elems) ] instance Arbitrary a => Arbitrary (RichSExpr a) where@@ -73,7 +72,10 @@ prettyPrinter :: SExprPrinter () (SExpr ()) prettyPrinter = basicPrint (const "X") +widePrinter :: SExprPrinter () (SExpr ())+widePrinter = unconstrainedPrint (const "X") + richIso :: SExpr () -> Bool richIso s = fromRich (toRich s) == s @@ -96,6 +98,9 @@ encDecPretty :: SExpr () -> Bool encDecPretty s = decodeOne parser (encodeOne prettyPrinter s) == Right s +encDecWide :: SExpr () -> Bool+encDecWide s = decodeOne parser (encodeOne widePrinter s) == Right s+ decEnc :: EncodedSExpr -> Bool decEnc s = decodeOne parser (encoding s) == Right (original s) @@ -109,6 +114,12 @@ (encodeOne prettyPrinter (fromRich s)) == Right s +encDecRichWide :: RichSExpr () -> Bool+encDecRichWide s =+ decodeOne (asRich parser)+ (encodeOne widePrinter (fromRich s))+ == Right s+ decEncRich :: EncodedSExpr -> Bool decEncRich s = decodeOne (asRich parser) (encoding s) == Right (toRich (original s)) @@ -122,6 +133,11 @@ decodeOne (asWellFormed parser) (encodeOne prettyPrinter (fromWellFormed s)) == Right s +encDecWFWide :: WellFormedSExpr () -> Bool+encDecWFWide s =+ decodeOne (asWellFormed parser) (encodeOne widePrinter (fromWellFormed s))+ == Right s+ decEncWF :: EncodedSExpr -> Bool decEncWF s = decodeOne (asWellFormed parser) (encoding s) == toWellFormed (original s) @@ -169,6 +185,11 @@ reallyQuickCheck encDecPretty reallyQuickCheck encDecRichPretty reallyQuickCheck encDecWFPretty++ putStrLn "And it should be true if pretty-printed using the wide-format printer"+ reallyQuickCheck encDecWide+ reallyQuickCheck encDecRichWide+ reallyQuickCheck encDecWFWide putStrLn "Comments should not affect parsing" reallyQuickCheck encDecLineComments