packages feed

hnix (empty) → 0.2.0

raw patch · 13 files changed

+1599/−0 lines, 13 filesdep +ansi-wl-pprintdep +basedep +containerssetup-changed

Dependencies added: ansi-wl-pprint, base, containers, criterion, data-fix, hnix, parsec, parsers, tasty, tasty-hunit, tasty-th, text, transformers, trifecta, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,19 @@+opyright (c) 2014 John Wiegley++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Nix/Eval.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE OverloadedStrings #-}+module Nix.Eval where++import           Control.Applicative+import           Control.Arrow+import           Control.Monad hiding (mapM, sequence)+import           Data.Fix+import           Data.Foldable (foldl')+import qualified Data.Map as Map+import           Data.Text (Text)+import qualified Data.Text as Text+import           Data.Traversable as T+import           Nix.Types+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+  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"++evalExpr :: NExpr -> NValue -> IO NValue+evalExpr = cata phi+  where+    phi :: NExprF (NValue -> IO NValue) -> NValue -> IO NValue+    phi (NSym var) = \env -> case env of+      Fix (NVSet s) -> maybe err return $ Map.lookup var s+      _ -> error "invalid evaluation environment"+     where err = error ("Undefined variable: " ++ show var)+    phi (NConstant x) = const $ return $ Fix $ NVConstant x+    phi (NStr str) = fmap (Fix . NVStr) . flip evalString str+    phi (NOper _x) = error "Operators are not yet defined"+    phi (NSelect _x _attr _or) = error "Select expressions are not yet supported"+    phi (NHasAttr _x _attr) = error "Has attr expressions are not yet supported"++    phi (NList l)     = \env ->+        Fix . NVList <$> mapM ($ env) l++    -- TODO: recursive sets+    phi (NSet _b binds)   = \env ->+        Fix . NVSet <$> evalBinds True env binds++    -- TODO: recursive binding+    phi (NLet binds e) = \env -> case env of+      (Fix (NVSet env')) -> do+        letenv <- evalBinds False env binds+        let newenv = Map.union letenv env'+        e . Fix . NVSet $ newenv+      _ -> error "invalid evaluation environment"++    phi (NIf cond t f)  = \env -> do+      (Fix cval) <- cond env+      case cval of+        NVConstant (NBool True) -> t env+        NVConstant (NBool False) -> f env+        _ -> error "condition must be a boolean"++    phi (NWith scope e) = \env -> case env of+      (Fix (NVSet env')) -> do+        s <- scope env+        case s of+          (Fix (NVSet scope')) -> e . Fix . NVSet $ Map.union scope' env'+          _ -> error "scope must be a set in with statement"+      _ -> error "invalid evaluation environment"++    phi (NAssert cond e) = \env -> do+      (Fix cond') <- cond env+      case cond' of+        (NVConstant (NBool True)) -> e env+        (NVConstant (NBool False)) -> error "assertion failed"+        _ -> error "assertion condition must be boolean"++    phi (NApp fun x) = \env -> do+        fun' <- fun env+        case fun' of+            Fix (NVFunction argset f) -> do+                arg <- x env+                let arg' = buildArgument argset arg+                f arg'+            _ -> error "Attempt to call non-function"++    phi (NAbs a b)    = \env -> do+        -- jww (2014-06-28): arglists should not receive the current+        -- environment, but rather should recursively view their own arg+        -- set+        args <- traverse ($ env) a+        return $ Fix $ NVFunction args b++evalString :: NValue -> NString (NValue -> IO NValue) -> IO Text+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)+evalBinds allowDynamic env xs = buildResult <$> sequence (concatMap go xs) where+  buildResult :: [([Text], NValue)] -> Map.Map Text NValue+  buildResult = foldl' insert Map.empty . map (first reverse) where+    insert _ ([], _) = error "invalid selector with no components"+    insert m (p:ps, v) = modifyPath ps (insertIfNotMember p v) where+      alreadyDefinedErr = error $ "attribute " ++ attr ++ " already defined"+      attr = show $ Text.intercalate "." $ reverse (p:ps)++      modifyPath :: [Text] -> (Map.Map Text NValue -> Map.Map Text NValue) -> Map.Map Text NValue+      modifyPath [] f = f m+      modifyPath (x:parts) f = modifyPath parts $ \m' -> case Map.lookup x m' of+        Nothing                -> Map.singleton x $ g Map.empty+        Just (Fix (NVSet m'')) -> Map.insert x (g m'') m'+        Just _                 -> alreadyDefinedErr+       where g = Fix . NVSet . f++      insertIfNotMember k x m'+        | Map.notMember k m' = Map.insert k x m'+        | otherwise = alreadyDefinedErr++  -- TODO: Inherit+  go :: Binding (NValue -> IO NValue) -> [IO ([Text], NValue)]+  go (NamedVar x y) = [liftM2 (,) (evalSelector allowDynamic env x) (y env)]++  evalSelector :: Bool -> NValue -> NSelector (NValue -> IO NValue) -> IO [Text]+  evalSelector dyn e = mapM evalKeyName where+    evalKeyName (StaticKey k) = return k+    evalKeyName (DynamicKey k)+      | dyn       = runAntiquoted (evalString e) (fmap valueText . ($ e)) k+      | otherwise = error "dynamic attribute not allowed in this context"
+ Nix/Parser.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Nix.Parser (parseNixFile, parseNixString, Result(..)) where++import           Control.Applicative+import           Control.Monad+import           Control.Monad.IO.Class+import           Data.Fix+import           Data.Foldable hiding (concat)+import qualified Data.Map as Map+import           Data.Text hiding (head, map, foldl1', foldl', concat)+import           Nix.Parser.Library+import           Nix.Types+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)+ where+  makeParser term (Left NSelectOp) = nixSelect term+  makeParser term (Left NAppOp) = chainl1 term $ pure $ \a b -> Fix (NApp a b)+  makeParser term (Left NHasAttrOp) = nixHasAttr term+  makeParser term (Right (NUnaryDef name op))+    = build <$> many (void $ symbol name) <*> term+   where build = flip $ foldl' (\t' () -> mkOper op t')+  makeParser term (Right (NBinaryDef assoc ops)) = case assoc of+    NAssocLeft  -> chainl1 term op+    NAssocRight -> chainr1 term op+    NAssocNone  -> term <**> (flip <$> op <*> term <|> pure id)+   where op = choice . map (\(n,o) -> mkOper2 o <$ reservedOp n) $ ops++antiStart :: Parser String+antiStart = try (string "${") <?> show ("${" :: String)++nixAntiquoted :: Parser a -> Parser (Antiquoted a NExpr)+nixAntiquoted p = Antiquoted <$> (antiStart *> nixExpr <* symbolic '}') <|> Plain <$> p++selDot :: Parser ()+selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath)) *> whiteSpace+      <?> "."++nixSelector :: Parser (NSelector NExpr)+nixSelector = keyName `sepBy1` selDot where++nixSelect :: Parser NExpr -> Parser NExpr+nixSelect term = build+  <$> term+  <*> optional ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixExpr))+ where+  build t Nothing = t+  build t (Just (s,o)) = Fix $ NSelect t s o++nixHasAttr :: Parser NExpr -> Parser NExpr+nixHasAttr term = build <$> term <*> optional (reservedOp "?" *> nixSelector) where+  build t Nothing = t+  build t (Just s) = Fix $ NHasAttr t s++nixOpArg :: Parser NExpr+nixOpArg = nixSelect $ choice+  [ nixInt, nixBool, nixNull, nixParens, nixList, nixPath, nixSPath, nixUri+  , nixStringExpr, nixSet, nixSym ]++nixToplevelForm :: Parser NExpr+nixToplevelForm = choice [nixLambda, nixLet, nixIf, nixAssert, nixWith]++nixSym :: Parser NExpr+nixSym = mkSym <$> identifier++nixInt :: Parser NExpr+nixInt = mkInt <$> token decimal <?> "integer"++nixBool :: Parser NExpr+nixBool = try (true <|> false) <?> "bool" where+  true = mkBool True <$ symbol "true"+  false = mkBool False <$ symbol "false"++nixNull :: Parser NExpr+nixNull = mkNull <$ try (symbol "null") <?> "null"++nixParens :: Parser NExpr+nixParens = parens nixExpr <?> "parens"++nixList :: Parser NExpr+nixList = brackets (Fix . NList <$> many nixOpArg) <?> "list"++pathChars :: String+pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']++slash :: Parser Char+slash = try (char '/' <* notFollowedBy (char '/')) <?> "slash"++nixSPath :: Parser NExpr+nixSPath = mkPath True <$> try (char '<' *> some (oneOf pathChars <|> slash) <* symbolic '>')+        <?> "spath"++nixPath :: Parser NExpr+nixPath = token $ fmap (mkPath False) $ ((++)+    <$> (try ((++) <$> many (oneOf pathChars) <*> fmap (:[]) slash) <?> "path")+    <*> fmap concat+      (  some (some (oneOf pathChars)+     <|> liftA2 (:) slash (some (oneOf pathChars)))+      )+    )+    <?> "path"++nixLet :: Parser NExpr+nixLet =  fmap Fix $ NLet+      <$> (reserved "let" *> nixBinders)+      <*> (whiteSpace *> reserved "in" *> nixExpr)+      <?> "let"++nixIf :: Parser NExpr+nixIf =  fmap Fix $ NIf+     <$> (reserved "if" *> nixExpr)+     <*> (whiteSpace *> reserved "then" *> nixExpr)+     <*> (whiteSpace *> reserved "else" *> nixExpr)+     <?> "if"++nixAssert :: Parser NExpr+nixAssert = fmap Fix $ NAssert+  <$> (reserved "assert" *> nixExpr)+  <*> (semi *> nixExpr)++nixWith :: Parser NExpr+nixWith = fmap Fix $ NWith+  <$> (reserved "with" *> nixExpr)+  <*> (semi *> nixExpr)++nixLambda :: Parser NExpr+nixLambda = Fix <$> (NAbs <$> (try argExpr <?> "lambda arguments") <*> nixExpr) <?> "lambda"++nixStringExpr :: Parser NExpr+nixStringExpr = Fix . NStr <$> nixString++uriAfterColonC :: Parser Char+uriAfterColonC = alphaNum <|> oneOf "%/?:@&=+$,-_.!~*'"++nixUri :: Parser NExpr+nixUri = token $ fmap (mkUri . pack) $ (++)+  <$> try ((++) <$> (scheme <* char ':') <*> fmap (\x -> [':',x]) uriAfterColonC)+  <*> many uriAfterColonC+ where+  scheme = (:) <$> letter <*> many (alphaNum <|> oneOf "+-.")++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 *> nixExpr <* char '}') -- don't skip trailing space+      <|> Plain . singleton <$> char '$'+      <|> Plain . pack <$> some plainChar+     where plainChar = notFollowedBy (end <|> void (char '$') <|> escStart) *> anyChar++    escapeCode = choice [ c <$ char e | (c,e) <- escapeCodes ] <|> anyChar++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++  argList :: Parser [(Text, Maybe NExpr)]+  argList = braces (argName `sepBy` symbolic ',') <?> "arglist"++  identifierNotUri :: Parser Text+  identifierNotUri = notFollowedBy nixUri *> identifier++  argName :: Parser (Text, Maybe NExpr)+  argName = (,) <$> identifier+                <*> optional (symbolic '?' *> nixExpr)++  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++nixBinders :: Parser [Binding NExpr]+nixBinders = (inherit <|> namedVar) `endBy` symbolic ';' where+  inherit = Inherit <$> (reserved "inherit" *> optional scope) <*> many ((:[]) <$> keyName)+         <?> "inherited binding"+  namedVar = NamedVar <$> nixSelector <*> (symbolic '=' *> nixExpr)+          <?> "variable binding"+  scope = parens nixExpr <?> "inherit scope"++keyName :: Parser (NKeyName NExpr)+keyName = dynamicKey <|> staticKey where+  staticKey = StaticKey <$> identifier+  dynamicKey = DynamicKey <$> nixAntiquoted nixString++nixSet :: Parser NExpr+nixSet = Fix <$> (NSet <$> isRec <*> braces nixBinders) <?> "set" where+  isRec = (try (reserved "rec" *> pure Rec) <?> "recursive set")+       <|> pure NonRec++parseNixFile :: MonadIO m => FilePath -> m (Result NExpr)+parseNixFile = parseFromFileEx $ nixExpr <* eof++parseNixString :: String -> Result NExpr+parseNixString = parseFromString $ nixExpr <* eof
+ Nix/Parser/Library.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+module Nix.Parser.Library ( module Nix.Parser.Library, module X) where++import Control.Applicative+import Control.Monad+import Control.Monad.IO.Class+import Data.Text hiding (map)+import Text.Parser.Expression as X+import Text.Parser.LookAhead as X+import Text.Parser.Token as X+import Text.Parser.Char as X hiding (text)+import Text.Parser.Combinators as X+import Text.PrettyPrint.ANSI.Leijen as X (Doc, text)+import Text.Parser.Token.Highlight+import Text.Parser.Token.Style++import qualified Data.HashSet as HashSet++#if USE_PARSEC+import qualified Text.Parsec as Parsec+import qualified Text.Parsec.Text as Parsec+import qualified Data.Text.IO as T+#else+import qualified Text.Trifecta as Trifecta+import qualified Text.Trifecta.Delta as Trifecta++import Text.Trifecta as X (Result(..))+#endif++newtype NixParser p a = NixParser { runNixParser :: p a }+  deriving (Functor, Applicative, Alternative, Monad, MonadPlus, Parsing, CharParsing, LookAheadParsing)++instance TokenParsing p => TokenParsing (NixParser p) where+  someSpace = NixParser $ buildSomeSpaceParser someSpace commentStyle+  nesting = NixParser . nesting . runNixParser+  highlight h = NixParser . highlight h . runNixParser+  semi = token $ char ';' <?> ";"+  token p = p <* whiteSpace++commentStyle :: CommentStyle+commentStyle = CommentStyle+  { _commentStart = "/*"+  , _commentEnd   = "*/"+  , _commentLine  = "#"+  , _commentNesting = True+  }++identStyle :: CharParsing m => IdentifierStyle m+identStyle = IdentifierStyle+  { _styleName = "identifier"+  , _styleStart = identStart+  , _styleLetter = identLetter+  , _styleReserved = reservedNames+  , _styleHighlight = Identifier+  , _styleReservedHighlight = ReservedIdentifier+  }++identifier :: (TokenParsing m, Monad m) => m Text+identifier = ident identStyle <?> "identifier"++reserved :: (TokenParsing m, Monad m) => String -> m ()+reserved = reserve identStyle++reservedOp :: TokenParsing m => String -> m ()+reservedOp o = token $ try $ () <$+  highlight ReservedOperator (string o) <* (notFollowedBy opLetter <?> "end of " ++ o)++opStart :: CharParsing m => m Char+opStart = oneOf ".+-*/=<>&|!?"++opLetter :: CharParsing m => m Char+opLetter = oneOf ">-+/&|="++identStart :: CharParsing m => m Char+identStart = letter <|> char '_'++identLetter :: CharParsing m => m Char+identLetter = alphaNum <|> oneOf "_'-"++reservedNames :: HashSet.HashSet String+reservedNames = HashSet.fromList+    [ "let", "in"+    , "if", "then", "else"+    , "assert"+    , "with"+    , "rec"+    , "inherit"+    , "or"+    ]++stopWords :: (TokenParsing m, Monad m) => m ()+stopWords = () <$+    (whiteSpace *> (reserved "in" <|> reserved "then" <|> reserved "else"))++someTill :: Alternative f => f a -> f end -> f [a]+someTill p end = go+  where+    go   = (:) <$> p <*> scan+    scan = (end *> pure []) <|>  go++--------------------------------------------------------------------------------+parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a)+parseFromString :: Parser a -> String -> Result a++#if USE_PARSEC+data Result a = Success a+              | Failure Doc+  deriving Show++type Parser = NixParser Parsec.Parser++parseFromFileEx p path =+    (either (Failure . text . show) Success . Parsec.parse (runNixParser p) path)+        `liftM` liftIO (T.readFile path)++parseFromString p = either (Failure . text . show) Success . Parsec.parse (runNixParser p) "<string>" . pack++#else++type Parser = NixParser Trifecta.Parser++parseFromFileEx p = Trifecta.parseFromFileEx (runNixParser p)++parseFromString p = Trifecta.parseString (runNixParser p) (Trifecta.Directed "<string>" 0 0 0 0)+#endif
+ Nix/Pretty.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}+module Nix.Pretty where++import Prelude hiding ((<$>))+import Data.Fix+import Data.Map (toList)+import Data.Maybe (isJust)+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+  { -- | The rendered expression, without any parentheses.+    withoutParens    :: Doc++    -- | The root operator is the operator at the root of+    -- the expression tree. For example, in '(a * b) + c', '+' would be the root+    -- operator. It is needed to determine if we need to wrap the expression in+    -- parentheses.+  , rootOp :: OperatorInfo+  }++-- | A simple expression is never wrapped in parentheses. The expression+-- behaves as if its root operator had a precedence higher than all+-- other operators (including function application).+simpleExpr :: Doc -> NixDoc+simpleExpr = flip NixDoc $ OperatorInfo maxBound NAssocNone "simple expr"++-- | An expression that behaves as if its root operator+-- had a precedence lower than all other operators.+-- That ensures that the expression is wrapped in parantheses in+-- almost always, but it's still rendered without parentheses+-- in cases where parentheses are never required (such as in the LHS+-- of a binding).+leastPrecedence :: Doc -> NixDoc+leastPrecedence = flip NixDoc $ OperatorInfo minBound NAssocNone "least precedence"++appOpNonAssoc :: OperatorInfo+appOpNonAssoc = appOp { associativity = NAssocNone }++wrapParens :: OperatorInfo -> NixDoc -> Doc+wrapParens op sub+  | precedence (rootOp sub) > precedence op = withoutParens sub+  | precedence (rootOp sub) == precedence op+    && associativity (rootOp sub) == associativity op+    && associativity op /= NAssocNone = withoutParens sub+  | otherwise = parens $ withoutParens sub++prettyString :: NString NixDoc -> Doc+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+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)++prettyParamSet :: FormalParamSet NixDoc -> Doc+prettyParamSet (FormalParamSet args) =+  lbrace <+> (hcat . punctuate (comma <> space) . map prettySetArg) (toList args) <+> rbrace++prettyBind :: Binding NixDoc -> Doc+prettyBind (NamedVar n v) = prettySelector n <+> equals <+> withoutParens v <> semi+prettyBind (Inherit s ns)+  = text "inherit" <+> scope <> fillSep (map prettySelector ns) <> semi+ where scope = maybe empty ((<> space) . parens . withoutParens) s++prettyKeyName :: NKeyName NixDoc -> Doc+prettyKeyName (StaticKey key) = text . unpack $ key+prettyKeyName (DynamicKey key) = runAntiquoted prettyString withoutParens key++prettySelector :: NSelector NixDoc -> Doc+prettySelector = hcat . punctuate dot . map prettyKeyName++prettySetArg :: (Text, Maybe NixDoc) -> Doc+prettySetArg (n, Nothing) = text (unpack n)+prettySetArg (n, Just v) = text (unpack n) <+> text "?" <+> withoutParens v++prettyOper :: NOperF NixDoc -> NixDoc+prettyOper (NBinary op r1 r2) = flip NixDoc opInfo $ hsep+  [ wrapParens (f NAssocLeft) r1+  , text $ operatorName opInfo+  , wrapParens (f NAssocRight) r2+  ]+ where+  opInfo = getBinaryOperator op+  f x+    | associativity opInfo /= x = opInfo { associativity = NAssocNone }+    | otherwise = opInfo+prettyOper (NUnary op r1) =+  NixDoc (text (operatorName opInfo) <> wrapParens opInfo r1) opInfo+ where opInfo = getUnaryOperator op++prettyAtom :: NAtom -> NixDoc+prettyAtom atom = simpleExpr $ text $ unpack $ atomText atom++prettyNix :: NExpr -> Doc+prettyNix = withoutParens . cata phi where+  phi :: NExprF NixDoc -> NixDoc+  phi (NConstant atom) = prettyAtom atom+  phi (NStr str) = simpleExpr $ prettyString str+  phi (NList []) = simpleExpr $ lbracket <> rbracket+  phi (NList xs) = simpleExpr $ group $+    nest 2 (vsep $ lbracket : map (wrapParens appOpNonAssoc) xs) <$> rbracket+  phi (NSet rec []) = simpleExpr $ recPrefix rec <> lbrace <> rbrace+  phi (NSet rec xs) = simpleExpr $ group $+    nest 2 (vsep $ recPrefix rec <> lbrace : map prettyBind xs) <$> rbrace+  phi (NAbs args body) = leastPrecedence $+    (prettyFormals args <> colon) </> withoutParens body+  phi (NOper oper) = prettyOper oper+  phi (NSelect r attr o) = (if isJust o then leastPrecedence else flip NixDoc selectOp) $+     wrapParens selectOp r <> dot <> prettySelector attr <> ordoc+    where ordoc = maybe empty (((space <> text "or") <+>) . withoutParens) o+  phi (NHasAttr r attr)+    = NixDoc (wrapParens hasAttrOp r <+> text "?" <+> prettySelector attr) hasAttrOp+  phi (NApp fun arg)+    = NixDoc (wrapParens appOp fun <+> wrapParens appOpNonAssoc arg) appOp++  phi (NSym name) = simpleExpr $ text (unpack name)+  phi (NLet binds body) = leastPrecedence $ group $ nest 2 $+        vsep (text "let" : map prettyBind binds) <$> text "in" <+> withoutParens body+  phi (NIf cond trueBody falseBody) = leastPrecedence $+    group $ nest 2 $ (text "if" <+> withoutParens cond) <$>+      (  align (text "then" <+> withoutParens trueBody)+     <$> align (text "else" <+> withoutParens falseBody)+      )+  phi (NWith scope body) = leastPrecedence $+    text "with"  <+> withoutParens scope <> semi <+> withoutParens body+  phi (NAssert cond body) = leastPrecedence $+    text "assert" <+> withoutParens cond <> semi <+> withoutParens body++  recPrefix Rec = text "rec" <> space+  recPrefix NonRec = empty
+ Nix/Types.hs view
@@ -0,0 +1,418 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE OverloadedStrings #-}++module Nix.Types where++import           Control.Applicative+import           Control.Monad hiding (forM_, mapM, sequence)+import           Data.Data+import           Data.Fix+import           Data.Foldable+import           Data.List (intercalate)+import           Data.Map (Map)+import qualified Data.Map as Map+import           Data.Maybe (catMaybes)+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, minimum, foldr)++-- | Atoms are values that evaluate to themselves. This means that they appear in both+-- the parsed AST (in the form of literals) and the evaluated form.+data NAtom+  -- | An integer. The c nix implementation currently only supports integers that+  -- fit in the range of 'Int64'.+  = NInt Integer++  -- | 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 (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.+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' )+  , ('\r', 'r' )+  , ('\t', 't' )+  , ('\\', '\\')+  , ('$' , '$' )+  ]++fromEscapeCode :: Char -> Maybe Char+fromEscapeCode = (`lookup` map swap escapeCodes)++toEscapeCode :: Char -> Maybe Char+toEscapeCode = (`lookup` escapeCodes)++instance IsString (NString r) where+  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@.+--+-- Nix supports both static keynames (just an identifier) and dynamic identifiers.+-- Dynamic identifiers can be either a string (e.g.: @{ "a" = 3; }@) or an antiquotation+-- (e.g.: @let a = "example"; in { ${a} = 3; }.example@).+--+-- Note: There are some places where a dynamic keyname is not allowed. In particular, those include:+--+--   * the RHS of a @binding@ inside @let@: @let ${"a"} = 3; in ...@ produces a syntax error.+--   * the attribute names of an 'inherit': @inherit ${"a"};@ is forbidden.+--+-- Note: In Nix, a simple string without antiquotes such as @"foo"@ is allowed even if+-- the context requires a static keyname, but the parser still considers it a+-- 'DynamicKey' for simplicity.+data NKeyName r+  = DynamicKey (Antiquoted (NString r) r)+  | StaticKey Text+  deriving (Eq, Ord, Generic, Typeable, Data, Show)++-- deriving this instance automatically is not possible+-- because r occurs not only as last argument in Antiquoted (NString r) r+instance Functor NKeyName where+  fmap f (DynamicKey (Plain str)) = DynamicKey . Plain $ fmap f str+  fmap f (DynamicKey (Antiquoted e)) = DynamicKey . Antiquoted $ f e+  fmap _ (StaticKey key) = StaticKey key++type NSelector r = [NKeyName r]++data NOperF r+  = NUnary NUnaryOp r+  | NBinary NBinaryOp r r+  deriving (Eq, Ord, Generic, Typeable, Data, Functor, Show)++data NUnaryOp = NNeg | NNot deriving (Eq, Ord, Generic, Typeable, Data, Show)+data NSpecialOp = NHasAttrOp | NSelectOp | NAppOp+  deriving (Eq, Ord, Generic, Typeable, Data, Show)+data NBinaryOp+  = NEq+  | NNEq+  | NLt+  | NLte+  | NGt+  | NGte+  | NAnd+  | NOr+  | NImpl+  | NUpdate++  | NPlus+  | NMinus+  | NMult+  | NDiv+  | NConcat+  deriving (Eq, Ord, Generic, Typeable, Data, Show)++data NAssoc = NAssocNone | NAssocLeft | NAssocRight+  deriving (Eq, Ord, Generic, Typeable, Data, Show)++data NOperatorDef+  = NUnaryDef String NUnaryOp+  | NBinaryDef NAssoc [(String, NBinaryOp)]+  deriving (Eq, Ord, Generic, Typeable, Data, Show)++nixOperators :: [Either NSpecialOp NOperatorDef]+nixOperators =+  [ Left NSelectOp+  , Left NAppOp+  , Right $ NUnaryDef  "-"  NNeg+  , Left NHasAttrOp+  ] ++ map Right+  [ NBinaryDef NAssocRight [("++", NConcat)]+  , NBinaryDef NAssocLeft [("*", NMult), ("/", NDiv)]+  , NBinaryDef NAssocLeft [("+", NPlus), ("-", NMinus)]+  , NUnaryDef  "!"  NNot+  , NBinaryDef NAssocRight [("//", NUpdate)]+  , NBinaryDef NAssocLeft [("<", NLt), (">", NGt), ("<=", NLte), (">=", NGte)]+  , NBinaryDef NAssocNone [("==", NEq), ("!=", NNEq)]+  , NBinaryDef NAssocLeft [("&&", NAnd)]+  , NBinaryDef NAssocLeft [("||", NOr)]+  , NBinaryDef NAssocNone [("->", NImpl)]+  ]++data OperatorInfo = OperatorInfo+  { precedence    :: Int+  , associativity :: NAssoc+  , operatorName  :: String+  } deriving (Eq, Ord, Generic, Typeable, Data, Show)++getUnaryOperator :: NUnaryOp -> OperatorInfo+getUnaryOperator = (m Map.!) where+  m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $ nixOperators+  buildEntry i (Right (NUnaryDef name op)) = [(op, OperatorInfo i NAssocNone name)]+  buildEntry _ _                           = []++getBinaryOperator :: NBinaryOp -> OperatorInfo+getBinaryOperator = (m Map.!) where+  m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $ nixOperators+  buildEntry i (Right (NBinaryDef assoc ops)) =+    [ (op, OperatorInfo i assoc name) | (name,op) <- ops ]+  buildEntry _ _                              = []++getSpecialOperatorPrec :: NSpecialOp -> Int+getSpecialOperatorPrec = (m Map.!) where+  m = Map.fromList . catMaybes . zipWith buildEntry [1..] . reverse $ nixOperators+  buildEntry _ (Right _) = Nothing+  buildEntry i (Left op) = Just (op, i)++selectOp :: OperatorInfo+selectOp = OperatorInfo (getSpecialOperatorPrec NSelectOp) NAssocLeft "."++hasAttrOp :: OperatorInfo+hasAttrOp = OperatorInfo (getSpecialOperatorPrec NHasAttrOp) NAssocLeft "?"++appOp :: OperatorInfo+appOp = OperatorInfo (getSpecialOperatorPrec NAppOp) NAssocLeft " "++data NSetBind = Rec | NonRec+  deriving (Ord, Eq, Generic, Typeable, Data, Show)++-- | A single line of the bindings section of a let expression or of+-- a set.+data Binding r+  = NamedVar (NSelector r) r+  | Inherit (Maybe r) [NSelector r]+  deriving (Typeable, Data, Ord, Eq, Functor, Show)++data FormalParamSet r = FormalParamSet (Map Text (Maybe r))+  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+  deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show, Foldable, Traversable)++data NExprF r+    -- value types+    = NConstant NAtom+    | NStr (NString r)+    | NList [r]+    | NSet NSetBind [Binding r]+    | NAbs (Formals r) r++    -- operators+    | NOper (NOperF r)+    | NSelect r (NSelector r) (Maybe r)+    | NHasAttr r (NSelector r)+    | NApp r r++    -- language constructs+    -- | A 'NSym' is a reference to a variable. For example, @f@ is represented as+    -- @NSym "f"@ and @a@ as @NSym "a" in @f a@.+    | NSym Text+    | NLet [Binding r] r+    | NIf r r r+    | NWith r r+    | NAssert r r+    deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show)++type NExpr = Fix NExprF++mkInt :: Integer -> NExpr+mkInt = Fix . NConstant . NInt++mkStr :: StringKind -> Text -> NExpr+mkStr kind x = Fix . NStr . NString kind $ if x == ""+  then []+  else [Plain x]++mkUri :: Text -> NExpr+mkUri = Fix . NStr . NUri++mkPath :: Bool -> FilePath -> NExpr+mkPath b = Fix . NConstant . NPath b++mkSym :: Text -> NExpr+mkSym = Fix . NSym++mkSelector :: Text -> NSelector NExpr+mkSelector = (:[]) . StaticKey++mkBool :: Bool -> NExpr+mkBool = Fix . NConstant . NBool++mkNull :: NExpr+mkNull = Fix (NConstant NNull)++mkOper :: NUnaryOp -> NExpr -> NExpr+mkOper op = Fix . NOper . NUnary op++mkOper2 :: NBinaryOp -> NExpr -> NExpr -> NExpr+mkOper2 op a = Fix . NOper . NBinary op a++mkFormalSet :: [(Text, Maybe NExpr)] -> Formals NExpr+mkFormalSet = FormalSet . FormalParamSet . Map.fromList++mkApp :: NExpr -> NExpr -> NExpr+mkApp e = Fix . NApp e++mkRecSet :: [Binding NExpr] -> NExpr+mkRecSet = Fix . NSet Rec++mkNonRecSet :: [Binding NExpr] -> NExpr+mkNonRecSet = Fix . NSet NonRec++mkLet :: [Binding NExpr] -> NExpr -> NExpr+mkLet bs = Fix . NLet bs++mkList :: [NExpr] -> NExpr+mkList = Fix . NList++mkWith :: NExpr -> NExpr -> NExpr+mkWith e = Fix . NWith e++mkAssert :: NExpr -> NExpr -> NExpr+mkAssert e = Fix . NWith e++mkIf :: NExpr -> NExpr -> NExpr -> NExpr+mkIf e1 e2 = Fix . NIf e1 e2++mkFunction :: Formals NExpr -> NExpr -> NExpr+mkFunction params = Fix . NAbs params++-- | Shorthand for producing a binding of a name to an expression.+bindTo :: Text -> NExpr -> Binding NExpr+bindTo name val = NamedVar (mkSelector name) val++-- | Append a list of bindings to a set or let expression.+-- For example, adding `[a = 1, b = 2]` to `let c = 3; in 4` produces+-- `let a = 1; b = 2; c = 3; in 4`.+appendBindings :: [Binding NExpr] -> NExpr -> NExpr+appendBindings newBindings (Fix e) = case e of+  NLet bindings e' -> Fix $ NLet (bindings <> newBindings) e'+  NSet bindType bindings -> Fix $ NSet bindType (bindings <> newBindings)+  _ -> error "Can only append bindings to a set or a let"++-- | Applies a transformation to the body of a nix function.+modifyFunctionBody :: (NExpr -> NExpr) -> NExpr -> NExpr+modifyFunctionBody f (Fix e) = case e of+  NAbs params body -> Fix $ NAbs params (f body)+  _ -> error "Not a function"++-- | An 'NValue' is the most reduced form of an 'NExpr' after evaluation+-- is completed.+data NValueF r+    = NVConstant NAtom+    | NVStr Text+    | NVList [r]+    | NVSet (Map Text r)+    | NVFunction (Formals r) (NValue -> IO r)+    deriving (Generic, Typeable, Functor)++instance Show f => Show (NValueF f) where+    showsPrec = flip go where+      go (NVConstant atom) = showsCon1 "NVConstant" atom+      go (NVStr      text) = showsCon1 "NVStr"      text+      go (NVList     list) = showsCon1 "NVList"     list+      go (NVSet     attrs) = showsCon1 "NVSet"      attrs+      go (NVFunction r _)  = showsCon1 "NVFunction" r++      showsCon1 :: Show a => String -> a -> Int -> String -> String+      showsCon1 con a d = showParen (d > 10) $ showString (con ++ " ") . showsPrec 11 a++type NValue = Fix NValueF++valueText :: NValue -> Text+valueText = cata phi where+    phi (NVConstant a)   = atomText a+    phi (NVStr t)        = t+    phi (NVList _)       = error "Cannot coerce a list to a string"+    phi (NVSet _)        = error "Cannot coerce a set to a string"+    phi (NVFunction _ _) = error "Cannot coerce a function to a string"
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/Main.hs view
@@ -0,0 +1,10 @@+module Main where++import Criterion.Main++import qualified ParserBench++main :: IO ()+main = defaultMain+  [ ParserBench.benchmarks+  ]
+ benchmarks/ParserBench.hs view
@@ -0,0 +1,20 @@+module ParserBench (benchmarks) where++import Nix.Parser++import Control.Applicative+import Criterion++benchFile :: FilePath -> Benchmark+benchFile = bench <*> whnfIO . parseNixFile . ("data/" ++)++benchmarks :: Benchmark+benchmarks = bgroup "Parser"+  [ benchFile "nixpkgs-all-packages.nix"+  , benchFile "nixpkgs-all-packages-pretty.nix"+  , benchFile "let-comments.nix"+  , benchFile "let-comments-multiline.nix"+  , benchFile "let.nix"+  , benchFile "simple.nix"+  , benchFile "simple-pretty.nix"+  ]
+ hnix.cabal view
@@ -0,0 +1,120 @@+Name:                hnix+Version:             0.2.0+Synopsis:            Haskell implementation of the Nix language+Description:+  Haskell implementation of the Nix language.++License:             BSD3+License-file:        LICENSE+Author:              John Wiegley+Maintainer:          johnw@newartisans.com+Category:            Data, Nix+Build-type:          Simple+Cabal-version:       >=1.10+Homepage:            http://github.com/jwiegley/hnix++Flag Parsec+  Description: Use parsec instead of Trifecta+  Default: False++Library+  Default-language: Haskell2010+  Exposed-modules:+    Nix.Eval+    Nix.Parser+    Nix.Types+    Nix.Pretty+  Other-modules:+    Nix.Parser.Library+  Default-extensions:+    DataKinds+    DeriveDataTypeable+    DeriveFunctor+    DeriveGeneric+    FlexibleContexts+    FlexibleInstances+    GADTs+    KindSignatures+    LambdaCase+    MultiWayIf+    OverloadedStrings+    PatternGuards+    RankNTypes+    TupleSections+  Build-depends:+      base                     >= 4.3          && < 5+    , ansi-wl-pprint+    , containers+    , text+    , transformers+    , parsers >= 0.10+    , unordered-containers+    , data-fix+  if flag(parsec)+    Cpp-options: -DUSE_PARSEC+    Build-depends: parsec+  else+    Build-depends: trifecta+  ghc-options: -Wall++Executable hnix+  Default-language: Haskell2010+  Main-is: Nix.hs+  Hs-source-dirs: main+  Default-extensions:+    DataKinds+    DeriveDataTypeable+    DeriveFunctor+    DeriveGeneric+    FlexibleContexts+    FlexibleInstances+    GADTs+    KindSignatures+    LambdaCase+    MultiWayIf+    OverloadedStrings+    PatternGuards+    RankNTypes+    TupleSections+  Build-depends:+      base                     >= 4.3          && < 5+    , hnix+    , containers+    , ansi-wl-pprint+    , data-fix+  Ghc-options: -Wall++Test-suite hnix-tests+  Type: exitcode-stdio-1.0+  Hs-source-dirs: tests+  Default-language: Haskell2010+  Main-is: Main.hs+  Other-modules:+    ParserTests+  Build-depends:+      base >= 4.3 && < 5+    , containers+    , text+    , data-fix+    , hnix+    , tasty+    , tasty-th+    , tasty-hunit++Benchmark hnix-benchmarks+  Type: exitcode-stdio-1.0+  Hs-source-dirs: benchmarks+  Default-language: Haskell2010+  Main-is: Main.hs+  Other-modules:+    ParserBench+  Build-depends:+      base >= 4.3 && < 5+    , containers+    , text+    , hnix+    , criterion++source-repository head+  type:     git+  location: git://github.com/jwiegley/hnix.git
+ main/Nix.hs view
@@ -0,0 +1,28 @@+module Main where++import Nix.Parser+import Nix.Pretty+import Nix.Eval+import Nix.Types++import Data.Fix+import System.Environment+import System.IO+import Text.PrettyPrint.ANSI.Leijen++import qualified Data.Map as Map++nix :: FilePath -> IO ()+nix path = do+  res <- parseNixFile path+  case res of+    Failure e -> hPutStrLn stderr $ "Parse failed: " ++ show e+    Success n -> do+      displayIO stdout $ renderPretty 0.4 80 (prettyNix n)+      putStrLn ""+      evalExpr n (Fix $ NVSet Map.empty) >>= print++main :: IO ()+main = do+    [path] <- getArgs+    nix path
+ tests/Main.hs view
@@ -0,0 +1,10 @@+module Main where++import Test.Tasty++import qualified ParserTests++main :: IO ()+main = defaultMain $ testGroup "hnix"+  [ ParserTests.tests+  ]
+ tests/ParserTests.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module ParserTests (tests) where++import Data.Fix+import Data.Text (pack)+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.TH++import qualified Data.Map as Map++import Nix.Types+import Nix.Parser++case_constant_int :: Assertion+case_constant_int = assertParseString "234" $ mkInt 234++case_constant_bool :: Assertion+case_constant_bool = do+  assertParseString "true" $ mkBool True+  assertParseString "false" $ mkBool False++case_constant_path :: Assertion+case_constant_path = do+  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"+  assertParseString "a//b" $ mkOper2 NUpdate (mkSym "a") (mkSym "b")+  assertParseString "rec+def/cdef" $ mkPath False "rec+def/cdef"+  assertParseString "a/b//c/def//<g> < def/d" $ mkOper2 NLt+    (mkOper2 NUpdate (mkPath False "a/b") $ mkOper2 NUpdate+      (mkPath False "c/def") (mkPath True "g"))+    (mkPath False "def/d")+  assertParseString "a'b/c" $ Fix $ NApp (mkSym "a'b") (mkPath False "/c")+  assertParseFail "."+  assertParseFail ".."+  assertParseFail "/"+  assertParseFail "a/"+  assertParseFail "a/def/"++case_constant_uri :: Assertion+case_constant_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&/"+  assertParseString "rec+def:c" $ mkUri "rec+def:c"+  assertParseString "f.foo:bar" $ mkUri "f.foo:bar"+  assertParseFail "http://foo${\"bar\"}"+  assertParseFail ":bcdef"+  assertParseFail "a%20:asda"+  assertParseFail ".:adasd"+  assertParseFail "+:acdcd"++case_simple_set :: Assertion+case_simple_set = do+  assertParseString "{ a = 23; b = 4; }" $ Fix $ NSet NonRec+    [ NamedVar (mkSelector "a") $ mkInt 23+    , NamedVar (mkSelector "b") $ mkInt 4+    ]+  assertParseFail "{ a = 23 }"++case_set_inherit :: Assertion+case_set_inherit = do+  assertParseString "{ e = 3; inherit a b; }" $ Fix $ NSet NonRec+    [ NamedVar (mkSelector "e") $ mkInt 3+    , Inherit Nothing [mkSelector "a", mkSelector "b"]+    ]+  assertParseString "{ inherit; }" $ Fix $ NSet NonRec [ Inherit Nothing [] ]++case_set_scoped_inherit :: Assertion+case_set_scoped_inherit = assertParseString "{ inherit (a) b c; e = 4; inherit(a)b c; }" $ Fix $ NSet NonRec+  [ Inherit (Just (mkSym "a")) [mkSelector "b", mkSelector "c"]+  , NamedVar (mkSelector "e") $ mkInt 4+  , Inherit (Just (mkSym "a")) [mkSelector "b", mkSelector "c"]+  ]++case_set_rec :: Assertion+case_set_rec = assertParseString "rec { a = 3; b = a; }" $ Fix $ NSet Rec+  [ NamedVar (mkSelector "a") $ mkInt 3+  , NamedVar (mkSelector "b") $ mkSym "a"+  ]++case_set_complex_keynames :: Assertion+case_set_complex_keynames = do+  assertParseString "{ \"\" = null; }" $ Fix $ NSet NonRec+    [ NamedVar [DynamicKey (Plain "")] mkNull ]+  assertParseString "{ a.b = 3; a.c = 4; }" $ Fix $ NSet NonRec+    [ NamedVar [StaticKey "a", StaticKey "b"] $ mkInt 3+    , NamedVar [StaticKey "a", StaticKey "c"] $ mkInt 4+    ]+  assertParseString "{ ${let a = \"b\"; in a} = 4; }" $ Fix $ NSet NonRec+    [ NamedVar [DynamicKey (Antiquoted letExpr)] $ mkInt 4 ]+  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 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+  [ flip Inherit [] $ Just $ Fix $ NSet NonRec [NamedVar (mkSelector "a") $ mkInt 3]+  ]++case_inherit_selector :: Assertion+case_inherit_selector = do+  assertParseString "{ inherit \"a\"; }" $ Fix $ NSet NonRec+    [ Inherit Nothing [ [DynamicKey (Plain "a")] ] ]+  assertParseFail "{ inherit a.x; }"++case_int_list :: Assertion+case_int_list = assertParseString "[1 2 3]" $ Fix $ NList+  [ mkInt i | i <- [1,2,3] ]++case_int_null_list :: Assertion+case_int_null_list = assertParseString "[1 2 3 null 4]" $ Fix (NList (map (Fix . NConstant) [NInt 1, NInt 2, NInt 3, NNull, NInt 4]))++case_mixed_list :: Assertion+case_mixed_list = do+  assertParseString "[{a = 3;}.a (if true then null else false) null false 4 [] c.d or null]" $ Fix $ NList+    [ Fix (NSelect (Fix (NSet NonRec [NamedVar (mkSelector "a") (mkInt 3)])) (mkSelector "a") Nothing)+    , Fix (NIf (mkBool True) mkNull (mkBool False))+    , mkNull, mkBool False, mkInt 4, Fix (NList [])+    , Fix (NSelect (mkSym "c") (mkSelector "d") (Just mkNull))+    ]+  assertParseFail "[if true then null else null]"+  assertParseFail "[a ? b]"+  assertParseFail "[a : a]"+  assertParseFail "[${\"test\")]"++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")+  assertParseString "a:{}" $ Fix $ NAbs (FormalName "a") $ Fix $ NSet NonRec []+  assertParseString "a:[a]" $ Fix $ NAbs (FormalName "a") $ Fix $ NList [mkSym "a"]+  assertParseFail "def:"++case_lambda_pattern :: Assertion+case_lambda_pattern = do+  assertParseString "{b, c ? 1}: b" $+    Fix $ NAbs (FormalSet args) (mkSym "b")+  assertParseString "{ b ? x: x  }: b" $+    Fix $ NAbs (FormalSet args2) (mkSym "b")+  assertParseString "a@{b,c ? 1}: b" $+    Fix $ NAbs (FormalLeftAt "a" args) (mkSym "b")+  assertParseString "{b,c?1}@a: c" $+    Fix $ NAbs (FormalRightAt args "a") (mkSym "c")+  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)]+  lam = Fix $ NAbs (FormalName "x") (mkSym "x")++case_lambda_app_int :: Assertion+case_lambda_app_int = assertParseString "(a: a) 3" $ Fix (NApp lam int) where+  int = mkInt 3+  lam = Fix (NAbs (FormalName "a") asym)+  asym = mkSym "a"++case_simple_let :: Assertion+case_simple_let = do+  assertParseString "let a = 4; in a" $ Fix (NLet binds $ mkSym "a")+  assertParseFail "let a = 4 in a"+ where+  binds = [NamedVar (mkSelector "a") $ mkInt 4]++case_nested_let :: Assertion+case_nested_let = do+  assertParseString "let a = 4; in let b = 5; in a" $ Fix $ NLet+    [ NamedVar (mkSelector "a") $ mkInt 4 ]+    (Fix $ NLet [NamedVar (mkSelector "b") $ mkInt 5] $ mkSym "a")+  assertParseFail "let a = 4; let b = 3; in b"++case_let_scoped_inherit :: Assertion+case_let_scoped_inherit = do+  assertParseString "let a = null; inherit (b) c; in c" $ Fix $ NLet+    [ NamedVar (mkSelector "a") mkNull, Inherit (Just $ mkSym "b") [mkSelector "c"] ]+    (mkSym "c")+  assertParseFail "let inherit (b) c in c"++case_if :: Assertion+case_if = do+  assertParseString "if true then true else false" $ Fix $ NIf (mkBool True) (mkBool True) (mkBool False)+  assertParseFail "if true then false"+  assertParseFail "else"+  assertParseFail "if true then false else"+  assertParseFail "if true then false else false else"+  assertParseFail "1 + 2 then"++case_identifier_special_chars :: Assertion+case_identifier_special_chars = do+  assertParseString "_a" $ mkSym "_a"+  assertParseString "a_b" $ mkSym "a_b"+  assertParseString "a'b" $ mkSym "a'b"+  assertParseString "a''b" $ mkSym "a''b"+  assertParseString "a-b" $ mkSym "a-b"+  assertParseString "a--b" $ mkSym "a--b"+  assertParseString "a12a" $ mkSym "a12a"+  assertParseFail ".a"+  assertParseFail "'a"++makeStringParseTest :: String -> Assertion+makeStringParseTest str = assertParseString ("\"" ++ str ++ "\"") $ mkStr DoubleQuoted $ pack str++case_simple_string :: Assertion+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 DoubleQuoted "$\n\t\r\\"+  assertParseString "\" \\\" \\' \"" $ mkStr DoubleQuoted " \" ' "++case_string_antiquote :: Assertion+case_string_antiquote = do+  assertParseString "\"abc${  if true then \"def\" else \"abc\"  } g\"" $+    Fix $ NStr $ NString DoubleQuoted+      [ Plain "abc"+      , Antiquoted $ Fix $ NIf (mkBool True) (mkStr DoubleQuoted "def") (mkStr DoubleQuoted "abc")+      , Plain " g"+      ]+  assertParseString "\"\\${a}\"" $ mkStr DoubleQuoted "${a}"+  assertParseFail "\"a"+  assertParseFail "${true}"+  assertParseFail "\"${true\""++case_select :: Assertion+case_select = do+  assertParseString "a .  e .di. f" $ Fix $ NSelect (mkSym "a")+    [ StaticKey "e", StaticKey "di", StaticKey "f" ]+    Nothing+  assertParseString "a.e . d    or null" $ Fix $ NSelect (mkSym "a")+    [ StaticKey "e", StaticKey "d" ]+    (Just mkNull)+  assertParseString "{}.\"\"or null" $ Fix $ NSelect (Fix (NSet NonRec []))+    [ DynamicKey (Plain "") ] (Just mkNull)++case_select_path :: Assertion+case_select_path = do+  assertParseString "f ./." $ Fix $ NApp (mkSym "f") (mkPath False "./.")+  assertParseString "f.b ../a" $ Fix $ NApp select (mkPath False "../a")+  assertParseString "{}./def" $ Fix $ NApp (Fix (NSet NonRec [])) (mkPath False "./def")+  assertParseString "{}.\"\"./def" $ Fix $ NApp+    (Fix $ NSelect (Fix (NSet NonRec [])) [DynamicKey (Plain "")] Nothing)+    (mkPath False "./def")+ where select = Fix $ NSelect (mkSym "f") (mkSelector "b") Nothing++case_fun_app :: Assertion+case_fun_app = do+  assertParseString "f a b" $ Fix $ NApp (Fix $ NApp (mkSym "f") (mkSym "a")) (mkSym "b")+  assertParseString "f a.x or null" $ Fix $ NApp (mkSym "f") $ Fix $+    NSelect (mkSym "a") (mkSelector "x") (Just mkNull)+  assertParseFail "f if true then null else null"++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 ' '' "++case_operator_fun_app :: Assertion+case_operator_fun_app = do+  assertParseString "a ++ b" $ mkOper2 NConcat (mkSym "a") (mkSym "b")+  assertParseString "a ++ f b" $ mkOper2 NConcat (mkSym "a") $ Fix $ NApp+    (mkSym "f") (mkSym "b")++case_operators :: Assertion+case_operators = do+  assertParseString "1 + 2 - 3" $ mkOper2 NMinus+    (mkOper2 NPlus (mkInt 1) (mkInt 2)) (mkInt 3)+  assertParseFail "1 + if true then 1 else 2"+  assertParseString "1 + (if true then 2 else 3)" $ mkOper2 NPlus (mkInt 1) $ Fix $ NIf+   (mkBool True) (mkInt 2) (mkInt 3)+  assertParseString "{ a = 3; } // rec { b = 4; }" $ mkOper2 NUpdate+    (Fix $ NSet NonRec [NamedVar (mkSelector "a") (mkInt 3)])+    (Fix $ NSet Rec    [NamedVar (mkSelector "b") (mkInt 4)])+  assertParseString "--a" $ mkOper NNeg $ mkOper NNeg $ mkSym "a"+  assertParseString "a - b - c" $ mkOper2 NMinus+    (mkOper2 NMinus (mkSym "a") (mkSym "b")) $+    mkSym "c"+  assertParseString "foo<bar" $ mkOper2 NLt (mkSym "foo") (mkSym "bar")+  assertParseFail "+ 3"+  assertParseFail "foo +"++case_comments :: Assertion+case_comments = do+  Success expected <- parseNixFile "data/let.nix"+  assertParseFile "let-comments-multiline.nix" expected+  assertParseFile "let-comments.nix" expected++tests :: TestTree+tests = $testGroupGenerator++--------------------------------------------------------------------------------+assertParseString :: String -> NExpr -> Assertion+assertParseString str expected = case parseNixString str of+  Success actual -> assertEqual ("When parsing " ++ str) expected actual+  Failure err    -> assertFailure $ "Unexpected error parsing `" ++ str ++ "':\n" ++ show err++assertParseFile :: FilePath -> NExpr -> Assertion+assertParseFile file expected = do+  res <- parseNixFile $ "data/" ++ file+  case res of+    Success actual -> assertEqual ("Parsing data file " ++ file) expected actual+    Failure err    -> assertFailure $ "Unexpected error parsing data file `" ++ file ++ "':\n" ++ show err++assertParseFail :: String -> Assertion+assertParseFail str = case parseNixString str of+  Failure _ -> return ()+  Success r -> assertFailure $ "Unexpected success parsing `" ++ str ++ ":\nParsed value: " ++ show r