154 lines
4.1 KiB
Haskell
154 lines
4.1 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
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.Text as T
|
|
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 :: Stream s m Char => P.GenTokenParser s u m
|
|
lexer = P.makeTokenParser P.LanguageDef
|
|
{ P.commentStart = "/*"
|
|
, P.commentEnd = "*/"
|
|
, P.commentLine = "#"
|
|
, P.nestedComments = True
|
|
, P.identStart = letter <|> char '_'
|
|
, P.identLetter = alphaNum <|> oneOf "_"
|
|
, P.opStart = oneOf ":!#$%&*+./<=>?@\\^|-~"
|
|
, P.opLetter = oneOf "@"
|
|
, P.reservedNames =
|
|
[ "let", "in"
|
|
, "if", "then", "else"
|
|
, "true", "false"
|
|
, "null"
|
|
, "assert"
|
|
, "with"
|
|
, "rec"
|
|
, "inherit"
|
|
, "or"
|
|
]
|
|
, 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
|
|
|
|
symbol :: String -> Parser Text
|
|
symbol str = pack <$> P.symbol lexer str
|
|
|
|
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)
|
|
|
|
#else
|
|
|
|
import Data.Char
|
|
import Data.List (nub)
|
|
import Data.Text
|
|
import Text.Parser.Expression as X
|
|
import Text.Parser.LookAhead as X
|
|
import Text.Trifecta as X hiding (whiteSpace, symbol, symbolic)
|
|
|
|
identifier :: Parser Text
|
|
identifier = pack <$> ((:) <$> letter <*> many (alphaNum <|> oneOf "_."))
|
|
|
|
reserved :: String -> Parser Text
|
|
reserved = fmap pack . symbol
|
|
|
|
-----------------------------------------------------------
|
|
-- White space & symbols
|
|
-----------------------------------------------------------
|
|
symbol :: (CharParsing m, Monad m) => String -> m String
|
|
symbol name = lexeme (string name)
|
|
|
|
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 ("*/" ++ "/*")
|
|
|
|
#endif
|
|
|
|
someTill :: Parser a -> Parser end -> Parser [a]
|
|
someTill p end = go
|
|
where
|
|
go = (:) <$> p <*> scan
|
|
scan = (end *> return []) <|> go
|
|
|
|
symbolic :: Char -> Parser Char
|
|
symbolic c = char c <* whiteSpace
|