language-nix 1.0 → 2

raw patch · 13 files changed

+250/−833 lines, 13 filesdep +deepseqdep +lensdep +prettydep −HUnitdep −containersdep −hspecdep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, lens, pretty, regex-posix

Dependencies removed: HUnit, containers, hspec, language-nix, mtl, parsec, transformers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +26/−26
• Language/Nix.hs +0/−549
• Setup.hs +0/−2
• Setup.lhs +8/−0
• language-nix.cabal +50/−37
• parse-nix.hs +0/−16
• run-nix.hs +0/−16
• self-test.hs +0/−187
• src/Language/Nix.hs +11/−0
• src/Language/Nix/Binding.hs +34/−0
• src/Language/Nix/Identifier.hs +64/−0
• src/Language/Nix/Path.hs +51/−0
• test/Main.hs +6/−0

@@ -1,30 +1,30 @@-Copyright (c) 2013, Peter Simons <simons@cryp.to>--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:+Redistribution and use in source and binary forms, with or+without modification, are permitted provided that the+following conditions are met: -    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.+  * Redistributions of source code must retain the above+    copyright notice, this list of conditions and the+    following disclaimer. -    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.+  * Redistributions in binary form must reproduce the above+    copyright notice, this list of conditions and the+    following disclaimer in the documentation and/or other+    materials provided with the distribution. -    * Neither the name of Peter Simons nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+  * The names of its contributors may not be used to endorse+    or promote products derived from this software without+    specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR+OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,549 +0,0 @@-{- |-   Module      :  Language.Nix-   Copyright   :  (c) 2013 Peter Simons-   License     :  BSD3-   Maintainer  :  simons@cryp.to- -}--module Language.Nix-  (-    -- * Evaluating the Nix Language-    run, runEval, eval, builtins,--    -- * Running the Parser-    parseNixFile, parseNix, parse, parse', ParseError,--    -- * Nix Language AST-    Expr(..), ScopedIdent(..), Attr(..), genIdentifier,--    -- * Nix Language Parsers-    expr, listExpr, term, operatorTable, listOperatorTable, identifier, literal,-    nixString, literalURI, attrSet, scopedIdentifier, attribute, list, letExpr,-    attrSetPattern,--    -- * Parsec Language Specification-    TokenParser, LanguageDef, NixParser, NixOperator, nixLanguage, nixLexer,-    symbol, reserved, reservedOp, lexeme, parens, braces, brackets, natural,-    assign, semi, dot, commaSep1, whitespace,-  )-  where--import Prelude hiding ( lookup )-import Data.Functor.Identity-import Control.Applicative ( (<$>), (<*>), (<$), (<*), (*>) )-import Text.Parsec hiding ( parse )-import qualified Text.Parsec as Parsec-import qualified Text.Parsec.Language as Parsec-import qualified Text.Parsec.Token as Parsec-import Text.Parsec.Expr-import Test.QuickCheck--import Text.Show.Functions ( )-import Control.Monad.Reader-import qualified Control.Monad.Error as ErrT-import Control.Monad.Error hiding ( Error )-import qualified Data.Map as Map ( )-import Data.Map hiding ( map, foldr )---- import Debug.Trace-trace :: a -> b -> b-trace _ b = b------- Nix Language Definition for Parsec ----------------------------------------type TokenParser = Parsec.GenTokenParser String () Identity-type LanguageDef = Parsec.GenLanguageDef String () Identity-type NixParser a = ParsecT String () Identity a-type NixOperator = Operator String () Identity Expr--nixLanguage :: LanguageDef-nixLanguage = Parsec.emptyDef-  { Parsec.commentStart    = "/*"-  , Parsec.commentEnd      = "*/"-  , Parsec.commentLine     = "#"-  , Parsec.nestedComments  = False-  , Parsec.identStart      = letter <|> oneOf "_"-  , Parsec.identLetter     = alphaNum <|> oneOf "-_"-  , Parsec.opStart         = Parsec.opLetter nixLanguage-  , Parsec.opLetter        = oneOf ".!{}[]+=?&|/:"-  , Parsec.reservedOpNames = [".","!","+","++","&&","||","?","=","//","==","!=",":"]-  , Parsec.reservedNames   = ["rec","let","in","import","with","inherit","assert","or","if","then","else"]-  , Parsec.caseSensitive   = True-  }--nixLexer :: TokenParser-nixLexer = Parsec.makeTokenParser nixLanguage--symbol :: String -> NixParser String-symbol = Parsec.symbol nixLexer--reserved :: String -> NixParser ()-reserved = Parsec.reserved nixLexer--reservedOp :: String -> NixParser ()-reservedOp = Parsec.reservedOp nixLexer--lexeme :: NixParser a -> NixParser a-lexeme = Parsec.lexeme nixLexer--parens :: NixParser a -> NixParser a-parens = Parsec.parens nixLexer--braces :: NixParser a -> NixParser a-braces = Parsec.braces nixLexer--brackets :: NixParser a -> NixParser a-brackets = Parsec.brackets nixLexer--natural :: NixParser String-natural = show <$> Parsec.natural nixLexer--assign :: NixParser String-assign = symbol "="--semi :: NixParser String-semi = Parsec.semi nixLexer--dot :: NixParser String-dot = Parsec.dot nixLexer--commaSep1 :: NixParser a -> NixParser [a]-commaSep1 = Parsec.commaSep1 nixLexer--whitespace :: NixParser ()-whitespace = Parsec.whiteSpace nixLexer------- Nix Expressions -----------------------------------------------------------newtype ScopedIdent = SIdent [String]-  deriving (Read, Show, Eq)--data Attr = Assign ScopedIdent Expr-          | Inherit ScopedIdent [String]-  deriving (Read, Show, Eq)--genIdentifier :: Gen String-genIdentifier = ((:) <$> elements firstChar <*> listOf (elements identChar)) `suchThat` (`notElem` Parsec.reservedNames nixLanguage)-  where firstChar = ['a'..'z'] ++ ['A'..'Z'] ++ "_"-        identChar = firstChar ++ ['0'..'9'] ++ "-"--instance Arbitrary ScopedIdent where-  arbitrary = SIdent <$> listOf1 genIdentifier--data Expr = Null-          | Lit String-          | Ident String-          | Boolean Bool-          | AttrSet Bool [Attr]-          | AttrSetP (Maybe String) [(String, Maybe Expr)]-          | List [Expr]-          | Deref Expr Expr-          | HasAttr Expr Expr-          | DefAttr Expr Expr-          | Concat Expr Expr-          | Append Expr Expr-          | Not Expr-          | Union Expr Expr-          | Equal Expr Expr-          | Inequal Expr Expr-          | And Expr Expr-          | Or Expr Expr-          | Implies Expr Expr-          | Fun Expr Expr-          | Let [Attr] Expr-          | Apply Expr Expr-          | Import Expr-          | With Expr-          | Assert Expr-          | IfThenElse Expr Expr Expr-  deriving (Read, Show, Eq)--expr :: NixParser Expr-expr = whitespace >> buildExpressionParser operatorTable term--listExpr :: NixParser Expr-listExpr = buildExpressionParser listOperatorTable term--term :: NixParser Expr-term = choice [ parens expr-              , list-              , try attrSetPattern-              , attrSet-              , letExpr-              , reserved "import" >> Import <$> expr-              , reserved "with" >> With <$> expr <* semi-              , reserved "assert" >> Assert <$> expr <* semi-              , IfThenElse <$> (reserved "if" *> expr) <*> (reserved "then" *> expr) <*> (reserved "else" *> expr)-              , try literal-              , identifier-              ]--operatorTable :: [[NixOperator]]-operatorTable = x1 : x2 : [ Infix (Apply <$ whitespace) AssocLeft ] : xs-  where (x1:x2:xs) = listOperatorTable--listOperatorTable :: [[NixOperator]]-listOperatorTable = [ [ binary "." Deref AssocLeft ]-                    , [ binary "or" DefAttr AssocNone ]-                {-  , [ Infix (Apply <$ whitespace) AssocRight ] -}-                    , [ binary "?" HasAttr AssocNone ]-                    , [ binary "++" Concat AssocRight ]-                    , [ binary "+" Append AssocLeft ]-                    , [ prefix "!" Not ]-                    , [ binary "//" Union AssocRight ]-                    , [ binary "==" Equal AssocNone ]-                    , [ binary "!=" Inequal AssocNone ]-                    , [ binary "&&" And AssocLeft ]-                    , [ binary "||" Or AssocLeft ]-                    , [ binary "->" Implies AssocNone ]-                    , [ binary ":" Fun AssocRight ]-                    ]-  where-    binary :: String -> (Expr -> Expr -> Expr) -> Assoc -> NixOperator-    binary op fun = Infix (fun <$ reservedOp op)--    prefix :: String -> (Expr -> Expr) -> NixOperator-    prefix op fun = Prefix (fun <$ reservedOp op)--identifier :: NixParser Expr-identifier = Ident <$> Parsec.identifier nixLexer--literal :: NixParser Expr-literal = Lit <$> (stringLiteral <|> nixString <|> natural <|> literalURI)--stringLiteral :: NixParser String-stringLiteral = lexeme $ between (string "\"") (string "\"") (concat <$> many stringChar)-  where-    stringChar :: NixParser String-    stringChar = choice [ many1 (noneOf "$\\\"")-                        , try $ char '$' >> braces expr >> return ""-                        , return <$> char '$'-                        , char '\\' >> anyChar >>= \c -> return ['\\',c]-                        ]--nixString :: NixParser String-nixString = lexeme $ between (string "''") (string "''") (concat <$> many stringChar)-  where-    stringChar :: NixParser String-    stringChar = choice [ many1 (noneOf "$'")-                        , try $ char '$' >> braces expr >> return ""-                        , return <$> char '$'-                        , try $ (return <$> char '\'') <* notFollowedBy (char '\'')-                        , try $ string "''" >> string "${"-                        ]--literalURI :: NixParser String-literalURI = lexeme $ try absoluteURI <|> relativeURI--absoluteURI :: NixParser String-absoluteURI = (++) <$> scheme <*> ((:) <$> char ':' <*> (hierPart <|> opaquePart))--relativeURI :: NixParser String-relativeURI = (++) <$> (absPath <|> relPath) <*> option "" (char '?' >> query)--absPath :: NixParser String-absPath = (:) <$> char '/' <*> pathSegments--authority :: NixParser String-authority = server <|> regName--domainlabel :: NixParser String-domainlabel = (:) <$> alphaNum <*> option "" ((++) <$> many (char '-') <*> domainlabel)--escapedChars :: NixParser Char-escapedChars = char '%' >> hexDigit >> hexDigit--hierPart :: NixParser String-hierPart = (++) <$> (try netPath <|> absPath) <*> option "" (char '?' >> query)--host :: NixParser String-host = hostname <|> ipv4address--hostname :: NixParser String-hostname = many (domainlabel >> char '.') >> toplabel >> option "" (string ".")--hostport :: NixParser String-hostport = (++) <$> host <*> option "" ((:) <$> char ':' <*> port)--ipv4address :: NixParser String-ipv4address = many1 digit >> char '.' >> many1 digit >> char '.' >> many1 digit >> char '.' >> many1 digit--markChars :: NixParser Char-markChars = oneOf "-_.!~*'" -- Note that "()" have been removed here!--netPath :: NixParser String-netPath = (++) <$> ((++) <$> string "//" <*> authority) <*> option "" absPath--opaquePart :: NixParser String-opaquePart = uricNoSlash >> many uric--pathSegments :: NixParser String-pathSegments = (++) <$> segment <*> (concat <$> many ((:) <$> char '/' <*> segment))--pchar :: NixParser Char-pchar = unreservedChars <|> escapedChars <|> oneOf ":@&=+$,"--port :: NixParser String-port = many1 digit--query :: NixParser String-query = many uric--regName :: NixParser String-regName = many1 (unreservedChars <|> escapedChars <|> oneOf "$,:@&=+") -- Note that ';' has been removed here!--relPath :: NixParser String-relPath = (++) <$> relSegment <*> absPath--relSegment :: NixParser String-relSegment = many1 (unreservedChars <|> escapedChars <|> oneOf "@&=+$,") -- Note that ';' has been removed here!--reservedChars :: NixParser Char-reservedChars = oneOf "/?:@&=+$," -- Note that ';' has been removed here!--scheme :: NixParser String-scheme = (:) <$> letter <*> many (alphaNum <|> oneOf "+-.")--segment :: NixParser String-segment = {- (++) <$> -} many pchar {- <*> (concat <$> many ((:) <$> char ';' <*> param)) -}--server :: NixParser String-server = option "" (option "" ((++) <$> userinfo <*> string "@") >> hostport)--toplabel :: NixParser Char-toplabel = letter <|> (letter >> many (alphaNum <|> char '-') >> alphaNum)--unreservedChars :: NixParser Char-unreservedChars = alphaNum <|> markChars--uric :: NixParser Char-uric = reservedChars <|> unreservedChars <|> escapedChars--uricNoSlash :: NixParser Char-uricNoSlash = unreservedChars <|> escapedChars <|> oneOf ";?:@&=+$,"--userinfo :: NixParser String-userinfo = many (unreservedChars <|> escapedChars <|> oneOf ";:&=+$,")--attrSet :: NixParser Expr-attrSet = AttrSet <$> option False (True <$ reserved "rec") <*> braces (attribute `endBy` semi)--scopedIdentifier :: NixParser ScopedIdent-scopedIdentifier = SIdent <$> sepBy1 (Parsec.identifier nixLexer) dot--attribute :: NixParser Attr-attribute =  (Assign <$> (SIdent . return <$> stringLiteral <|> scopedIdentifier) <* assign <*> expr)-         <|> (Inherit <$> (symbol "inherit" *> option (SIdent []) (parens scopedIdentifier)) <*> many1 (Parsec.identifier nixLexer))--list :: NixParser Expr-list = List <$> brackets (many listExpr)--attrSetPattern :: NixParser Expr-attrSetPattern = AttrSetP <$> optionMaybe atPattern <*> setPattern-  where-    atPattern  = Parsec.identifier nixLexer <* reserved "@"-    setPattern = braces $ commaSep1 $ (,) <$> Parsec.identifier nixLexer <*> optionMaybe (reservedOp "?" >> expr) <|> ellipsis-    ellipsis   = ("...",Nothing) <$ reserved "..."--letExpr :: NixParser Expr-letExpr = choice [ try $ Let <$> (reserved "let" *> try attribute `endBy1` semi) <*> (reserved "in" *> expr)-                 , (`Let` Ident "body") <$> (reserved "let" *> braces (try attribute `endBy1` semi))-                 ]--parseNixFile :: FilePath -> IO (Either ParseError Expr)-parseNixFile path = parse' (expr <* eof) path <$> readFile path--parseNix :: String -> Either ParseError Expr-parseNix = parse expr--parse' :: NixParser a -> SourceName -> String -> Either ParseError a-parse' = Parsec.parse--parse :: NixParser a -> String -> Either ParseError a-parse p = parse' (p <* eof) "<string>"------- Nix Evaluation ------------------------------------------------------------type VarName = String-type Env = Map VarName Expr--data Error = CannotCoerceToString Expr-           | CannotCoerceToBool Expr-           | TypeMismatch Expr-           | UndefinedVariable VarName-           | Unsupported Expr-           | Unstructured String-           | InvalidSyntax ParseError-  deriving (Show)--instance ErrT.Error Error where-  strMsg = Unstructured-  noMsg  = Unstructured "no error message available"--type Eval a = ErrorT Error (Reader Env) a--getEnv :: VarName -> Eval Expr-getEnv v = ask >>= maybe (throwError (UndefinedVariable v)) return . lookup v--onError :: Eval a -> (Error -> Bool, Eval a) -> Eval a-onError f (p,g) = catchError f (\e -> if p e then g else throwError e)--isUndefinedVariable :: Error -> Bool-isUndefinedVariable (UndefinedVariable _) = True-isUndefinedVariable _                     = False--isCoerceToString :: Error -> Bool-isCoerceToString (CannotCoerceToString _) = True-isCoerceToString _                        = False--isCoerceToBool :: Error -> Bool-isCoerceToBool (CannotCoerceToBool _) = True-isCoerceToBool _                      = False--evalBool :: Expr -> Eval Bool-evalBool e | trace ("evalBool " ++ show e) False = undefined-evalBool (Boolean x)    = return x-evalBool (Ident v)      = getEnv v >>= evalBool-evalBool (And x y)      = (&&) <$> evalBool x <*> evalBool y-evalBool (Or x y)       = (||) <$> evalBool x <*> evalBool y-evalBool (Not x)        = not <$> evalBool x-evalBool e@(Equal x y)  = ((==) <$> evalString  x <*> evalString  y)-                            `onError` (isCoerceToString, (==) <$> evalBool x <*> evalBool y)-                            `onError` (isCoerceToBool, throwError (TypeMismatch e))-evalBool e              = throwError (CannotCoerceToBool e)--evalString :: Expr -> Eval String-evalString e | trace ("evalString " ++ show e) False = undefined-evalString (Lit x)      = return x-evalString (Append x y) = (++) <$> evalString x <*> evalString y-evalString (Ident v)    = getEnv v >>= evalString-evalString e            = throwError (CannotCoerceToString e)--evalAttribute :: Attr -> Eval [(VarName,Expr)]-evalAttribute (Assign (SIdent [k]) v)  = (return . (,) k) <$> eval v-evalAttribute (Inherit (SIdent []) vs) = sequence [ (,) v <$> getEnv v | v <- vs ]-evalAttribute e                        = throwError (Unsupported (AttrSet False [e]))--attrSetToEnv :: Attr -> Eval [(VarName,Expr)]-attrSetToEnv (Assign (SIdent [k]) v)  = return [(k,v)]-attrSetToEnv (Inherit (SIdent []) vs) = sequence [ (,) v <$> getEnv v | v <- vs ]-attrSetToEnv e                        = throwError (Unsupported (AttrSet True [e]))--eval :: Expr -> Eval Expr-eval e | trace ("eval " ++ show e) False = undefined-eval Null                                       = return Null-eval e@(Lit _)                                  = return e-eval e@(Boolean _)                              = return e-eval (Ident v)                                  = getEnv v >>= eval-eval e@(Append _ _)                             = Lit <$> evalString e-eval e@(And _ _)                                = Boolean <$> evalBool e-eval e@(Or _ _)                                 = Boolean <$> evalBool e-eval e@(Not _)                                  = Boolean <$> evalBool e-eval e@(Equal _ _)                              = Boolean <$> evalBool e-eval e@(Inequal _ _)                            = Boolean <$> evalBool e-eval (IfThenElse b x y)                         = evalBool b >>= \b' -> eval (if b' then x else y)-eval (DefAttr x y)                              = eval x `onError` (isUndefinedVariable, eval y)-eval (Let as e)                                 = concat <$> mapM attrSetToEnv as >>= \env -> trace ("add to env: " ++ show env) $ local (union (fromList env)) (eval e)-eval (Apply (Fun (Ident v) x) y)                = trace "foo" $ eval y >>= \y' -> local (insert v y') (eval x)-eval (Apply (Ident v) y)                        = trace "yo" $ getEnv v >>= \x' -> eval (Apply x' y)-eval (Apply x@(Apply _ _) y)                    = trace "yo" $ eval x >>= \x' -> eval (Apply x' y)-eval (AttrSet False as)                         = (AttrSet False . map (\(k,v) -> Assign (SIdent [k]) v) . concat) <$> mapM evalAttribute as-eval (AttrSet True as)                          = concat <$> mapM attrSetToEnv as >>= \as' -> trace ("add to env: " ++ show as') $ local (union (fromList as')) (eval (AttrSet False as))-eval (Deref (Ident v) y)                        = getEnv v >>= \v' -> eval (Deref v' y)-eval (Deref (AttrSet False as) y@(Ident _))     = concat <$> mapM evalAttribute as >>= \as' -> trace ("add to env: " ++ show as') $ local (\env -> foldr (uncurry insert) env as') (eval y)-eval (Deref (AttrSet True as) y@(Ident _))      = concat <$> mapM attrSetToEnv as >>= \as' -> trace ("add to env: " ++ show as') $ local (\env -> foldr (uncurry insert) env as') (eval y)-eval e@(Deref _ _)                              = throwError (TypeMismatch e)-eval e                                          = throwError (Unsupported e)------- eval (Apply (Lambda v x) y)     = eval y >>= \y' -> trace ("add to env: " ++ show (v,y')) $ local ((v,y'):) (eval x)--- eval (Apply x@(V _) y)          = eval x >>= \x' -> eval (Apply x' y)--- eval (Apply x@(Apply _ _) y)    = eval x >>= \x' -> eval (Apply x' y)--- eval (Let env e)                = trace ("add to env: " ++ show env) $ local (env++) (eval e)--- eval e@(Lambda _ _)             = return e--- eval e                          = throwError (Unsupported e)----- coerceDict :: Value -> Dict--- coerceDict (AttrSetV e) = e--- coerceDict e            = error ("cannot coerce expression to attribute set: " ++ show e)------ coerceFun :: Value -> (Value -> Value)--- coerceFun (FunV f) = f--- coerceFun e        = error ("cannot coerce expression to function: " ++ show e)------ coerceStr :: Value -> String--- coerceStr (StrV x) = x--- coerceStr e        = error ("cannot coerce expression to string: " ++ show e)------ -- getScopedVar :: [String] -> Eval Value--- -- getScopedVar   []   = fail "invalid empty scoped variable"--- -- getScopedVar (k:[]) = getEnv k--- -- getScopedVar (k:ks) = getEnv k >>= \e -> local (union (coerceDict e)) (getScopedVar ks)------ -- evalAttr :: Attr -> Eval Dict--- -- evalAttr (Inherit (SIdent k) is)    = fromList <$> forM is (\i -> (,) i <$> getScopedVar (k++[i]))--- -- evalAttr (Assign (SIdent   []) _)   = fail "invalid empty scoped identifier in assignment"--- -- evalAttr (Assign (SIdent (k:[])) e) = singleton k <$> eval e--- -- evalAttr (Assign (SIdent (k:ks)) e) = (singleton k . AttrSetV) <$> evalAttr (Assign (SIdent ks) e)------ simplifyAttr :: Attr -> Map String Expr--- simplifyAttr (Inherit (SIdent _) [])    = error "invalid empty inherit statement"--- simplifyAttr (Inherit (SIdent k) is)    = unions [ singleton i (foldl1 Deref (map Ident (k++[i]))) | i <- is]--- simplifyAttr (Assign (SIdent   []) _)   = error "invalid empty scoped identifier in assignment"--- simplifyAttr (Assign (SIdent (k:[])) e) = singleton k e--- simplifyAttr (Assign (SIdent (k:ks)) e) = singleton k (AttrSet False [Assign (SIdent ks) e])------ evalAttr' :: (String, Expr) -> Eval Dict--- evalAttr' (k, e) = singleton k <$> eval e------ evalDict :: Map String Expr -> Eval Dict--- evalDict as = unionsWith mergeDicts <$> mapM evalAttr' (assocs as)------ -- -- (Inherit (SIdent k) is)    = fromList <$> forM is (\i -> (,) i <$> getScopedVar (k++[i]))--- -- evalAttr' (Assign (SIdent   []) _)   = fail "invalid empty scoped identifier in assignment"--- -- evalAttr' (Assign (SIdent (k:[])) e) = singleton k <$> eval e--- -- evalAttr' (Assign (SIdent (k:ks)) e) = (singleton k . AttrSetV) <$> evalAttr (Assign (SIdent ks) e)------ eval :: Expr -> Eval Value--- eval e | trace ("eval: " ++ show e) False = undefined--- eval (Lit v)                    = return (StrV v)--- eval (Ident v)                  = getEnv v--- eval (AttrSet False as)         = AttrSetV . unionsWith mergeDicts <$> mapM (evalDict . simplifyAttr) as------ eval (AttrSet True as)          = do---   env <- ask---   let e :: Map String Expr---       e = unionsWith mergeAttrSets (map simplifyAttr as)---   return (AttrSetV (resolve env e))------ -- mdo { r@(AttrSetV d) <- local (`union` d) (eval (AttrSet False as)); return r }------ -- eval (AttrSet False as)         = AttrSetV . unionsWith mergeDicts <$> mapM evalAttr as--- -- eval (AttrSet True as)          = mdo { r@(AttrSetV d) <- local (`union` d) (eval (AttrSet False as)); return r }--- eval (Fun (Ident x) y)          = do { env <- ask; return (FunV (\v -> runEval' (eval y) (insert x v env))) }--- eval (Apply x y)                = coerceFun <$> eval x <*> eval y--- eval (Append x y)               = StrV <$> ((++) <$> (coerceStr <$> eval x) <*> (coerceStr <$> eval y))--- eval (Deref x (Ident y))        = coerceDict <$> eval x >>= \x' -> local (const x') (getEnv y)--- -- default catch-all to report the un-expected expression--- eval e                          = fail ("unsupported: " ++ show e)------ mergeDicts :: Value -> Value -> Value--- mergeDicts x y = AttrSetV (unionWith mergeDicts (coerceDict x) (coerceDict y))------ mergeAttrSets :: Expr -> Expr -> Expr--- mergeAttrSets (AttrSet False x) (AttrSet False y) = AttrSet False (x++y)--- mergeAttrSets x y = error ("mergeAttrSets: cannot merge expressions " ++ show x ++ " and " ++ show y)--run :: String -> Either Error Expr-run = either (Left . InvalidSyntax) (\e -> runEval (eval e) builtins) . parseNix--runEval :: Eval a -> Env -> Either Error a-runEval = runReader . runErrorT--builtins :: Env-builtins = fromList-           [ ("true", Boolean True)-           , ("false", Boolean False)-           , ("null", Null)-           ]

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -0,0 +1,8 @@+#!/usr/bin/env runhaskell++> module Main (main) where+>+> import Distribution.Simple+>+> main :: IO ()+> main = defaultMain

@@ -1,41 +1,54 @@-name:                   language-nix-version:                1.0-synopsis:               Haskell AST and Parsers for the Nix language-description:            This library provides parsec combinators that parse Nix into an AST.-homepage:               https://github.com/peti/language-nix-license:                BSD3-license-file:           LICENSE-author:                 Peter Simons <simons@cryp.to>-maintainer:             Peter Simons <simons@cryp.to>-category:               Language-build-type:             Simple-cabal-version:          >= 1.8--Source-Repository head-  Type:                 git-  Location:             git://github.com/peti/language-nix.git+-- This file has been generated from package.yaml by hpack version 0.7.0.+--+-- see: https://github.com/sol/hpack -Library-  Exposed-Modules:      Language.Nix-  Build-Depends:        base >= 3 && < 5, parsec, transformers, QuickCheck,-                        containers >= 0.4.2, mtl-  Ghc-Options:          -Wall+name:           language-nix+version:        2+synopsis:       Data types and useful functions to represent and manipulate the Nix language.+description:    Data types and useful functions to represent and manipulate the Nix language.+category:       Distribution, Language+homepage:       https://github.com/nixos/cabal2nix#readme+bug-reports:    https://github.com/nixos/cabal2nix/issues+author:         Peter Simons+maintainer:     simons@cryp.to+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 -Executable parse-nix-  main-is:              parse-nix.hs-  Build-Depends:        base, language-nix, parsec, transformers, QuickCheck,-                        containers >= 0.4.2, mtl-  Ghc-Options:          -Wall+source-repository head+  type: git+  location: https://github.com/nixos/cabal2nix -Executable run-nix-  main-is:              run-nix.hs-  Build-Depends:        base, language-nix, parsec, transformers, QuickCheck,-                        containers >= 0.4.2, mtl-  Ghc-Options:          -Wall+library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base < 5+    , deepseq+    , lens+    , pretty >= 1.1.2+    , regex-posix+  exposed-modules:+      Language.Nix+      Language.Nix.Binding+      Language.Nix.Identifier+      Language.Nix.Path+  default-language: Haskell2010 -Test-Suite self-test-  type:                 exitcode-stdio-1.0-  main-is:              self-test.hs-  build-depends:        base, language-nix, parsec, transformers,-                        containers >= 0.4.2, mtl, doctest, QuickCheck, hspec, HUnit-  Ghc-Options:          -Wall+test-suite spec+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test+  ghc-options: -Wall+  build-depends:+      base < 5+    , deepseq+    , lens+    , pretty >= 1.1.2+    , regex-posix+    , doctest+    , QuickCheck+  default-language: Haskell2010

@@ -1,16 +0,0 @@--- parse-nix.hs--module Main ( main ) where--import Prelude ( fmap, either )-import Language.Nix ( parseNixFile, parseNix )-import System.Environment ( getArgs )-import System.IO ( IO, getContents, hPrint, print, stderr )-import Control.Monad ( mapM_, (>>=), (>=>) )--main :: IO ()-main = do-  args <- getArgs-  case args of-    [] -> fmap parseNix getContents >>= either (hPrint stderr) print-    _  -> mapM_ (parseNixFile >=> either (hPrint stderr) print) args

@@ -1,16 +0,0 @@--- run-nix.hs--module Main ( main ) where--import Prelude ( fmap, either, (.) )-import Language.Nix ( run )-import System.Environment ( getArgs )-import System.IO ( IO, getContents, hPrint, print, stderr, readFile )-import Control.Monad ( mapM_, (>>=), (>=>) )--main :: IO ()-main = do-  args <- getArgs-  case args of-    [] -> fmap run getContents >>= either (hPrint stderr) print-    _  -> mapM_ (readFile >=> (either (hPrint stderr) print) . run) args

@@ -1,187 +0,0 @@--- self-test.hs--module Main ( main ) where--import Language.Nix-import qualified Text.Parsec.Token as Parsec ( reservedNames )-import Test.DocTest-import Test.QuickCheck-import Test.Hspec-import Test.Hspec.QuickCheck-import Test.HUnit.Base ( assertFailure, assertEqual )--gives :: (Show err, Eq a, Show a) => Either err a -> a -> Expectation-gives x y = either (assertFailure . msg) (assertEqual "" y) x-  where msg z = "expected: " ++ show y ++ "\nbut got parser error: " ++ show z--parseFail :: Show a => NixParser a -> String -> Expectation-parseFail p input = parse p input `shouldSatisfy` either (const True) (const False)--main :: IO ()-main = do-  doctest [ "Language/Nix.hs" ]-  hspec $ do-    describe "identifier" $ do-      it "parses hand-picked sample inputs" $ do-        parse identifier "abc" `gives` Ident "abc"-        parse identifier "abc  " `gives` Ident "abc"-        parse identifier "__a-b-c-__  " `gives` Ident "__a-b-c-__"-      prop "parses all randomly generated samples" $-        forAll genIdentifier $ \input -> either (const False) (Ident input ==) (parse identifier input)-      it "does not swallow leading whitespace" $-        parseFail identifier " abc"-      it "does not parse a de-referencing expression" $-        parseFail identifier "abc.def"-      it "does not accept reserved words" $-        mapM_ (parseFail identifier) (Parsec.reservedNames nixLanguage)-      it "accepts identifiers that are a prefix of a reserved word" $-        parse identifier "lett" `gives` Ident "lett"--    describe "scopedIdentifier" $ do-      it "parses hand-picked sample inputs" $ do-        parse scopedIdentifier "abc" `gives` SIdent ["abc"]-        parse scopedIdentifier "abc  " `gives` SIdent ["abc"]-        parse scopedIdentifier "abc.def" `gives` SIdent ["abc","def"]-      -- Need to implement pretty-printing again before this test can be used.-      -- prop "parses all randomly generated samples" $-      --   \sident -> either (const False) (sident ==) (parse scopedIdentifier (show (pretty sident)))-      it "does not swallow leading whitespace" $-        parseFail scopedIdentifier " abc"-      it "does not accept reserved words" $-        mapM_ (parseFail scopedIdentifier) (Parsec.reservedNames nixLanguage)-      it "accepts identifiers that are a prefix of a reserved word" $-        parse scopedIdentifier "lett" `gives` SIdent ["lett"]--    describe "literal" $ do-      -- This is not really true: "\n" gives "\\n", not a LF.-      -- prop "parses all randomly generated literal strings" $-      --   \str -> either (const False) (Lit str ==) (parse literal (show str))-      prop "parses all randomly generated integers" $-        \n -> either (const False) (Lit (show (abs (n::Int))) ==) (parse literal (show (abs n)))-      it "parses paths" $-        parse literal "claus/ist/der/beste" `gives` Lit "claus/ist/der/beste"-      it "parses URIs" $-        parse literal "http://example.org" `gives` Lit "http://example.org"-      it "parses antiquotation" $ do-        -- The literal parser is more or less useless for actually processing-        -- the strings.-        parse literal "''abc''${''" `gives` Lit "abc${"-        parse literal "\"a${b}c\"" `gives` Lit "ac"-        parse literal "\"a${if !x then \"b\" else \"c\"}d\"" `gives` Lit "ad"-        parse literal "''a${if b then \"c\" else ''d''}e''" `gives` Lit "ae"--    describe "attrSet" $ do-      it "parses an empty attribute set" $ do-        parse attrSet "{}" `gives` AttrSet False []-        parse attrSet "rec {}" `gives` AttrSet True []-      it "parses hand-picked sample inputs" $ do-        parse attrSet "{ a = b; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Ident "b")]-        parse attrSet "{ a = b.c; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Deref (Ident "b") (Ident "c"))]-        parse attrSet "{ a = \"b\"; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Lit "b")]-      it "parses attribute sets as values of attribute sets" $-        parse attrSet "{ a = { b = c; }; }" `gives` AttrSet False [Assign (SIdent ["a"]) (AttrSet False [Assign (SIdent ["b"]) (Ident "c")])]-      it "expects assignments to terminated by a semicolon" $-        parseFail attrSet "{ a = b }"-      it "ignores comments" $-        parse attrSet "{ /* foo */ a = /* bar */ b; # foobar\n }" `gives` AttrSet False [Assign (SIdent ["a"]) (Ident "b")]-      it "parses recursive attribute sets" $-        parse attrSet "rec { a = b; b = a; }" `gives` AttrSet True [Assign (SIdent ["a"]) (Ident "b"), Assign (SIdent ["b"]) (Ident "a")]-      it "parses inherit statements" $ do-        parse attrSet "{ inherit a; }" `gives` AttrSet False [Inherit (SIdent []) ["a"]]-        parse attrSet "{ inherit a; inherit b; }" `gives` AttrSet False [Inherit (SIdent []) ["a"],Inherit (SIdent []) ["b"]]-        parse attrSet "{ inherit a b; }" `gives` AttrSet False [Inherit (SIdent []) ["a","b"]]-        parse attrSet "{ inherit (a) b c d; }" `gives` AttrSet False [Inherit (SIdent ["a"]) ["b","c","d"]];-        -- The parser cannot handle this expample yet.-        -- parse attrSet "{ inherit (import ./foo.nix) a b c; }" `gives` Lit "a"--    describe "list" $ do-      it "parses an empty list" $-        parse list "[]" `gives` List []-      it "parses hand-picked sample inputs" $ do-        parse list "[ a b c ]" `gives` List [Ident "a",Ident "b",Ident "c"]-        parse list "[ \"b\" { a = [\"c\"]; } d ]" `gives` List [Lit "b",AttrSet False [Assign (SIdent ["a"]) (List [Lit "c"])],Ident "d"]-        parse list "[ (a b) c ]" `gives` List [Apply (Ident "a") (Ident "b"),Ident "c"]-        parse list "[ 12 8 a 0 ]" `gives` List [Lit "12", Lit "8", Ident "a", Lit "0"]--    describe "reserved" $ do-      it "parses a specific reserved name" $ do-         parse (reserved "let") "let" `gives` ()-         parse (reserved "in") "in" `gives` ()-         parse (reserved "rec") "rec" `gives` ()-         parseFail (reserved "rec") "let"-      it "recognizes if the keyword is actually just a prefix of the input string" $-         parseFail (reserved "in") "input"--    describe "expr" $ do-      it "parses an empty attribute set" $ do-        parse expr "{}" `gives` AttrSet False []-        parse expr "rec {}" `gives` AttrSet True []-      it "parses an empty list" $-        parse expr "[]" `gives` List []-      it "parses a de-referencing expression" $ do-        parse expr "abc.def" `gives` Deref (Ident "abc") (Ident "def")-        parse expr "a.b.c" `gives` Deref (Deref (Ident "a") (Ident "b")) (Ident "c")-      it "parses recursive attribute sets" $-        parse expr "rec { id = x: x; }" `gives` AttrSet True [Assign (SIdent ["id"]) (Fun (Ident "x") (Ident "x"))]-      it "parses boolean expressions" $ do-        parse expr "true" `gives` Ident "true"-        parse expr "false" `gives` Ident "false"-        parse expr "system == \"linux\"" `gives` Equal (Ident "system") (Lit "linux")-        parse expr "system != \"linux\"" `gives` Inequal (Ident "system") (Lit "linux")-        parse expr "true && true" `gives` And (Ident "true") (Ident "true")-        parse expr "false || false" `gives` Or (Ident "false") (Ident "false")-        parse expr "isLinux || isDarwin" `gives` Or (Ident "isLinux") (Ident "isDarwin")-        parse expr "(isLinux || isDarwin)" `gives` Or (Ident "isLinux") (Ident "isDarwin")-        parse expr "(isLinux) || (isDarwin)" `gives` Or (Ident "isLinux") (Ident "isDarwin")-        parse expr "!(!isLinux) || (isDarwin)" `gives` Or (Not (Not (Ident "isLinux"))) (Ident "isDarwin")-        parse expr "!a && b || c" `gives` Or (And (Not (Ident "a")) (Ident "b")) (Ident "c")-        parse expr "a && b || c" `gives` Or (And (Ident "a") (Ident "b")) (Ident "c")-        parse expr "a || b && c" `gives` Or (Ident "a") (And (Ident "b") (Ident "c"))-        parse expr "(a -> b) -> c" `gives` Implies (Implies (Ident "a") (Ident "b")) (Ident "c")-      it "parses simple lambda expressions" $ do-        parse expr "x: {}" `gives` Fun (Ident "x") (AttrSet False [])-        parse expr "x: y: rec{}" `gives` Fun (Ident "x") (Fun (Ident "y") (AttrSet True []))-      it "parses attribute set patterns" $ do-        parse expr "{}: {}" `gives` Fun (AttrSet False []) (AttrSet False [])-        parse expr "{a ? b, c}: {}" `gives` Fun (AttrSetP Nothing [("a",Just (Ident "b")),("c",Nothing)]) (AttrSet False [])-        parse expr "{ id = x: x; }" `gives` AttrSet False [Assign (SIdent ["id"]) (Fun (Ident "x") (Ident "x"))]-        parse expr "{ a?null, b }: rec {}" `gives` Fun (AttrSetP Nothing [("a",Just (Ident "null")),("b",Nothing)]) (AttrSet True [])-        parse expr "{ a?c.d }: {}" `gives` Fun (AttrSetP Nothing [("a",Just (Deref (Ident "c") (Ident "d")))]) (AttrSet False [])-        parse expr "{ a?c.d, ... }: {}" `gives` Fun (AttrSetP Nothing [("a",Just (Deref (Ident "c") (Ident "d"))),("...",Nothing)]) (AttrSet False [])-        parse expr "e@{ a?c.d, ... }: {}" `gives` Fun (AttrSetP (Just "e") [("a",Just (Deref (Ident "c") (Ident "d"))),("...",Nothing)]) (AttrSet False [])-      it "ignores leading/trailing whitespace" $ do-        parse expr "   {}" `gives` AttrSet False []-        parse expr "{}   " `gives` AttrSet False []-        parse expr " { } " `gives` AttrSet False []-      it "ignores comments" $-        parse expr "# foo\n/* bar \n */ { /* bla */ }" `gives` AttrSet False []-      it "parses function application" $ do-        parse expr "a b c" `gives` Apply (Apply (Ident "a") (Ident "b")) (Ident "c")-        parse expr "a.b c" `gives` Apply (Deref (Ident "a") (Ident "b")) (Ident "c")-        parse expr "a{b=c.d;}" `gives` Apply (Ident "a") (AttrSet False [Assign (SIdent ["b"]) (Deref (Ident "c") (Ident "d"))])-      it "parses import statements" $ do-        parse expr "(import ../some/function.nix) c" `gives` Apply (Import (Lit "../some/function.nix")) (Ident "c")-        parse expr "let x = import ../some/function.nix; in x" `gives` Let [Assign (SIdent ["x"]) (Import (Lit "../some/function.nix"))] (Ident "x")-      it "parses if-then-else statements" $-        parse expr "if a b then c { inherit d; } else e" `gives` IfThenElse (Apply (Ident "a") (Ident "b")) (Apply (Ident "c") (AttrSet False [Inherit (SIdent []) ["d"]])) (Ident "e")-      it "parses with statements" $-        parse expr "with a; a" `gives` Apply (With (Ident "a")) (Ident "a")--    describe "run" $ do-      it "can evaluate simple data types" $ do-        run "null" `gives` Null-        run "true" `gives` Boolean True-        run "false" `gives` Boolean False-        run "\"null\"" `gives` Lit "null"-        run "123" `gives` Lit "123"-        run "http://example.org" `gives` Lit "http://example.org"-      it "can evaluate hand-picked Nix expressions" $ do-        run "rec { y = \"bar\"; f = x: \"foo\" + x; v = f y; }.v" `gives` Lit "foobar"-        -- run "{ a.a.a=1; a.a.b=2; a.b=3; }" `gives` Lit "foo"-        -- run "{ a.a.a=1; a.a.b=2; a.b=3; }.a.a.a" `gives` Lit "1"-        run "bla or false" `gives` Boolean False-        run "let a = \"foo\"; b = a; f = x: x+\"bar\"; in f b" `gives` Lit "foobar"-        run "let a = { b = \"claus\"; };  b = \"bar\"; in { a = \"foo\"; inherit b; c = a.b; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Lit "foo"),Assign (SIdent ["b"]) (Lit "bar"),Assign (SIdent ["c"]) (Lit "claus")]-        run "let a = { b = \"claus\"; };  b = \"bar\"; in { a = \"foo\"; inherit b; c = a.b; }.c" `gives` Lit "claus"-        run "let b = \"bar\"; in rec { a = \"foo\"; inherit b; c = a + b; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Lit "foo"),Assign (SIdent ["b"]) (Lit "bar"),Assign (SIdent ["c"]) (Lit "foobar")]-        run "let { a = \"foo\"; b = a; f = x: x+\"bar\"; body = f b; }" `gives` Lit "foobar"

@@ -0,0 +1,11 @@+module Language.Nix+  ( module Language.Nix.Identifier+  , module Language.Nix.Path+  , module Language.Nix.Binding+  ) where++import Language.Nix.Identifier+import Language.Nix.Path+import Language.Nix.Binding++{-# ANN module "HLint: ignore Use import/export shortcut" #-}

@@ -0,0 +1,34 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module Language.Nix.Binding ( Binding, binding, localName, reference ) where++import Control.DeepSeq+import Control.Lens+import Text.PrettyPrint.HughesPJClass+import Language.Nix.Identifier+import Language.Nix.Path++-- | A 'Binding' represents an identifier that refers to some other 'Path'.++declareLenses [d| data Binding = Bind { localName :: Identifier, reference :: Path }+                    deriving (Show, Eq, Ord)+              |]++binding :: Iso' Binding (Identifier,Path)+binding = iso (\(Bind l r) -> (l,r)) (uncurry Bind)++instance NFData Binding where rnf (Bind l r) = l `deepseq` rnf r++instance Pretty Binding where+  pPrint b = case (init ps, last ps) of+               ([], i') -> if i == i'+                              then text "inherit" <+> pPrint i' <> semi+                              else pPrint i <+> equals <+> pPrint p <> semi+               (p', i') -> if i == i'+                              then text "inherit" <+> parens (pPrint (path # p')) <+> pPrint i' <> semi+                              else pPrint i <+> equals <+> pPrint p <> semi++    where+      (i, p) = view binding b+      ps = view path p

