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

Implement indented strings + uri + SPATH

Browse source 
We now parse till line 10005 of all-packages.nix
This commit is contained in:
Benno Fünfstück 2014-08-18 22:54:20 +02:00
parent 76efcb6c7d
commit 8f0648f5bb
5 changed files with 217 additions and 66 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Nix/Eval.hs
View file

@ -93,8 +93,9 @@ evalExpr = cata phi
return $ Fix $ NVFunction args b
evalString :: NValue -> NString (NValue -> IO NValue) -> IO Text
evalString env (NString parts)
evalString env (NString _ parts)
= Text.concat <$> mapM (runAntiquoted return (fmap valueText . ($ env))) parts
evalString env (NUri t) = return t
evalBinds :: Bool -> NValue -> [Binding (NValue -> IO NValue)] ->
IO (Map.Map Text NValue)

98
Nix/Parser.hs
View file

@ -62,23 +62,25 @@ nixHasAttr term = build <$> term <*> optional (reservedOp "?" *> nixSelector) wh
build t Nothing = t
build t (Just s) = Fix $ NHasAttr t s
nixFunArgUnamb :: Parser NExpr
nixFunArgUnamb = choice
[ nixInt, nixBool, nixNull, nixParens, nixList, nixPath, nixSPath, nixUri
, nixStringExpr ]
nixFunArg :: Parser NExpr
nixFunArg = nixSelect $ nixFunArgUnamb <|> nixSet <|> nixSym
nixTerm :: Parser NExpr
nixTerm = choice
[ nixInt
, nixParens
, nixList
, nixLet
, nixIf
, nixAssert
, nixWith
, nixBool
, nixNull
, nixPath
, nixLambda
, nixSet
, nixStringExpr
, nixSym
] <* whiteSpace
nixTerm = nixSelect $ choice
[ nixFunArgUnamb
, nixLambda
, nixSet
, nixLet
, nixIf
, nixAssert
, nixWith
, nixSym
]
nixSym :: Parser NExpr
nixSym = mkSym <$> identifier
@ -97,20 +99,21 @@ nixNull = mkNull <$ try (symbol "null") <?> "null"
nixParens :: Parser NExpr
nixParens = parens nixApp <?> "parens"
nixFunArg :: Parser NExpr
nixFunArg = nixSelect $ choice
[ nixInt, nixParens, nixList, nixSet, nixBool, nixNull, nixPath, nixStringExpr
, nixSym ]
nixList :: Parser NExpr
nixList = brackets (Fix . NList <$> many nixFunArg) <?> "list"
pathChars :: String
pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']
nixSPath :: Parser NExpr
nixSPath = mkPath True <$> try (char '<' *> some (oneOf ('/':pathChars)) <* symbolic '>')
<?> "spath"
nixPath :: Parser NExpr
nixPath = token $ fmap mkPath $ (++)
<$> (try ((++) <$> many (oneOf pathChars) <*> string "/") <?> "path")
<*> some (oneOf ('/':pathChars))
<?> "path"
where pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']
nixPath = token $ fmap (mkPath False) $ (++)
<$> (try ((++) <$> many (oneOf pathChars) <*> string "/") <?> "path")
<*> some (oneOf ('/':pathChars))
<?> "path"
nixLet :: Parser NExpr
nixLet = fmap Fix $ NLet
@ -141,20 +144,43 @@ nixLambda = Fix <$> (NAbs <$> (try argExpr <?> "lambda arguments") <*> nixApp) <
nixStringExpr :: Parser NExpr
nixStringExpr = Fix . NStr <$> nixString
nixString :: Parser (NString NExpr)
nixString = NString . merge <$> (char '"' *> manyTill stringChar (symbolic '"')) <?> "string"
where
merge [] = [Plain ""]
merge [x] = [x]
merge (Plain a : Plain b : rs) = merge (Plain (a `append` b) : rs)
merge (x : rs) = x : merge rs
nixUri :: Parser NExpr
nixUri = token $ fmap (mkUri . pack) $ (++)
<$> try ((++) <$> (scheme <* char ':') <*> fmap (\x -> [':',x]) afterColonC)
<*> many afterColonC
where
scheme = (:) <$> letter <*> many (alphaNum <|> oneOf "+-.")
afterColonC = alphaNum <|> oneOf "%/?:@&=+$,-_.!~*'"
stringChar = char '\\' *> (Plain . singleton <$> escapeCode)
nixString :: Parser (NString NExpr)
nixString = doubleQuoted <|> indented <?> "string"
where
doubleQuoted = NString DoubleQuoted . removePlainEmpty . mergePlain
<$> (doubleQ *> many (stringChar doubleQ (void $ char '\\') doubleEscape)
<* token doubleQ)
<?> "double quoted string"
doubleQ = void $ char '"'
doubleEscape = Plain . singleton <$> (char '\\' *> escapeCode)
indented = stripIndent
<$> (indentedQ *> many (stringChar indentedQ indentedQ indentedEscape)
<* token indentedQ)
<?> "indented string"
indentedQ = void $ try (string "''") <?> "\"''\""
indentedEscape = fmap Plain
$ try (indentedQ *> char '\\') *> fmap singleton escapeCode
<|> try (indentedQ *> ("''" <$ char '\'' <|> "$" <$ char '$'))
stringChar end escStart esc
= esc
<|> Antiquoted <$> (antiStart *> nixApp <* char '}') -- don't skip trailing space
<|> Plain . singleton <$> char '$'
<|> Plain . pack <$> some (noneOf "\"\\$")
<|> Plain . pack <$> some plainChar
where plainChar = notFollowedBy (end <|> void (char '$') <|> escStart) *> anyChar
escapeCode = choice [ c <$ char e | (c,e) <- escapeCodes ]
escapeCode = choice [ c <$ char e | (c,e) <- escapeCodes ] <|> anyChar
argExpr :: Parser (Formals NExpr)
argExpr = choice

