From 71a0876120b0b877dfaff5a9ef1ed108723e382b Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Sat, 2 Aug 2014 21:13:35 +0000 Subject: [PATCH 1/3] simplify set and lambda parsing use try and parser failure --- Nix/Parser.hs | 42 +++++++++++------------------------------- 1 file changed, 11 insertions(+), 31 deletions(-) diff --git a/Nix/Parser.hs b/Nix/Parser.hs index dcd352c..e4a22a6 100644 --- a/Nix/Parser.hs +++ b/Nix/Parser.hs @@ -101,21 +101,11 @@ nixIf = fmap Fix $ NIf -- or a lambda until we've looked ahead a bit. And then it may be neither, -- in which case we fall back to expected a plain string or identifier. setLambdaStringOrSym :: Bool -> Parser NExpr -setLambdaStringOrSym allowLambdas = do - isSetOrArgs <- try (lookAhead (reserved "rec") *> pure True) - <|> try (lookAhead (singleton <$> char '{') *> pure True) - <|> pure False - if isSetOrArgs - then setOrArgs - else do - y <- try (lookAhead (True <$ (identifier *> whiteSpace - *> symbolic ':'))) - <|> return False - if y - then if allowLambdas - then setOrArgs - else error "Unexpected lambda" - else keyName "string" +setLambdaStringOrSym True = try nixLambda <|> setLambdaStringOrSym False +setLambdaStringOrSym False = try nixSet <|> keyName + +nixLambda :: Parser NExpr +nixLambda = Fix <$> (NAbs <$> (argExpr "arguments") <*> nixApp) stringish :: Parser NExpr stringish = (char '"' *> (merge <$> manyTill stringChar (char '"'))) @@ -129,9 +119,9 @@ stringish = (char '"' *> (merge <$> manyTill stringChar (char '"'))) argExpr :: Parser NExpr argExpr = (Fix . NArgSet . Map.fromList <$> argList) - <|> ((mkSym <$> identifier) "argname") + <|> ((mkSym <$> identifier <* symbolic ':') "argname") where - argList = braces ((argName <* whiteSpace) `sepBy` symbolic ',') + argList = braces ((argName <* whiteSpace) `sepBy` symbolic ',') <* symbolic ':' "arglist" argName = (,) <$> (identifier <* whiteSpace) @@ -147,20 +137,6 @@ nixBinders = (scopedInherit <|> inherit <|> namedVar) `endBy` symbolic ';' where keyName :: Parser NExpr keyName = (stringish <|> (mkSym <$> identifier)) <* whiteSpace -setOrArgs :: Parser NExpr -setOrArgs = do - sawRec <- try (reserved "rec" *> pure True) <|> pure False - haveSet <- - if sawRec - then return True - else try (lookAhead lookaheadForSet) - if haveSet - then braces (Fix . NSet (if sawRec then Rec else NonRec) <$> nixBinders) "set" - else do - args <- argExpr "arguments" - symbolic ':' *> fmap Fix (NAbs <$> pure args <*> nixApp) - <|> pure args - lookaheadForSet :: Parser Bool lookaheadForSet = do x <- (symbolic '{' *> return True) <|> return False @@ -169,5 +145,9 @@ lookaheadForSet = do if not y then return y else (symbolic '=' *> return True) <|> return False +nixSet :: Parser NExpr +nixSet = Fix <$> (NSet <$> isRec <*> (braces nixBinders "set")) where + isRec = try (reserved "rec" *> pure Rec) <|> pure NonRec + parseNixFile :: MonadIO m => FilePath -> m (Result NExpr) parseNixFile = parseFromFileEx nixApp From 4242b91e8ae0a8c4bda8ce6ad07da32e9ec74150 Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Sat, 2 Aug 2014 21:55:33 +0000 Subject: [PATCH 2/3] add some language pragmas --- Nix/Types.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Nix/Types.hs b/Nix/Types.hs index d3c52ed..d775c34 100644 --- a/Nix/Types.hs +++ b/Nix/Types.hs @@ -1,3 +1,10 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE OverloadedStrings #-} + module Nix.Types where import Control.Monad hiding (forM_, mapM, sequence) From 9f07afd101b2709334799b6de6c93dd120175a8f Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Sun, 3 Aug 2014 16:01:09 +0000 Subject: [PATCH 3/3] Handle full formal parameters syntax --- Nix/Eval.hs | 2 +- Nix/Parser.hs | 23 ++++++++++------------- Nix/Pretty.hs | 11 ++++++++++- Nix/Types.hs | 52 +++++++++++++++++++++++++++++++++++++++------------ 4 files changed, 61 insertions(+), 27 deletions(-) diff --git a/Nix/Eval.hs b/Nix/Eval.hs index 91b6e0c..96f4b67 100644 --- a/Nix/Eval.hs +++ b/Nix/Eval.hs @@ -41,7 +41,7 @@ evalExpr = cata phi -- Fix . NVConstant . NStr . T.concat -- <$> mapM (fmap valueText . ($ env)) l - phi (NArgSet s) = \env -> Fix . NVArgSet <$> mapM (T.sequence . fmap ($ env)) s + phi (NArgs s) = \env -> Fix . NVArgSet <$> mapM (T.sequence . fmap ($ env)) (formalsAsMap s) -- TODO: recursive sets phi (NSet _b binds) = \env -> diff --git a/Nix/Parser.hs b/Nix/Parser.hs index e4a22a6..6402244 100644 --- a/Nix/Parser.hs +++ b/Nix/Parser.hs @@ -118,13 +118,18 @@ stringish = (char '"' *> (merge <$> manyTill stringChar (char '"'))) <|> (mkStr . pack <$> many (noneOf "\"\\")) argExpr :: Parser NExpr -argExpr = (Fix . NArgSet . Map.fromList <$> argList) - <|> ((mkSym <$> identifier <* symbolic ':') "argname") +argExpr = (try (Fix . NArgs . FormalSet <$> paramSet) + <|> try (Fix . NArgs . FormalName <$> identifier <* whiteSpace) + <|> try (Fix . NArgs <$> (FormalLeftAt <$> identifier <* whiteSpace <*> paramSet)) + <|> try (Fix . NArgs <$> (FormalRightAt <$> paramSet <*> identifier <* whiteSpace))) <* symbolic ':' where - argList = braces ((argName <* whiteSpace) `sepBy` symbolic ',') <* symbolic ':' + paramSet :: Parser (FormalParamSet NExpr) + paramSet = (FormalParamSet . Map.fromList <$> argList) + argList :: Parser [(Text, Maybe NExpr)] + argList = braces ((argName <* whiteSpace) `sepBy` symbolic ',') <* symbolic ':' "arglist" - - argName = (,) <$> (identifier <* whiteSpace) + argName :: Parser (Text, Maybe NExpr) + argName = (,) <$> (identifier <* whiteSpace) <*> optional (symbolic '?' *> nixExpr False) nixBinders :: Parser [Binding NExpr] @@ -137,14 +142,6 @@ nixBinders = (scopedInherit <|> inherit <|> namedVar) `endBy` symbolic ';' where keyName :: Parser NExpr keyName = (stringish <|> (mkSym <$> identifier)) <* whiteSpace -lookaheadForSet :: Parser Bool -lookaheadForSet = do - x <- (symbolic '{' *> return True) <|> return False - if not x then return x else do - y <- (keyName *> return True) <|> return False - if not y then return y else - (symbolic '=' *> return True) <|> return False - nixSet :: Parser NExpr nixSet = Fix <$> (NSet <$> isRec <*> (braces nixBinders "set")) where isRec = try (reserved "rec" *> pure Rec) <|> pure NonRec diff --git a/Nix/Pretty.hs b/Nix/Pretty.hs index 97b7b0f..35d7a81 100644 --- a/Nix/Pretty.hs +++ b/Nix/Pretty.hs @@ -10,6 +10,15 @@ prettyBind (NamedVar n v) = prettyNix n <+> equals <+> prettyNix v <> semi prettyBind (Inherit ns) = text "inherit" <+> fillSep (map prettyNix ns) <> semi prettyBind (ScopedInherit s ns) = text "inherit" <+> parens (prettyNix s) <+> fillSep (map prettyNix ns) <> semi +prettyFormals :: Formals -> Doc +prettyFormals (FormalName n) = text $ unpack n +prettyFormals (FormalSet s) =prettyParamSet s +prettyFormals (FormalLeftAt s n) = prettyParamSet s <> text "@" <> text (unpack n) +prettyFormals (FormalRightAt n s) text (unpack n) <> text "@" <> prettyParamSet s + +prettyParamSet :: FormalParamSet -> Doc +prettyParamSet s = lbrace <+> hcat (map prettySetArg $ toList args) <+> rbrace + prettySetArg :: (Text, Maybe NExpr) -> Doc prettySetArg (n, Nothing) = text (unpack n) prettySetArg (n, Just v) = text (unpack n) <+> text "?" <+> prettyNix v @@ -50,7 +59,7 @@ prettyNix (Fix expr) = go expr where go (NOper oper) = prettyOper oper go (NList xs) = lbracket <+> fillSep (map prettyNix xs) <+> rbracket - go (NArgSet args) = lbrace <+> vcat (map prettySetArg $ toList args) <+> rbrace + go (NArgs fs) = prettyFormals fs go (NSet rec xs) = (case rec of Rec -> "rec"; NonRec -> empty) diff --git a/Nix/Types.hs b/Nix/Types.hs index d775c34..adc0995 100644 --- a/Nix/Types.hs +++ b/Nix/Types.hs @@ -113,7 +113,43 @@ data Binding r = NamedVar r r | Inherit [r] | ScopedInherit r [r] instance Show r => Show (Binding r) where show (NamedVar name val) = show name ++ " = " ++ show val ++ ";" show (Inherit names) = "inherit " ++ concatMap show names ++ ";" - show (ScopedInherit context names) = "inherit (" ++ show context ++ ") " ++ concatMap show names ++ "; " + show (ScopedInherit context names) = "inherit (" ++ show context ++ ") " ++ concatMap show names ++ ";" + +data FormalParamSet r = FormalParamSet (Map Text (Maybe r)) + deriving (Eq, Ord, Generic, Typeable, Data, Functor) + +instance Show r => Show (FormalParamSet r) where + show (FormalParamSet h) = "{ " ++ go (Map.toList h) ++ " }" + where + go [] = "" + go [x] = showArg x + go (x:xs) = showArg x ++ ", " ++ go xs + + showArg (k, Nothing) = unpack k + showArg (k, Just v) = unpack k ++ " ? " ++ show v + +-- | @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 + deriving (Ord, Eq, Generic, Typeable, Data, Functor) + +instance Show r => Show (Formals r) where + show (FormalName n) = show n + show (FormalSet s) = show s + show (FormalLeftAt n s) = show n ++ "@" ++ show s + show (FormalRightAt s n) = show s ++ "@" ++ show n + +-- | @formalsAsMap@ combines the outer and inner name bindings of +-- 'Formals' +formalsAsMap :: Formals r -> Map Text (Maybe r) +formalsAsMap (FormalName n) = Map.singleton n Nothing +formalsAsMap (FormalSet (FormalParamSet s)) = s +formalsAsMap (FormalLeftAt n (FormalParamSet s)) = Map.insert n Nothing s +formalsAsMap (FormalRightAt (FormalParamSet s) n) = Map.insert n Nothing s data NExprF r = NConstant NAtom @@ -122,7 +158,7 @@ data NExprF r | NList [r] -- ^ A "concat" is a list of things which must combine to form a string. - | NArgSet (Map Text (Maybe r)) + | NArgs (Formals r) | NSet NSetBind [Binding r] | NLet [Binding r] r @@ -152,15 +188,7 @@ instance Show f => Show (NExprF f) where go [x] = show x go (x:xs) = show x ++ ", " ++ go xs - show (NArgSet h) = "{ " ++ go (Map.toList h) ++ " }" - where - go [] = "" - go [x] = showArg x - go (x:xs) = showArg x ++ ", " ++ go xs - - showArg (k, Nothing) = unpack k - showArg (k, Just v) = unpack k ++ " ? " ++ show v - + show (NArgs fs) = show fs show (NSet b xs) = show b ++ " { " ++ concatMap show xs ++ " }" show (NLet v e) = "let " ++ show v ++ "; " ++ show e @@ -177,7 +205,7 @@ dumpExpr = cata phi where phi (NConstant x) = "NConstant " ++ show x phi (NOper x) = "NOper " ++ show x phi (NList l) = "NList [" ++ show l ++ "]" - phi (NArgSet xs) = "NArgSet " ++ show xs + phi (NArgs xs) = "NArgs " ++ show xs phi (NSet b xs) = "NSet " ++ show b ++ " " ++ show xs phi (NLet v e) = "NLet " ++ show v ++ " " ++ e phi (NIf i t e) = "NIf " ++ i ++ " " ++ t ++ " " ++ e