@@ -0,0 +1,64 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell            #-}++module Language.Nix.Identifier+  (+    -- | Identifiers in Nix are essentially strings. They can be constructed+    -- (and viewed) with the 'ident' isomorphism. For the sake of convenience,+    -- @Identifier@s are an instance of the 'IsString' class.+    --+    -- Reasonable people restrict themselves to identifiers of the form+    -- @[a-zA-Z\_][a-zA-Z0-9\_\'\-]*@, because these don't need quoting. The+    -- methods of the 'Pretty' class can be used to pretty-print an identifier+    -- with proper quoting:+    --+    -- >>> pPrint (ident # "test")+    -- test+    -- >>> pPrint (ident # "foo.bar")+    -- "foo.bar"+    Identifier++  , -- | An isomorphism that allows conversion of 'Identifier' from/to the+    -- standard 'String' type via 'review'.+    --+    -- prop> \str -> fromString str == ident # str+    -- prop> \str -> set ident str undefined == ident # str+    -- prop> \str -> view ident (review ident str) == str+    ident++  , -- | Helper function to quote a given identifier string if necessary.+    --+    -- >>> putStrLn (quote "abc")+    -- abc+    -- >>> putStrLn (quote "abc.def")+    -- "abc.def"+    quote++  , -- | Checks whether a given string needs quoting when interpreted as an+    -- 'Identifier'.+    needsQuoting++  ) where++import Control.DeepSeq+import Control.Lens+import Data.String+import Text.PrettyPrint.HughesPJClass+import Text.Regex.Posix++declareLenses [d| newtype Identifier = Identifier { ident :: String }+                    deriving (Show, Eq, Ord, IsString)+              |]++instance Pretty Identifier where+  pPrint i = text (i ^. ident . to quote)++instance NFData Identifier where rnf (Identifier str) = rnf str++needsQuoting :: String -> Bool+needsQuoting str = not (str =~ grammar)+  where grammar :: String       -- TODO: should be a compiled regular expression+        grammar = "^[a-zA-Z\\_][a-zA-Z0-9\\_\\'\\-]*$"++quote :: String -> String+quote s = if needsQuoting s then show s else s