19
Nix/Pretty.hs
View file

@ -2,10 +2,12 @@ module Nix.Pretty where
import Data.Map (toList)
import Data.Maybe (isJust)
import Data.Text (Text, unpack)
import Data.Text (Text, unpack, replace, strip)
import Nix.Types
import Text.PrettyPrint.ANSI.Leijen
import qualified Data.Text as Text
-- | This type represents a pretty printed nix expression
-- together with some information about the expression.
data NixDoc = NixDoc
@ -46,10 +48,23 @@ wrapParens op sub
| otherwise = parens $ withoutParens sub
prettyString :: NString NixDoc -> Doc
prettyString (NString parts) = dquotes . hcat . map prettyPart $ parts
prettyString (NString DoubleQuoted parts) = dquotes . hcat . map prettyPart $ parts
where prettyPart (Plain t) = text . concatMap escape . unpack $ t
prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r)
escape '"' = "\""
escape x = maybe [x] (('\\':) . (:[])) $ toEscapeCode x
prettyString (NString Indented parts)
= group $ nest 2 (squote <> squote <$> content) <$> squote <> squote
where
content = vsep . map prettyLine . stripLastIfEmpty . splitLines $ parts
stripLastIfEmpty = reverse . f . reverse where
f ([Plain t] : xs) | Text.null (strip t) = xs
f xs = xs
prettyLine = hcat . map prettyPart
prettyPart (Plain t) = text . unpack . replace "$" "''$" . replace "''" "'''" $ t
prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r)
prettyString (NUri uri) = text (unpack uri)
prettyFormals :: Formals NixDoc -> Doc
prettyFormals (FormalName n) = text $ unpack n

94
Nix/Types.hs
View file

