diff --git a/sexp-grammar.cabal b/sexp-grammar.cabal --- a/sexp-grammar.cabal +++ b/sexp-grammar.cabal @@ -1,5 +1,5 @@ name: sexp-grammar -version: 2.3.3.1 +version: 2.3.4.0 license: BSD3 license-file: LICENSE author: Yevhen Smolanka, Sergey Vinokurov @@ -14,7 +14,7 @@ description: Serialisation to and deserialisation from S-expressions derived from a single grammar definition. -tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1 +tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.1 source-repository head type: git @@ -52,8 +52,8 @@ , prettyprinter >=1 && <1.8 , recursion-schemes >=5.2 && <5.3 , scientific >=0.3.3 && <0.4 - , semigroups >=0.16 && <0.20 - , text >=1.2 && <1.3 + , semigroups >=0.16 && <0.21 + , text >=1.2 && <1.3 || >=2.0 && <2.1 , utf8-string >=1.0 && <2.0 build-tools: alex, happy diff --git a/src/Language/Sexp/Lexer.x b/src/Language/Sexp/Lexer.x --- a/src/Language/Sexp/Lexer.x +++ b/src/Language/Sexp/Lexer.x @@ -54,34 +54,26 @@ $whitespace+ ; ";" .* ; +"#;" / $allgraphic { const TokCommentIntro } -"(" { just TokLParen } -")" { just TokRParen } -"[" { just TokLBracket } -"]" { just TokRBracket } -"{" { just TokLBrace } -"}" { just TokRBrace } +"(" { const TokLParen } +")" { const TokRParen } +"[" { const TokLBracket } +"]" { const TokRBracket } +"{" { const TokLBrace } +"}" { const TokRBrace } -"'" / $allgraphic { just (TokPrefix Quote) } -"`" / $allgraphic { just (TokPrefix Backtick) } -",@" / $allgraphic { just (TokPrefix CommaAt) } -"," / $allgraphic { just (TokPrefix Comma) } -"#" / $allgraphic { just (TokPrefix Hash) } +"'" / $allgraphic { const (TokPrefix Quote) } +"`" / $allgraphic { const (TokPrefix Backtick) } +",@" / $allgraphic { const (TokPrefix CommaAt) } +"," / $allgraphic { const (TokPrefix Comma) } +"#" / $allgraphic { const (TokPrefix Hash) } -@number { TokNumber `via` readNum } -@symbol { TokSymbol `via` decode } -\" @string* \" { TokString `via` readString } +@number { TokNumber . readNum } +@symbol { TokSymbol . decode } +\" @string* \" { TokString . readString } { - ----------------------------------------------------------------------- --- Actions - -just :: Token -> AlexAction -just tok _ = tok - -via :: (a -> Token) -> (ByteString -> a) -> AlexAction -via ftok f = ftok . f ---------------------------------------------------------------------- -- Decoders diff --git a/src/Language/Sexp/Parser.y b/src/Language/Sexp/Parser.y --- a/src/Language/Sexp/Parser.y +++ b/src/Language/Sexp/Parser.y @@ -16,6 +16,7 @@ import qualified Data.ByteString.Lazy.Char8 as B8 import qualified Data.List.NonEmpty as NE +import Data.Maybe (catMaybes) import qualified Data.Scientific import Data.Text (Text) import qualified Data.Text as T @@ -45,11 +46,14 @@ ']' { _ :< TokRBracket } '{' { _ :< TokLBrace } '}' { _ :< TokRBrace } + PREFIX { _ :< (TokPrefix _) } SYMBOL { _ :< (TokSymbol _) } NUMBER { _ :< (TokNumber _) } STRING { _ :< (TokString _) } + COMMENT { _ :< TokCommentIntro } + EOF { _ :< TokEOF } %% @@ -58,19 +62,23 @@ : Sexps EOF { $1 } Sexps :: { [Sexp] } - : list(Sexp) { $1 } + : list(MSexp) { catMaybes $1 } Sexp_ :: { Sexp } : Sexp EOF { $1 } Sexp :: { Sexp } : Atom { AtomF @@ $1 } - | '(' list(Sexp) ')' { const (ParenListF $2) @@ $1 } - | '[' list(Sexp) ']' { const (BracketListF $2) @@ $1 } - | '{' list(Sexp) '}' { const (BraceListF $2) @@ $1 } + | '(' Sexps ')' { const (ParenListF $2) @@ $1 } + | '[' Sexps ']' { const (BracketListF $2) @@ $1 } + | '{' Sexps '}' { const (BraceListF $2) @@ $1 } | PREFIX Sexp { const (ModifiedF (getPrefix (extract $1)) $2) @@ $1 } + +MSexp :: { Maybe Sexp } + : Sexp { Just $1 } + | COMMENT Sexp { Nothing } Atom :: { LocatedBy Position Atom } : NUMBER { fmap (AtomNumber . getNumber) $1 } diff --git a/src/Language/Sexp/Token.hs b/src/Language/Sexp/Token.hs --- a/src/Language/Sexp/Token.hs +++ b/src/Language/Sexp/Token.hs @@ -31,6 +31,7 @@ | TokRBracket -- ] | TokLBrace -- { | TokRBrace -- } + | TokCommentIntro -- #; | TokPrefix { getPrefix :: !Prefix } -- e.g. a quote in '(foo bar) | TokNumber { getNumber :: !Scientific } -- 42.0, -1.0, 3.14, -1e10 | TokString { getString :: !Text } -- "foo", "", "hello world" @@ -40,18 +41,19 @@ deriving (Show, Eq) instance Pretty Token where - pretty TokLParen = "left paren '('" - pretty TokRParen = "right paren ')'" - pretty TokLBracket = "left bracket '['" - pretty TokRBracket = "right bracket '['" - pretty TokLBrace = "left brace '{'" - pretty TokRBrace = "right brace '}'" - pretty (TokPrefix c) = "modifier" <+> pretty (show c) - pretty (TokSymbol s) = "symbol" <+> squotes (pretty s) <> squote - pretty (TokNumber n) = "number" <+> pretty (show n) - pretty (TokString s) = "string" <+> pretty (show s) - pretty (TokUnknown u) = "unrecognized" <+> pretty u <> "..." - pretty TokEOF = "end of file" + pretty TokLParen = "left paren '('" + pretty TokRParen = "right paren ')'" + pretty TokLBracket = "left bracket '['" + pretty TokRBracket = "right bracket '['" + pretty TokLBrace = "left brace '{'" + pretty TokRBrace = "right brace '}'" + pretty TokCommentIntro = "datum comment" + pretty (TokPrefix c) = "modifier" <+> pretty (show c) + pretty (TokSymbol s) = "symbol" <+> squotes (pretty s) <> squote + pretty (TokNumber n) = "number" <+> pretty (show n) + pretty (TokString s) = "string" <+> pretty (show s) + pretty (TokUnknown u) = "unrecognized" <+> pretty u <> "..." + pretty TokEOF = "end of file" newtype DText = DText (TL.Text -> TL.Text) diff --git a/src/Language/Sexp/Types.hs b/src/Language/Sexp/Types.hs --- a/src/Language/Sexp/Types.hs +++ b/src/Language/Sexp/Types.hs @@ -115,6 +115,9 @@ | ModifiedF !Prefix e deriving (Functor, Foldable, Traversable, Generic) +instance Eq a => Eq (SexpF a) where + (==) = liftEq (==) + instance Eq1 SexpF where liftEq eq = go where diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -358,6 +358,9 @@ , testCase "keyword" $ parseSexp' ":foo" `sexpEq` Right (Symbol ":foo") + , testCase "datum comment" $ + parseSexp' "(three #;(not four) element list)" + `sexpEq` Right (ParenList [Symbol "three", Symbol "element", Symbol "list"]) ]