@@ -0,0 +1,51 @@+{-# LANGUAGE TemplateHaskell #-}++module Language.Nix.Path ( Path, path ) where++import Control.DeepSeq+import Control.Lens+import Language.Nix.Identifier+import Text.PrettyPrint.HughesPJClass ( Pretty (..), char, hcat, punctuate )++-- | Paths are non-empty lists of identifiers in Nix.+--+-- >>> path # [ident # "yo"]+-- Path [Identifier "yo"]+--+-- Any attempt to construct the empty path throws an 'error':+--+-- >>> path # []+-- Path *** Exception: Nix paths cannot be empty+--+-- 'Identifier' is an instance of 'IsString':+--+-- >>> :set -XOverloadedStrings+-- >>> pPrint $ path # ["yo","bar"]+-- yo.bar+--+-- Freaky quoted identifiers are fine except in the first segment:+--+-- >>> pPrint $ path # ["yo","b\"ar"]+-- yo."b\"ar"+-- >>> pPrint $ path # ["5ident"]+-- *** Exception: invalid Nix path: [Identifier "5ident"]+-- >>> pPrint $ path # ["5ident","foo","bar"]+-- *** Exception: invalid Nix path: [Identifier "5ident",Identifier "foo",Identifier "bar"]++declareLenses [d| newtype Path = Path [Identifier]+                    deriving (Show, Eq, Ord)+              |]++instance NFData Path where rnf (Path p) = rnf p++instance Pretty Path where+  pPrint p = hcat $ punctuate (char '.') $ pPrint <$> p^.path++path :: Iso' Path [Identifier]+path = iso (\(Path p) -> p) mkPath+  where+    mkPath :: [Identifier] -> Path+    mkPath []                           = error "Nix paths cannot be empty"+    mkPath p@(s0:_)+      | s0^.ident.to needsQuoting       = error ("invalid Nix path: " ++ show p)+      | otherwise                       = Path p

@@ -0,0 +1,6 @@+module Main ( main ) where++import Test.DocTest++main :: IO ()+main = doctest [ "-isrc", "src" ]