@ -9,19 +9,23 @@
module Nix.Types where
import Control.Applicative
import Control.Monad hiding (forM_, mapM, sequence)
import Data.Data
import Data.Foldable
import Data.List (intercalate)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Text hiding (concat, concatMap, head, map, zipWith, reverse, intercalate)
import Data.Monoid
import Data.Text (Text, pack)
import qualified Data.Text as T
import Data.Traversable
import Data.Tuple (swap)
import GHC.Exts
import GHC.Generics
import Prelude hiding (readFile, concat, concatMap, elem, mapM,
sequence)
sequence, minimum, foldr)
newtype Fix (f :: * -> *) = Fix { outF :: f (Fix f) }
@ -37,32 +41,94 @@ data NAtom
-- | An integer. The c nix implementation currently only supports integers that
-- fit in the range of 'Int64'.
= NInt Integer
| NPath FilePath
-- | The first argument of 'NPath' is 'True' if the path must be looked up in the Nix
-- search path.
-- For example, @<nixpkgs/pkgs>@ is represented by @NPath True "nixpkgs/pkgs"@,
-- while @foo/bar@ is represented by @NPath False "foo/bar@.
| NPath Bool FilePath
| NBool Bool
| NNull
deriving (Eq, Ord, Generic, Typeable, Data, Show)
atomText :: NAtom -> Text
atomText (NInt i) = pack (show i)
atomText (NPath p) = pack p
atomText (NBool b) = if b then "true" else "false"
atomText NNull = "null"
atomText (NPath s p)
| s = pack ("<" ++ p ++ ">")
| otherwise = pack p
-- | 'Antiquoted' represents an expression that is either
-- antiquoted (surrounded by ${...}) or plain (not antiquoted).
data Antiquoted v r = Plain v | Antiquoted r
deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show)
-- | Merge adjacent 'Plain' values with 'mappend'.
mergePlain :: Monoid v => [Antiquoted v r] -> [Antiquoted v r]
mergePlain [] = []
mergePlain (Plain a: Plain b: xs) = mergePlain (Plain (a <> b) : xs)
mergePlain (x:xs) = x : mergePlain xs
-- | Remove 'Plain' values equal to 'mempty'.
removePlainEmpty :: (Eq v, Monoid v) => [Antiquoted v r] -> [Antiquoted v r]
removePlainEmpty = filter f where
f (Plain x) = x /= mempty
f _ = True
runAntiquoted :: (v -> a) -> (r -> a) -> Antiquoted v r -> a
runAntiquoted f _ (Plain v) = f v
runAntiquoted _ f (Antiquoted r) = f r
data StringKind = DoubleQuoted | Indented
deriving (Eq, Ord, Generic, Typeable, Data, Show)
-- | A 'NixString' is a list of things that are either a plain string
-- or an antiquoted expression. After the antiquotes have been evaluated,
-- the final string is constructed by concating all the parts.
newtype NString r = NString [Antiquoted Text r]
data NString r = NString StringKind [Antiquoted Text r] | NUri Text
deriving (Eq, Ord, Generic, Typeable, Data, Functor, Show)
-- | Split a stream representing a string with antiquotes on line breaks.
splitLines :: [Antiquoted Text r] -> [[Antiquoted Text r]]
splitLines = uncurry (flip (:)) . go where
go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls where
(l : ls) = T.split (=='\n') t
f prefix (finished, current) = ((Plain prefix : current) : finished, [])
go (Antiquoted a : xs) = (Antiquoted a :) <$> go xs
go [] = ([],[])
-- | Join a stream of strings containing antiquotes again. This is the inverse
-- of 'splitLines'.
unsplitLines :: [[Antiquoted Text r]] -> [Antiquoted Text r]
unsplitLines = intercalate [Plain "\n"]
-- | Form an indented string by stripping spaces equal to the minimal indent.
stripIndent :: [Antiquoted Text r] -> NString r
stripIndent [] = NString Indented []
stripIndent xs = NString Indented . removePlainEmpty . mergePlain . unsplitLines $ ls'
where
ls = stripEmptyOpening $ splitLines xs
ls' = map (dropSpaces minIndent) ls
minIndent = minimum . map (countSpaces . mergePlain) . stripEmptyLines $ ls
stripEmptyLines = filter f where
f [Plain t] = not $ T.null $ T.strip t
f _ = True
stripEmptyOpening ([Plain t]:ts) | T.null (T.strip t) = ts
stripEmptyOpening ts = ts
countSpaces (Antiquoted _:_) = 0
countSpaces (Plain t : _) = T.length . T.takeWhile (== ' ') $ t
countSpaces [] = 0
dropSpaces 0 x = x
dropSpaces n (Plain t : cs) = Plain (T.drop n t) : cs
dropSpaces _ _ = error "stripIndent: impossible"
escapeCodes :: [(Char, Char)]
escapeCodes =
[ ('\n', 'n' )
@ -70,8 +136,6 @@ escapeCodes =
, ('\t', 't' )
, ('\\', '\\')
, ('$' , '$' )
, ('"' , '"' )
, ('\'', '\'')
]
fromEscapeCode :: Char -> Maybe Char
@ -81,7 +145,8 @@ toEscapeCode :: Char -> Maybe Char
toEscapeCode = (`lookup` escapeCodes)
instance IsString (NString r) where
fromString = NString . (:[]) . Plain . pack
fromString "" = NString DoubleQuoted []
fromString x = NString DoubleQuoted . (:[]) . Plain . pack $ x
-- | A 'KeyName' is something that can appear at the right side of an equals sign.
-- For example, @a@ is a 'KeyName' in @{ a = 3; }@, @let a = 3; in ...@, @{}.a@ or @{} ? a@.
@ -266,11 +331,16 @@ instance Ord (Fix NExprF) where compare (Fix x) (Fix y) = compare x y
mkInt :: Integer -> NExpr
mkInt = Fix . NConstant . NInt
mkStr :: Text -> NExpr
mkStr = Fix . NStr . NString . (:[]) . Plain
mkStr :: StringKind -> Text -> NExpr
mkStr kind x = Fix . NStr . NString kind $ if x == ""
then []
else [Plain x]
mkPath :: FilePath -> NExpr
mkPath = Fix . NConstant . NPath
mkUri :: Text -> NExpr
mkUri = Fix . NStr . NUri
mkPath :: Bool -> FilePath -> NExpr
mkPath b = Fix . NConstant . NPath b
mkSym :: Text -> NExpr
mkSym = Fix . NSym

