picnoir/hnix
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

now really fix parsing paths

Browse source
This commit is contained in:
Benno Fünfstück 2014-08-16 01:17:01 +02:00
parent ec5742a1a8
commit 24a4ffdce4
2 changed files with 15 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
Nix/Parser.hs
View file

@ -43,20 +43,19 @@ nixAntiquoted :: Parser a -> Parser (Antiquoted a NExpr)
nixAntiquoted p = Plain <$> p nixAntiquoted p = Plain <$> p
<|> Antiquoted <$> (try (string "${") *> whiteSpace *> nixApp <* symbolic '}') <|> Antiquoted <$> (try (string "${") *> whiteSpace *> nixApp <* symbolic '}')
selDot :: Parser ()
selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath)) *> whiteSpace
nixSelector :: Parser (NSelector NExpr) nixSelector :: Parser (NSelector NExpr)
nixSelector = keyName `sepBy1` symbolic '.' nixSelector = keyName `sepBy1` selDot where
nixSelect :: Parser NExpr -> Parser NExpr nixSelect :: Parser NExpr -> Parser NExpr
nixSelect term = build nixSelect term = build
<$> term <$> term
<*> optional (char '.' *> choice <*> optional ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixApp))
[ Left <$> nixPath
, fmap Right $ (,) <$> nixSelector <*> optional (reserved "or" *> nixApp)
])
where where
build t Nothing = t build t Nothing = t
build t (Just (Left p)) = Fix $ NApp t (mkPath $ '.' : p) build t (Just (s,o)) = Fix $ NSelect t s o
build t (Just (Right (s,o))) = Fix $ NSelect t s o
nixHasAttr :: Parser NExpr -> Parser NExpr nixHasAttr :: Parser NExpr -> Parser NExpr
nixHasAttr term = build <$> term <*> optional (reservedOp "?" *> nixSelector) where nixHasAttr term = build <$> term <*> optional (reservedOp "?" *> nixSelector) where
@ -72,7 +71,7 @@ nixTerm = choice
, nixIf , nixIf
, nixBool , nixBool
, nixNull , nixNull
, nixPathExpr -- can be expensive due to back-tracking , nixPath -- can be expensive due to back-tracking
, try nixLambda <|> nixSet , try nixLambda <|> nixSet
, nixStringExpr , nixStringExpr
, nixSym , nixSym
@ -98,14 +97,11 @@ nixParens = parens nixApp <?> "parens"
nixList :: Parser NExpr nixList :: Parser NExpr
nixList = brackets (Fix . NList <$> many (listTerm <* whiteSpace)) <?> "list" where nixList = brackets (Fix . NList <$> many (listTerm <* whiteSpace)) <?> "list" where
listTerm = nixSelect $ choice listTerm = nixSelect $ choice
[ nixInt, nixParens, nixList, nixSet, nixBool, nixNull, nixPathExpr, nixStringExpr [ nixInt, nixParens, nixList, nixSet, nixBool, nixNull, nixPath, nixStringExpr
, nixSym ] , nixSym ]
nixPathExpr :: Parser NExpr nixPath :: Parser NExpr
nixPathExpr = mkPath <$> nixPath nixPath = fmap mkPath $ (++)
nixPath :: Parser String
nixPath = (++)
<$> try ((++) <$> many (oneOf pathChars) <*> string "/") <$> try ((++) <$> many (oneOf pathChars) <*> string "/")
<*> some (oneOf ('/':pathChars)) <*> some (oneOf ('/':pathChars))
where pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9'] where pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']

7
tests/ParserTests.hs
View file

@ -201,8 +201,11 @@ case_string_antiquote = do
assertParseFail "${true}" assertParseFail "${true}"
assertParseFail "\"${true\"" assertParseFail "\"${true\""
case_fun_app_path :: Assertion case_select_path :: Assertion
case_fun_app_path = assertParseString "f ./." $ Fix $ NApp (mkSym "f") (mkPath "./.") case_select_path = do
assertParseString "f ./." $ Fix $ NApp (mkSym "f") (mkPath "./.")
assertParseString "f.b ../a" $ Fix $ NApp select (mkPath "../a")
where select = Fix $ NSelect (mkSym "f") (mkSelector "b") Nothing
tests :: TestTree tests :: TestTree
tests = $testGroupGenerator tests = $testGroupGenerator