From 1b85b76a4ef7079184154f30f4e8166fda8e183c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Benno=20F=C3=BCnfst=C3=BCck?= Date: Fri, 15 Aug 2014 16:09:10 +0200 Subject: [PATCH] parsec: Also use parsers (like trifecta) This saves a lot of duplication and also makes it easier to keep the parsec and trifecta versions of the parser in sync. --- Nix/Parser/Library.hs | 225 ++++++++++++++++-------------------------- hnix.cabal | 52 +++++----- 2 files changed, 107 insertions(+), 170 deletions(-) diff --git a/Nix/Parser/Library.hs b/Nix/Parser/Library.hs index c53e958..da0bded 100644 --- a/Nix/Parser/Library.hs +++ b/Nix/Parser/Library.hs @@ -1,87 +1,61 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Nix.Parser.Library ( module Nix.Parser.Library, module X) where -module Nix.Parser.Library ( module Nix.Parser.Library, module X ) where - -import Control.Applicative - -#if USE_PARSEC - -import Control.Monad -import Control.Monad.IO.Class -import Data.Functor.Identity -import Data.Text as T hiding (map) -import Data.Text.IO as T -import Text.Parsec as X hiding ((<|>), many, optional) -import Text.Parsec.Expr as X -import Text.Parsec.Text as X -import qualified Text.Parsec.Token as P -import Text.PrettyPrint.ANSI.Leijen as X (Doc, text) - -lexer :: P.GenTokenParser Text () Identity -lexer = P.makeTokenParser P.LanguageDef - { P.commentStart = "/*" - , P.commentEnd = "*/" - , P.commentLine = "#" - , P.nestedComments = True - , P.identStart = identStart - , P.identLetter = identLetter - , P.opStart = opStart - , P.opLetter = opLetter - , P.reservedNames = reservedNames - , P.reservedOpNames = [] - , P.caseSensitive = True - } - -parens :: Parser a -> Parser a -parens = P.parens lexer - -brackets :: Parser a -> Parser a -brackets = P.brackets lexer - -braces :: Parser a -> Parser a -braces = P.braces lexer - -identifier :: Parser Text -identifier = pack <$> P.identifier lexer - -reserved :: String -> Parser () -reserved = P.reserved lexer - -reservedOp :: String -> Parser () -reservedOp = P.reservedOp lexer - -decimal :: Parser Integer -decimal = read <$> some digit - -whiteSpace :: Parser () -whiteSpace = P.whiteSpace lexer - -data Result a = Success a - | Failure Doc - -parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a) -parseFromFileEx p path = - (either (Failure . text . show) Success . parse p path) - `liftM` liftIO (T.readFile path) - -parseFromString :: Parser a -> String -> Result a -parseFromString p = either (Failure . text . show) Success . parse p "" . pack - -#else - +import Control.Applicative +import Control.Monad +import Control.Monad.IO.Class import Data.Char -import Data.List (nub) import Data.Text hiding (map) import Text.Parser.Expression as X import Text.Parser.LookAhead as X +import Text.Parser.Token as X +import Text.Parser.Char as X hiding (text) +import Text.Parser.Combinators as X +import Text.PrettyPrint.ANSI.Leijen as X (Doc, text) import Text.Parser.Token.Highlight -import Text.Trifecta as X hiding (whiteSpace, symbol, symbolic, parseString) -import Text.Trifecta (parseString) -import Text.Trifecta.Delta import qualified Data.HashSet as HashSet -identStyle :: IdentifierStyle Parser +#if USE_PARSEC +import qualified Text.Parsec as Parsec +import qualified Text.Parsec.Text as Parsec +import qualified Data.Text.IO as T +#else +import qualified Text.Trifecta as Trifecta +import qualified Text.Trifecta.Delta as Trifecta + +import Text.Trifecta as X (Result(..)) +#endif + +newtype NixParser p a = NixParser { runNixParser :: p a } + deriving (Functor, Applicative, Alternative, Monad, MonadPlus, Parsing, CharParsing, LookAheadParsing) + +instance TokenParsing p => TokenParsing (NixParser p) where + someSpace = skipSome (simpleSpace <|> oneLineComment <|> multiLineComment "") + nesting = NixParser . nesting . runNixParser + highlight h = NixParser . highlight h . runNixParser + semi = token $ char ';' ";" + token p = p <* whiteSpace + +simpleSpace :: CharParsing m => m () +simpleSpace = skipSome (satisfy isSpace) + +oneLineComment :: CharParsing m => m () +oneLineComment = char '#' *> skipMany (notChar '\n') + +multiLineComment :: CharParsing m => m () +multiLineComment = try (string "/*") *> inComment + +inComment :: CharParsing m => m () +inComment = choice + [ () <$ try (string "*/") + , multiLineComment *> inComment + , skipSome (noneOf "*/") *> inComment + , oneOf "*/" *> inComment + ] "end of comment" + +identStyle :: CharParsing m => IdentifierStyle m identStyle = IdentifierStyle { _styleName = "nix identifier" , _styleStart = identStart @@ -91,82 +65,26 @@ identStyle = IdentifierStyle , _styleReservedHighlight = ReservedIdentifier } -identifier :: Parser Text +identifier :: (TokenParsing m, Monad m) => m Text identifier = ident identStyle -reserved :: String -> Parser Text +reserved :: (TokenParsing m, Monad m) => String -> m Text reserved n = pack n <$ reserve identStyle n -reservedOp :: String -> Parser Text +reservedOp :: TokenParsing m => String -> m Text reservedOp o = token $ try $ pack o <$ highlight ReservedOperator (string o) <* (notFollowedBy opLetter "end of " ++ o) ------------------------------------------------------------ --- White space & symbols ------------------------------------------------------------ - -lexeme :: (CharParsing m, Monad m) => m b -> m b -lexeme p = do{ x <- p; whiteSpace; return x } - -whiteSpace :: (CharParsing m, Monad m) => m () -whiteSpace = - skipMany (simpleSpace <|> oneLineComment <|> multiLineComment "") - -simpleSpace :: CharParsing m => m () -simpleSpace = skipSome (satisfy isSpace) - -oneLineComment :: (CharParsing m, Monad m) => m () -oneLineComment = - do{ _ <- try (string "#") - ; skipMany (satisfy (/= '\n')) - ; return () - } - -multiLineComment :: (CharParsing m, Monad m) => m () -multiLineComment = - do { _ <- try (string "/*") - ; inComment - } - -inComment :: (CharParsing m, Monad m) => m () -inComment - | True = inCommentMulti - | otherwise = inCommentSingle - -inCommentMulti :: (CharParsing m, Monad m) => m () -inCommentMulti - = do{ _ <- try (string "*/") ; return () } - <|> do{ multiLineComment ; inCommentMulti } - <|> do{ skipSome (noneOf startEnd) ; inCommentMulti } - <|> do{ _ <- oneOf startEnd ; inCommentMulti } - "end of comment" - where - startEnd = nub ("*/" ++ "/*") - -inCommentSingle :: (CharParsing m, Monad m) => m () -inCommentSingle - = do{ _ <- try (string "*/"); return () } - <|> do{ skipSome (noneOf startEnd) ; inCommentSingle } - <|> do{ _ <- oneOf startEnd ; inCommentSingle } - "end of comment" - where - startEnd = nub ("*/" ++ "/*") - -parseFromString :: Parser a -> String -> Result a -parseFromString p = parseString p (Directed "" 0 0 0 0) - -#endif - -opStart :: Parser Char +opStart :: CharParsing m => m Char opStart = oneOf ":!#$%&*+./<=>?@\\^|-~" -opLetter :: Parser Char +opLetter :: CharParsing m => m Char opLetter = oneOf "@" -identStart :: Parser Char +identStart :: CharParsing m => m Char identStart = letter <|> char '_' -identLetter :: Parser Char +identLetter :: CharParsing m => m Char identLetter = alphaNum <|> oneOf "_'-" reservedNames :: [String] @@ -182,15 +100,38 @@ reservedNames = , "or" ] -stopWords :: Parser () +stopWords :: (TokenParsing m, Monad m) => m () stopWords = () <$ (whiteSpace *> (reserved "in" <|> reserved "then" <|> reserved "else")) -someTill :: Parser a -> Parser end -> Parser [a] +someTill :: Alternative f => f a -> f end -> f [a] someTill p end = go where go = (:) <$> p <*> scan - scan = (end *> return []) <|> go + scan = (end *> pure []) <|> go -symbolic :: Char -> Parser Char -symbolic c = char c <* whiteSpace +-------------------------------------------------------------------------------- +parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a) +parseFromString :: Parser a -> String -> Result a + +#if USE_PARSEC +data Result a = Success a + | Failure Doc + deriving Show + +type Parser = NixParser Parsec.Parser + +parseFromFileEx p path = + (either (Failure . text . show) Success . Parsec.parse (runNixParser p) path) + `liftM` liftIO (T.readFile path) + +parseFromString p = either (Failure . text . show) Success . Parsec.parse (runNixParser p) "" . pack + +#else + +type Parser = NixParser Trifecta.Parser + +parseFromFileEx p = Trifecta.parseFromFileEx (runNixParser p) + +parseFromString p = Trifecta.parseString (runNixParser p) (Trifecta.Directed "" 0 0 0 0) +#endif diff --git a/hnix.cabal b/hnix.cabal index ef299d6..b3e2851 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -18,7 +18,7 @@ Flag Parsec Default: False Library - default-language: Haskell2010 + Default-language: Haskell2010 Exposed-modules: Nix.Eval Nix.Parser @@ -26,7 +26,7 @@ Library Other-modules: Nix.Internal Nix.Parser.Library - Default-extensions: + Default-extensions: DataKinds DeriveDataTypeable DeriveFunctor @@ -47,21 +47,19 @@ Library , containers , text , transformers + , parsers >= 0.10 + , unordered-containers if flag(parsec) - ghc-options: -DUSE_PARSEC - Build-depends: - parsec + Cpp-options: -DUSE_PARSEC + Build-depends: parsec else - Build-depends: - parsers - , trifecta - , unordered-containers + Build-depends: trifecta ghc-options: -Wall -executable hnix - default-language: Haskell2010 - main-is: Nix.hs - Default-extensions: +Executable hnix + Default-language: Haskell2010 + Main-is: Nix.hs + Default-extensions: DataKinds DeriveDataTypeable DeriveFunctor @@ -76,30 +74,28 @@ executable hnix PatternGuards RankNTypes TupleSections - build-depends: + Build-depends: base >= 4.3 && < 5 , hnix , ansi-wl-pprint , containers , text , transformers + , parsers >= 0.10 + , unordered-containers if flag(parsec) - ghc-options: -DUSE_PARSEC - Build-depends: - parsec + Cpp-options: -DUSE_PARSEC + Build-depends: parsec else - Build-depends: - parsers - , trifecta - , unordered-containers - ghc-options: -Wall + Build-depends: trifecta + Ghc-options: -Wall -test-suite hnix-tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - default-language: Haskell2010 - main-is: Main.hs - build-depends: +Test-suite hnix-tests + Type: exitcode-stdio-1.0 + Hs-source-dirs: tests + Default-language: Haskell2010 + Main-is: Main.hs + Build-depends: base >= 4.3 && < 5 , containers , text