parsing variadic functions, avoiding empty list error

This commit is contained in:
Allen Nelson 2015-06-23 19:18:43 -05:00
parent 365a17144e
commit 9765256ab4
6 changed files with 101 additions and 49 deletions

View File

@ -16,16 +16,17 @@ import Prelude hiding (mapM, sequence)
buildArgument :: Formals NValue -> NValue -> NValue
buildArgument paramSpec arg = either error (Fix . NVSet) $ case paramSpec of
FormalName name -> return $ Map.singleton name arg
FormalSet s -> lookupParamSet s
FormalLeftAt name s -> Map.insert name arg <$> lookupParamSet s
FormalRightAt s name -> Map.insert name arg <$> lookupParamSet s
FormalSet s Nothing -> lookupParamSet s
FormalSet s (Just name) -> Map.insert name arg <$> lookupParamSet s
where
go env k def = maybe (Left err) return $ Map.lookup k env <|> def
where err = "Could not find " ++ show k
lookupParamSet (FormalParamSet s) = case arg of
Fix (NVSet env) -> Map.traverseWithKey (go env) s
_ -> Left "Unexpected function environment"
lookupParamSet fps = case fps of
FixedParamSet s -> case arg of
Fix (NVSet env) -> Map.traverseWithKey (go env) s
_ -> Left "Unexpected function environment"
_ -> error "Can't yet handle variadic param sets"
evalExpr :: NExpr -> NValue -> IO NValue
evalExpr = cata phi

View File