69
tests/ParserTests.hs
View file

@ -22,10 +22,12 @@ case_constant_bool = do
case_constant_path :: Assertion
case_constant_path = do
assertParseString "./." $ mkPath "./."
assertParseString "./+-_/cdef/09ad+-/" $ mkPath "./+-_/cdef/09ad+-/"
assertParseString "/abc" $ mkPath "/abc"
assertParseString "../abc" $ mkPath "../abc"
assertParseString "./." $ mkPath False "./."
assertParseString "./+-_/cdef/09ad+-/" $ mkPath False "./+-_/cdef/09ad+-/"
assertParseString "/abc" $ mkPath False "/abc"
assertParseString "../abc" $ mkPath False "../abc"
assertParseString "<abc>" $ mkPath True "abc"
assertParseString "<../cdef>" $ mkPath True "../cdef"
assertParseFail "."
assertParseFail ".."
assertParseFail "/"
@ -72,8 +74,8 @@ case_set_complex_keynames = do
assertParseString "{ \"a${let a = \"b\"; in a}c\".e = 4; }" $ Fix $ NSet NonRec
[ NamedVar [DynamicKey (Plain str), StaticKey "e"] $ mkInt 4 ]
where
letExpr = Fix $ NLet [ NamedVar (mkSelector "a") (mkStr "b") ] (mkSym "a")
str = NString [Plain "a", Antiquoted letExpr, Plain "c"]
letExpr = Fix $ NLet [ NamedVar (mkSelector "a") (mkStr DoubleQuoted "b") ] (mkSym "a")
str = NString DoubleQuoted [Plain "a", Antiquoted letExpr, Plain "c"]
case_set_inherit_direct :: Assertion
case_set_inherit_direct = assertParseString "{ inherit ({a = 3;}); }" $ Fix $ NSet NonRec
@ -109,6 +111,13 @@ case_mixed_list = do
case_simple_lambda :: Assertion
case_simple_lambda = assertParseString "a: a" $ Fix $ NAbs (FormalName "a") (mkSym "a")
case_lambda_or_uri :: Assertion
case_lambda_or_uri = do
assertParseString "a :b" $ Fix $ NAbs (FormalName "a") (mkSym "b")
assertParseString "a c:def" $ Fix $ NApp (mkSym "a") (mkUri "c:def")
assertParseString "c:def: c" $ Fix $ NApp (mkUri "c:def:") (mkSym "c")
assertParseFail "def:"
case_lambda_pattern :: Assertion
case_lambda_pattern = do
assertParseString "{b, c ? 1}: b" $
@ -166,18 +175,18 @@ case_identifier_special_chars = do
assertParseFail "'a"
makeStringParseTest :: String -> Assertion
makeStringParseTest str = assertParseString ("\"" ++ str ++ "\"") $ mkStr $ pack str
makeStringParseTest str = assertParseString ("\"" ++ str ++ "\"") $ mkStr DoubleQuoted $ pack str
case_simple_string :: Assertion
case_simple_string = mapM_ makeStringParseTest ["abcdef", "a", "A"]
case_simple_string = mapM_ makeStringParseTest ["abcdef", "a", "A", " a a ", ""]
case_string_dollar :: Assertion
case_string_dollar = mapM_ makeStringParseTest ["a$b", "a$$b", "$cdef", "gh$i"]
case_string_escape :: Assertion
case_string_escape = do
assertParseString "\"\\$\\n\\t\\r\\\\\"" $ mkStr "$\n\t\r\\"
assertParseString "\" \\\" \\' \"" $ mkStr " \" ' "
assertParseString "\"\\$\\n\\t\\r\\\\\"" $ mkStr DoubleQuoted "$\n\t\r\\"
assertParseString "\" \\\" \\' \"" $ mkStr DoubleQuoted " \" ' "
case_if :: Assertion
case_if = do
@ -191,12 +200,12 @@ case_if = do
case_string_antiquote :: Assertion
case_string_antiquote = do
assertParseString "\"abc${ if true then \"def\" else \"abc\" } g\"" $
Fix $ NStr $ NString
Fix $ NStr $ NString DoubleQuoted
[ Plain "abc"
, Antiquoted $ Fix $ NIf (mkBool True) (mkStr "def") (mkStr "abc")
, Antiquoted $ Fix $ NIf (mkBool True) (mkStr DoubleQuoted "def") (mkStr DoubleQuoted "abc")
, Plain " g"
]
assertParseString "\"\\${a}\"" $ mkStr "${a}"
assertParseString "\"\\${a}\"" $ mkStr DoubleQuoted "${a}"
assertParseFail "\"a"
assertParseFail "${true}"
assertParseFail "\"${true\""
@ -214,8 +223,8 @@ case_select = do
case_select_path :: Assertion
case_select_path = do
assertParseString "f ./." $ Fix $ NApp (mkSym "f") (mkPath "./.")
assertParseString "f.b ../a" $ Fix $ NApp select (mkPath "../a")
assertParseString "f ./." $ Fix $ NApp (mkSym "f") (mkPath False "./.")
assertParseString "f.b ../a" $ Fix $ NApp select (mkPath False "../a")
where select = Fix $ NSelect (mkSym "f") (mkSelector "b") Nothing
case_fun_app :: Assertion
@ -225,6 +234,36 @@ case_fun_app = do
NSelect (mkSym "a") (mkSelector "x") (Just mkNull)
assertParseFail "f if true then null else null"
case_uri :: Assertion
case_uri = do
assertParseString "a:a" $ mkUri "a:a"
assertParseString "http://foo.bar" $ mkUri "http://foo.bar"
assertParseString "a+de+.adA+-:%%%ads%5asdk&/" $ mkUri "a+de+.adA+-:%%%ads%5asdk&/"
assertParseFail "http://foo${\"bar\"}"
assertParseFail ":bcdef"
assertParseFail "a%20:asda"
assertParseFail ".:adasd"
assertParseFail "+:acdcd"
case_indented_string :: Assertion
case_indented_string = do
assertParseString "''a''" $ mkStr Indented "a"
assertParseString "''\n foo\n bar''" $ mkStr Indented "foo\nbar"
assertParseString "'' ''" $ mkStr Indented ""
assertParseString "'''''''" $ mkStr Indented "''"
assertParseString "'' ${null}\n a${null}''" $ Fix $ NStr $ NString Indented
[ Antiquoted mkNull
, Plain "\na"
, Antiquoted mkNull
]
assertParseFail "'''''"
assertParseFail "'' '"
case_indented_string_escape :: Assertion
case_indented_string_escape = assertParseString
"'' ''\\n ''\\t ''\\\\ ''${ \\ \\n ' ''' ''" $
mkStr Indented "\n \t \\ ${ \\ \\n ' '' "
tests :: TestTree
tests = $testGroupGenerator