From 9765256ab454b9d1f244237d789181b15603ad27 Mon Sep 17 00:00:00 2001 From: Allen Nelson Date: Tue, 23 Jun 2015 19:18:43 -0500 Subject: [PATCH] parsing variadic functions, avoiding empty list error --- Nix/Eval.hs | 13 ++++---- Nix/Parser.hs | 71 ++++++++++++++++++++++++++++---------------- Nix/Pretty.hs | 15 ++++++---- Nix/Types.hs | 24 +++++++++++---- main/Main.hs | 10 ++++++- tests/ParserTests.hs | 17 +++++++---- 6 files changed, 101 insertions(+), 49 deletions(-) diff --git a/Nix/Eval.hs b/Nix/Eval.hs index 4be44cf..3f9bc7a 100644 --- a/Nix/Eval.hs +++ b/Nix/Eval.hs @@ -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 diff --git a/Nix/Parser.hs b/Nix/Parser.hs index a38b561..e870e89 100644 --- a/Nix/Parser.hs +++ b/Nix/Parser.hs @@ -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 diff --git a/Nix/Pretty.hs b/Nix/Pretty.hs index 8f8ff20..d8b055a 100644 --- a/Nix/Pretty.hs +++ b/Nix/Pretty.hs @@ -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 diff --git a/Nix/Types.hs b/Nix/Types.hs index 527f8e4..6b8a29e 100644 --- a/Nix/Types.hs +++ b/Nix/Types.hs @@ -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 diff --git a/main/Main.hs b/main/Main.hs index abdb1f9..efb2436 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -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 \n" + \ hnix \n\ + \ hnix --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." diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs index d3d8f67..fd45d23 100644 --- a/tests/ParserTests.hs +++ b/tests/ParserTests.hs @@ -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