@ -16,7 +16,7 @@ import Prelude hiding (elem)
-- | The lexer for this parser is defined in 'Nix.Parser.Library'.
nixExpr :: Parser NExpr
nixExpr = whiteSpace *> (nixToplevelForm <|> foldl' makeParser nixOpArg nixOperators)
nixExpr = whiteSpace *> (nixToplevelForm <|> foldl' makeParser nixTerm nixOperators)
where
makeParser term (Left NSelectOp) = nixSelect term
makeParser term (Left NAppOp) = chainl1 term $ pure $ \a b -> Fix (NApp a b)
@ -56,8 +56,9 @@ nixHasAttr term = build <$> term <*> optional (reservedOp "?" *> nixSelector) wh
build t Nothing = t
build t (Just s) = Fix $ NHasAttr t s
nixOpArg :: Parser NExpr
nixOpArg = nixSelect $ choice
-- | A self-contained unit.
nixTerm :: Parser NExpr
nixTerm = nixSelect $ choice
[ nixInt, nixBool, nixNull, nixParens, nixList, nixPath, nixSPath, nixUri
, nixStringExpr, nixSet, nixSym ]
@ -82,7 +83,7 @@ nixParens :: Parser NExpr
nixParens = parens nixExpr <?> "parens"
nixList :: Parser NExpr
nixList = brackets (Fix . NList <$> many nixOpArg) <?> "list"
nixList = brackets (Fix . NList <$> many nixTerm) <?> "list"
pathChars :: String
pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']
@ -90,6 +91,8 @@ pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']
slash :: Parser Char
slash = try (char '/' <* notFollowedBy (char '/')) <?> "slash"
-- | A path surrounded by angle brackets, indicating that it should be
-- looked up in the NIX_PATH environment variable at evaluation.
nixSPath :: Parser NExpr
nixSPath = mkPath True <$> try (char '<' *> some (oneOf pathChars <|> slash) <* symbolic '>')
<?> "spath"
@ -173,32 +176,50 @@ nixString = doubleQuoted <|> indented <?> "string"
escapeCode = choice [ c <$ char e | (c,e) <- escapeCodes ] <|> anyChar
-- | Gets all of the arguments for a function.
argExpr :: Parser (Formals NExpr)
argExpr = choice
[ idOrAtPattern <$> identifierNotUri <*> optional (symbolic '@' *> paramSet)
, setOrAtPattern <$> paramSet <*> optional (symbolic '@' *> identifier)
] <* symbolic ':'
where
paramSet :: Parser (FormalParamSet NExpr)
paramSet = FormalParamSet . Map.fromList <$> argList
argExpr = choice [atLeft, onlyname, atRight] <* symbolic ':' where
-- An argument not in curly braces. There's some potential ambiguity
-- in the case of, for example `x:y`. Is it a lambda function `x: y`, or
-- a URI `x:y`? Nix syntax says it's the latter. So we need to fail if
-- there's a valid URI parse here.
onlyname = choice [nixUri >> unexpected "valid uri",
FormalName <$> identifier]
argList :: Parser [(Text, Maybe NExpr)]
argList = braces (argName `sepBy` symbolic ',') <?> "arglist"
-- Parameters named by an identifier on the left (`args @ {x, y}`)
atLeft = try $ do
name <- identifier <* symbolic '@'
ps <- params
return $ FormalSet ps (Just name)
identifierNotUri :: Parser Text
identifierNotUri = notFollowedBy nixUri *> identifier
-- Parameters named by an identifier on the right, or none (`{x, y} @ args`)
atRight = do
ps <- params
name <- optional $ symbolic '@' *> identifier
return $ FormalSet ps name
argName :: Parser (Text, Maybe NExpr)
argName = (,) <$> identifier
<*> optional (symbolic '?' *> nixExpr)
-- Return the parameters set.
params = do
(args, dotdots) <- braces getParams
let pset = if dotdots then VariadicParamSet else FixedParamSet
return $ pset $ Map.fromList args
idOrAtPattern :: Text -> Maybe (FormalParamSet NExpr) -> Formals NExpr
idOrAtPattern i Nothing = FormalName i
idOrAtPattern i (Just s) = FormalLeftAt i s
setOrAtPattern :: FormalParamSet NExpr -> Maybe Text -> Formals NExpr
setOrAtPattern s Nothing = FormalSet s
setOrAtPattern s (Just i) = FormalRightAt s i
-- Collects the parameters within curly braces. Returns the parameters and
-- a boolean indicating if the parameters are variadic.
getParams :: Parser ([(Text, Maybe NExpr)], Bool)
getParams = go [] where
-- Attempt to parse `...`. If this succeeds, stop and return True.
-- Otherwise, attempt to parse an argument, optionally with a
-- default. If this fails, then return what has been accumulated
-- so far.
go acc = (token (string "...") >> return (acc, True)) <|> getMore acc
getMore acc = do
-- Could be nothing, in which just return what we have so far.
option (acc, False) $ do
-- Get an argument name and an optional default.
pair <- liftA2 (,) identifier (optional $ symbolic '?' *> nixExpr)
-- Either return this, or attempt to get a comma and restart.
option (acc ++ [pair], False) $ symbolic ',' >> go (acc ++ [pair])
nixBinders :: Parser [Binding NExpr]
nixBinders = (inherit <|> namedVar) `endBy` symbolic ';' where

View File

@ -71,13 +71,18 @@ prettyString (NUri uri) = text (unpack uri)
prettyFormals :: Formals NixDoc -> Doc
prettyFormals (FormalName n) = text $ unpack n
prettyFormals (FormalSet s) = prettyParamSet s
prettyFormals (FormalLeftAt n s) = text (unpack n) <> text "@" <> prettyParamSet s
prettyFormals (FormalRightAt s n) = prettyParamSet s <> text "@" <> text (unpack n)
prettyFormals (FormalSet s mname) = prettyParamSet s <> case mname of
Nothing -> empty
Just name -> text "@" <> text (unpack name)
prettyParamSet :: FormalParamSet NixDoc -> Doc
prettyParamSet (FormalParamSet args) =
lbrace <+> (hcat . punctuate (comma <> space) . map prettySetArg) (toList args) <+> rbrace
prettyParamSet params = lbrace <+> middle <+> rbrace
where
prettyArgs = case params of
FixedParamSet args -> map prettySetArg (toList args)
VariadicParamSet args -> map prettySetArg (toList args) ++ [text "..."]
middle = hcat $ punctuate (comma <> space) prettyArgs
prettyBind :: Binding NixDoc -> Doc
prettyBind (NamedVar n v) = prettySelector n <+> equals <+> withoutParens v <> semi

View File

@ -104,7 +104,9 @@ stripIndent xs = NString Indented . removePlainEmpty . mergePlain . unsplitLines
ls = stripEmptyOpening $ splitLines xs
ls' = map (dropSpaces minIndent) ls
minIndent = minimum . map (countSpaces . mergePlain) . stripEmptyLines $ ls
minIndent = case stripEmptyLines ls of
[] -> 0
nonEmptyLs -> minimum $ map (countSpaces . mergePlain) nonEmptyLs
stripEmptyLines = filter f where
f [Plain t] = not $ T.null $ T.strip t
@ -267,18 +269,22 @@ data Binding r
| Inherit (Maybe r) [NSelector r]
deriving (Typeable, Data, Ord, Eq, Functor, Show)
data FormalParamSet r = FormalParamSet (Map Text (Maybe r))
-- | For functions which are called with a set as an argument.
data FormalParamSet r
= FixedParamSet (Map Text (Maybe r)) -- ^ E.g. `{foo, bar}`
| VariadicParamSet (Map Text (Maybe r)) -- ^ E.g. `{foo, bar, ...}`
deriving (Eq, Ord, Generic, Typeable, Data, Functor, Show, Foldable, Traversable)
-- | @Formals@ represents all the ways the formal parameters to a
-- function can be represented.
data Formals r
= FormalName Text
| FormalSet (FormalParamSet r)
| FormalLeftAt Text (FormalParamSet r)
| FormalRightAt (FormalParamSet r) Text
| FormalSet (FormalParamSet r) (Maybe Text)
deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show, Foldable, Traversable)
-- | A functor-ized nix expression type, which lets us do things like traverse
-- expressions and map functions over them. The actual NExpr type is defined
-- below.
data NExprF r
-- value types
= NConstant NAtom
@ -338,7 +344,13 @@ mkOper2 :: NBinaryOp -> NExpr -> NExpr -> NExpr
mkOper2 op a = Fix . NOper . NBinary op a
mkFormalSet :: [(Text, Maybe NExpr)] -> Formals NExpr
mkFormalSet = FormalSet . FormalParamSet . Map.fromList
mkFormalSet = mkFixedParamSet
mkFixedParamSet :: [(Text, Maybe NExpr)] -> Formals NExpr
mkFixedParamSet ps = FormalSet (FixedParamSet $ Map.fromList ps) Nothing
mkVariadicParamSet :: [(Text, Maybe NExpr)] -> Formals NExpr
mkVariadicParamSet ps = FormalSet (VariadicParamSet $ Map.fromList ps) Nothing
mkApp :: NExpr -> NExpr -> NExpr
mkApp e = Fix . NApp e

View File

@ -16,16 +16,24 @@ nix path = do
Success n -> do
displayIO stdout $ renderPretty 0.4 80 (prettyNix n)
nixString :: String -> IO ()
nixString s = case parseNixString s of
Success n -> displayIO stdout $ renderPretty 0.4 80 (prettyNix n)
Failure e -> hPutStrLn stderr $ "Parse failed: " ++ show e
main :: IO ()
main = do
let usageStr = "Parses a nix file and prints to stdout.\n\
\\n\
\Usage:\n\
\ hnix --help\n\
\ hnix <path>\n"
\ hnix <path>\n\
\ hnix --expr <expr>\n"
let argErr msg = error $ "Invalid arguments: " ++ msg ++ "\n" ++ usageStr
getArgs >>= \case
"--help":_ -> putStrLn usageStr
"--expr":expr:_ -> nixString expr
"--expr":_ -> argErr "Provide an expression."
('-':_):_ -> argErr "Provide a path to a nix file."
path:_ -> nix path
_ -> argErr "Provide a path to a nix file."

View File

@ -146,18 +146,23 @@ case_lambda_or_uri = do
case_lambda_pattern :: Assertion
case_lambda_pattern = do
assertParseString "{b, c ? 1}: b" $
Fix $ NAbs (FormalSet args) (mkSym "b")
Fix $ NAbs (FormalSet args Nothing) (mkSym "b")
assertParseString "{ b ? x: x }: b" $
Fix $ NAbs (FormalSet args2) (mkSym "b")
Fix $ NAbs (FormalSet args2 Nothing) (mkSym "b")
assertParseString "a@{b,c ? 1}: b" $
Fix $ NAbs (FormalLeftAt "a" args) (mkSym "b")
Fix $ NAbs (FormalSet args (Just "a")) (mkSym "b")
assertParseString "{b,c?1}@a: c" $
Fix $ NAbs (FormalRightAt args "a") (mkSym "c")
Fix $ NAbs (FormalSet args (Just "a")) (mkSym "c")
assertParseString "{b,c?1,...}@a: c" $
Fix $ NAbs (FormalSet vargs (Just "a")) (mkSym "c")
assertParseString "{...}: 1" $
Fix $ NAbs (FormalSet (VariadicParamSet mempty) Nothing) (mkInt 1)
assertParseFail "a@b: a"
assertParseFail "{a}@{b}: a"
where
args = FormalParamSet $ Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
args2 = FormalParamSet $ Map.fromList [("b", Just lam)]
args = FixedParamSet $ Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
vargs = VariadicParamSet $ Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
args2 = FixedParamSet $ Map.fromList [("b", Just lam)]
lam = Fix $ NAbs (FormalName "x") (mkSym "x")
case_lambda_app_int :: Assertion