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.
This commit is contained in:
Benno Fünfstück
parent
018ad98827
commit
1b85b76a4e
|
|
@ -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 "<string>" . 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 "<string>" 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) "<string>" . pack
|
||||
|
||||
#else
|
||||
|
||||
type Parser = NixParser Trifecta.Parser
|
||||
|
||||
parseFromFileEx p = Trifecta.parseFromFileEx (runNixParser p)
|
||||
|
||||
parseFromString p = Trifecta.parseString (runNixParser p) (Trifecta.Directed "<string>" 0 0 0 0)
|
||||
#endif
|
||||
|
|
|
|||
52
hnix.cabal
52
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue