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

Merge pull request #31 from jwiegley/reorganize_types

Browse source 
Reorganize types
This commit is contained in:
John Wiegley 2016-01-25 12:57:57 -05:00
parent f60f12f9a0 80a7dcb684
commit 28adc7bdb1
13 changed files with 709 additions and 594 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -2,3 +2,4 @@
/dist/
**/#*
**/.#*
result

141
Nix/Eval.hs
View file

@ -13,23 +13,57 @@ 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 Data.Typeable (Typeable)
import GHC.Generics
import Nix.Pretty (atomText)
import Nix.StringOperations (runAntiquoted)
import Nix.Expr
import Prelude hiding (mapM, sequence)
buildArgument :: Formals (NValue m) -> NValue m -> NValue m
-- | An 'NValue' is the most reduced form of an 'NExpr' after evaluation
-- is completed.
data NValueF m r
= NVConstant NAtom
| NVStr Text
| NVList [r]
| NVSet (Map.Map Text r)
| NVFunction (Params r) (NValue m -> m r)
deriving (Generic, Typeable, Functor)
instance Show f => Show (NValueF m 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 m = Fix (NValueF m)
valueText :: Functor m => NValue m -> 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"
buildArgument :: Params (NValue m) -> NValue m -> NValue m
buildArgument paramSpec arg = either error (Fix . NVSet) $ case paramSpec of
FormalName name -> return $ Map.singleton name arg
FormalSet s Nothing -> lookupParamSet s
FormalSet s (Just name) -> Map.insert name arg <$> lookupParamSet s
Param name -> return $ Map.singleton name arg
ParamSet (FixedParamSet s) Nothing -> lookupParamSet s
ParamSet (FixedParamSet s) (Just name) ->
Map.insert name arg <$> lookupParamSet s
ParamSet _ _ -> error "Can't yet handle variadic param sets"
where
go env k def = maybe (Left err) return $ Map.lookup k env <|> def
where err = "Could not find " ++ show k
lookupParamSet fps = case fps of
FixedParamSet s -> case arg of
lookupParamSet s = case arg of
Fix (NVSet env) -> Map.traverseWithKey (go env) s
_ -> Left "Unexpected function environment"
_ -> error "Can't yet handle variadic param sets"
evalExpr :: MonadFix m => NExpr -> NValue m -> m (NValue m)
evalExpr = cata phi
@ -40,40 +74,41 @@ evalExpr = cata phi
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 (NLiteralPath _) = error "Path expressions are not yet supported"
phi (NEnvPath _) = error "Path expressions are not yet supported"
phi (NOper x) = \env -> case x of
NUnary op arg -> arg env >>= \case
Fix (NVConstant c) -> pure $ Fix $ NVConstant $ case (op, c) of
(NNeg, NInt i) -> NInt (-i)
(NNot, NBool b) -> NBool (not b)
_ -> error $ "unsupported argument type for unary operator " ++ show op
_ -> error "argument to unary operator must evaluate to an atomic type"
NBinary op larg rarg -> do
lval <- larg env
rval <- rarg env
case (lval, rval) of
(Fix (NVConstant lc), Fix (NVConstant rc)) -> pure $ Fix $ NVConstant $ case (op, lc, rc) of
(NEq, l, r) -> NBool $ l == r
(NNEq, l, r) -> NBool $ l /= r
(NLt, l, r) -> NBool $ l < r
(NLte, l, r) -> NBool $ l <= r
(NGt, l, r) -> NBool $ l > r
(NGte, l, r) -> NBool $ l >= r
(NAnd, NBool l, NBool r) -> NBool $ l && r
(NOr, NBool l, NBool r) -> NBool $ l || r
(NImpl, NBool l, NBool r) -> NBool $ not l || r
(NPlus, NInt l, NInt r) -> NInt $ l + r
(NMinus, NInt l, NInt r) -> NInt $ l - r
(NMult, NInt l, NInt r) -> NInt $ l * r
(NDiv, NInt l, NInt r) -> NInt $ l `div` r
_ -> error $ "unsupported argument types for binary operator " ++ show op
(Fix (NVStr ls), Fix (NVStr rs)) -> case op of
NConcat -> pure $ Fix $ NVStr $ ls `mappend` rs
_ -> error $ "unsupported argument types for binary operator " ++ show op
(Fix (NVSet ls), Fix (NVSet rs)) -> case op of
NUpdate -> pure $ Fix $ NVSet $ rs `Map.union` ls
_ -> error $ "unsupported argument types for binary operator " ++ show op
phi (NUnary op arg) = \env -> arg env >>= \case
Fix (NVConstant c) -> pure $ Fix $ NVConstant $ case (op, c) of
(NNeg, NInt i) -> NInt (-i)
(NNot, NBool b) -> NBool (not b)
_ -> error $ "unsupported argument type for unary operator " ++ show op
_ -> error "argument to unary operator must evaluate to an atomic type"
phi (NBinary op larg rarg) = \env -> do
lval <- larg env
rval <- rarg env
case (lval, rval) of
(Fix (NVConstant lc), Fix (NVConstant rc)) -> pure $ Fix $ NVConstant $ case (op, lc, rc) of
(NEq, l, r) -> NBool $ l == r
(NNEq, l, r) -> NBool $ l /= r
(NLt, l, r) -> NBool $ l < r
(NLte, l, r) -> NBool $ l <= r
(NGt, l, r) -> NBool $ l > r
(NGte, l, r) -> NBool $ l >= r
(NAnd, NBool l, NBool r) -> NBool $ l && r
(NOr, NBool l, NBool r) -> NBool $ l || r
(NImpl, NBool l, NBool r) -> NBool $ not l || r
(NPlus, NInt l, NInt r) -> NInt $ l + r
(NMinus, NInt l, NInt r) -> NInt $ l - r
(NMult, NInt l, NInt r) -> NInt $ l * r
(NDiv, NInt l, NInt r) -> NInt $ l `div` r
_ -> error $ "unsupported argument types for binary operator " ++ show op
(Fix (NVStr ls), Fix (NVStr rs)) -> case op of
NConcat -> pure $ Fix $ NVStr $ ls `mappend` rs
_ -> error $ "unsupported argument types for binary operator " ++ show op
(Fix (NVSet ls), Fix (NVSet rs)) -> case op of
NUpdate -> pure $ Fix $ NVSet $ rs `Map.union` ls
_ -> error $ "unsupported argument types for binary operator " ++ show op
_ -> error $ "unsupported argument types for binary operator " ++ show op
phi (NSelect aset attr alternative) = go where
go env = do
@ -99,12 +134,12 @@ evalExpr = cata phi
phi (NList l) = \env ->
Fix . NVList <$> mapM ($ env) l
phi (NSet recBind binds) = \env -> case env of
phi (NSet binds) = \env -> Fix . NVSet <$> evalBinds True env binds
phi (NRecSet binds) = \env -> case env of
(Fix (NVSet env')) -> do
rec
mergedEnv <- case recBind of
Rec -> pure $ Fix $ NVSet $ evaledBinds `Map.union` env'
NonRec -> fmap (Fix . NVSet) $ evalBinds True env binds
mergedEnv <- pure $ Fix $ NVSet $ evaledBinds `Map.union` env'
evaledBinds <- evalBinds True mergedEnv binds
pure mergedEnv
_ -> error "invalid evaluation environment"
@ -157,12 +192,16 @@ evalExpr = cata phi
evalString :: Monad m
=> NValue m -> NString (NValue m -> m (NValue m)) -> m Text
evalString env (NString _ parts)
= Text.concat <$> mapM (runAntiquoted return (fmap valueText . ($ env))) parts
evalString _env (NUri t) = return t
evalString env nstr = do
let fromParts parts = Text.concat <$>
mapM (runAntiquoted return (fmap valueText . ($ env))) parts
case nstr of
Indented parts -> fromParts parts
DoubleQuoted parts -> fromParts parts
evalBinds :: Monad m => Bool -> NValue m -> [Binding (NValue m -> m (NValue m))] ->
m (Map.Map Text (NValue m))
evalBinds :: Monad m => Bool -> NValue m ->
[Binding (NValue m -> m (NValue m))] ->
m (Map.Map Text (NValue m))
evalBinds allowDynamic env xs = buildResult <$> sequence (concatMap go xs) where
buildResult :: [([Text], NValue m)] -> Map.Map Text (NValue m)
buildResult = foldl' insert Map.empty . map (first reverse) where
@ -186,7 +225,7 @@ evalBinds allowDynamic env xs = buildResult <$> sequence (concatMap go xs) where
go (NamedVar x y) = [liftM2 (,) (evalSelector allowDynamic env x) (y env)]
go _ = [] -- HACK! But who cares right now
evalSelector :: Monad m => Bool -> NValue m -> NSelector (NValue m -> m (NValue m)) -> m [Text]
evalSelector :: Monad m => Bool -> NValue m -> NAttrPath (NValue m -> m (NValue m)) -> m [Text]
evalSelector dyn env = mapM evalKeyName where
evalKeyName (StaticKey k) = return k
evalKeyName (DynamicKey k)

315
Nix/Expr.hs Normal file
View file

@ -0,0 +1,315 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
-- | The nix expression type and supporting types.
module Nix.Expr where
import Control.Monad hiding (forM_, mapM, sequence)
import Data.Data
import Data.Fix
import Data.Foldable
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.Text (Text, pack)
import Data.Traversable
import GHC.Exts
import GHC.Generics
import Prelude hiding (readFile, concat, concatMap, elem, mapM,
sequence, minimum, foldr)
-- | The main nix expression type. This is polymorphic so that it can be made
-- a functor, which allows us to traverse expressions and map functions over
-- them. The actual 'NExpr' type is a fixed point of this functor, defined
-- below.
data NExprF r
= NConstant NAtom
-- ^ Constants: ints, bools, URIs, and null.
| NStr (NString r)
-- ^ A string, with interpolated expressions.
| NSym Text
-- ^ A variable. For example, in the expression @f a@, @f@ is represented
-- as @NSym "f"@ and @a@ as @NSym "a"@.
| NList [r]
-- ^ A list literal.
| NSet [Binding r]
-- ^ An attribute set literal, not recursive.
| NRecSet [Binding r]
-- ^ An attribute set literal, recursive.
| NLiteralPath FilePath
-- ^ A path expression, which is evaluated to a store path. The path here
-- can be relative, in which case it's evaluated relative to the file in
-- which it appears.
| NEnvPath FilePath
-- ^ A path which refers to something in the Nix search path (the NIX_PATH
-- environment variable. For example, @<nixpkgs/pkgs>@.
| NUnary NUnaryOp r
-- ^ Application of a unary operator to an expression.
| NBinary NBinaryOp r r
-- ^ Application of a binary operator to two expressions.
| NSelect r (NAttrPath r) (Maybe r)
-- ^ Dot-reference into an attribute set, optionally providing an
-- alternative if the key doesn't exist.
| NHasAttr r (NAttrPath r)
-- ^ Ask if a set contains a given attribute path.
| NAbs (Params r) r
-- ^ A function literal (lambda abstraction).
| NApp r r
-- ^ Apply a function to an argument.
| NLet [Binding r] r
-- ^ Evaluate the second argument after introducing the bindings.
| NIf r r r
-- ^ If-then-else statement.
| NWith r r
-- ^ Evaluate an attribute set, bring its bindings into scope, and
-- evaluate the second argument.
| NAssert r r
-- ^ Assert that the first returns true before evaluating the second.
deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show)
-- | The monomorphic expression type is a fixed point of the polymorphic one.
type NExpr = Fix NExprF
-- | 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
-- | Booleans.
| NBool Bool
-- | Null values. There's only one of this variant.
| NNull
-- | URIs, which are just string literals, but do not need quotes.
| NUri Text
deriving (Eq, Ord, Generic, Typeable, Data, Show)
-- | A single line of the bindings section of a let expression or of a set.
data Binding r
= NamedVar (NAttrPath r) r
-- ^ An explicit naming, such as @x = y@ or @x.y = z@.
| Inherit (Maybe r) [NAttrPath r]
-- ^ Using a name already in scope, such as @inherit x;@ which is shorthand
-- for @x = x;@ or @inherit (x) y;@ which means @y = x.y;@.
deriving (Typeable, Data, Ord, Eq, Functor, Show)
-- | @Params@ represents all the ways the formal parameters to a
-- function can be represented.
data Params r
= Param Text
-- ^ For functions with a single named argument, such as @x: x + 1@.
| ParamSet (ParamSet r) (Maybe Text)
-- ^ Explicit parameters (argument must be a set). Might specify a name
-- to bind to the set in the function body.
deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show,
Foldable, Traversable)
-- | An explicit parameter set; provides a shorthand for unpacking arguments.
data ParamSet r
= FixedParamSet (Map Text (Maybe r))
-- ^ A fixed set, where no arguments beyond what is specified in the map
-- may be given. The map might contain defaults for arguments not passed.
| VariadicParamSet (Map Text (Maybe r))
-- ^ Same as the 'FixedParamSet', but extra arguments are allowed.
deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show,
Foldable, Traversable)
-- | '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)
-- | An 'NString' 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
= DoubleQuoted [Antiquoted Text r]
-- ^ Strings wrapped with double-quotes (") are not allowed to contain
-- literal newline characters.
| Indented [Antiquoted Text r]
-- ^ Strings wrapped with two single quotes ('') can contain newlines,
-- and their indentation will be stripped.
deriving (Eq, Ord, Generic, Typeable, Data, Functor, Show)
-- | For the the 'IsString' instance, we use a plain doublequoted string.
instance IsString (NString r) where
fromString "" = DoubleQuoted []
fromString string = DoubleQuoted [Plain $ pack string]
-- | 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
-- | A selector (for example in a @let@ or an attribute set) is made up
-- of strung-together key names.
type NAttrPath r = [NKeyName r]
-- | There are two unary operations: logical not and integer negation.
data NUnaryOp = NNeg | NNot
deriving (Eq, Ord, Generic, Typeable, Data, Show)
-- | Binary operators expressible in the nix language.
data NBinaryOp
= NEq -- ^ Equality (==)
| NNEq -- ^ Inequality (!=)
| NLt -- ^ Less than (<)
| NLte -- ^ Less than or equal (<=)
| NGt -- ^ Greater than (>)
| NGte -- ^ Greater than or equal (>=)
| NAnd -- ^ Logical and (&&)
| NOr -- ^ Logical or (||)
| NImpl -- ^ Logical implication (->)
| NUpdate -- ^ Joining two attribut sets (//)
| NPlus -- ^ Addition (+)
| NMinus -- ^ Subtraction (-)
| NMult -- ^ Multiplication (*)
| NDiv -- ^ Division (/)
| NConcat -- ^ List concatenation (++)
deriving (Eq, Ord, Generic, Typeable, Data, Show)
-- | Get the name out of the parameter (there might be none).
paramName :: Params r -> Maybe Text
paramName (Param n) = Just n
paramName (ParamSet _ n) = n
-- | Make an integer literal expression.
mkInt :: Integer -> NExpr
mkInt = Fix . NConstant . NInt
-- | Make a regular (double-quoted) string.
mkStr :: Text -> NExpr
mkStr = Fix . NStr . DoubleQuoted . \case
"" -> []
x -> [Plain x]
mkIndentedStr :: Text -> NExpr
mkIndentedStr = Fix . NStr . Indented . \case
"" -> []
x -> [Plain x]
-- | Make a literal URI expression.
mkUri :: Text -> NExpr
mkUri = Fix . NConstant . NUri
-- | Make a path. Use 'True' if the path should be read from the
-- environment, else 'False'.
mkPath :: Bool -> FilePath -> NExpr
mkPath False = Fix . NLiteralPath
mkPath True = Fix . NEnvPath
-- | Make a path expression which pulls from the NIX_PATH env variable.
mkEnvPath :: FilePath -> NExpr
mkEnvPath = mkPath True
-- | Make a path expression which references a relative path.
mkRelPath :: FilePath -> NExpr
mkRelPath = mkPath False
-- | Make a variable (symbol)
mkSym :: Text -> NExpr
mkSym = Fix . NSym
mkSelector :: Text -> NAttrPath NExpr
mkSelector = (:[]) . StaticKey
mkBool :: Bool -> NExpr
mkBool = Fix . NConstant . NBool
mkNull :: NExpr
mkNull = Fix (NConstant NNull)
mkOper :: NUnaryOp -> NExpr -> NExpr
mkOper op = Fix . NUnary op
mkOper2 :: NBinaryOp -> NExpr -> NExpr -> NExpr
mkOper2 op a = Fix . NBinary op a
mkParamset :: [(Text, Maybe NExpr)] -> Params NExpr
mkParamset params = ParamSet (mkFixedParamSet params) Nothing
mkFixedParamSet :: [(Text, Maybe NExpr)] -> ParamSet NExpr
mkFixedParamSet ps = FixedParamSet (Map.fromList ps)
mkVariadicParamSet :: [(Text, Maybe NExpr)] -> ParamSet NExpr
mkVariadicParamSet ps = VariadicParamSet (Map.fromList ps)
mkApp :: NExpr -> NExpr -> NExpr
mkApp e = Fix . NApp e
mkRecSet :: [Binding NExpr] -> NExpr
mkRecSet = Fix . NRecSet
mkNonRecSet :: [Binding NExpr] -> NExpr
mkNonRecSet = Fix . NSet
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 :: Params 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 bindings -> Fix $ NSet (bindings <> newBindings)
NRecSet bindings -> Fix $ NRecSet (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"

30
Nix/Parser.hs
View file

@ -16,7 +16,9 @@ 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 Nix.Parser.Operators
import Nix.Expr
import Nix.StringOperations
import Prelude hiding (elem)
-- | The lexer for this parser is defined in 'Nix.Parser.Library'.
@ -45,7 +47,7 @@ selDot :: Parser ()
selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath)) *> whiteSpace
<?> "."
nixSelector :: Parser (NSelector NExpr)
nixSelector :: Parser (NAttrPath NExpr)
nixSelector = keyName `sepBy1` selDot where
nixSelect :: Parser NExpr -> Parser NExpr
@ -154,7 +156,7 @@ nixUri = token $ fmap (mkUri . pack) $ (++)
nixString :: Parser (NString NExpr)
nixString = doubleQuoted <|> indented <?> "string"
where
doubleQuoted = NString DoubleQuoted . removePlainEmpty . mergePlain
doubleQuoted = DoubleQuoted . removePlainEmpty . mergePlain
<$> (doubleQ *> many (stringChar doubleQ (void $ char '\\') doubleEscape)
<* token doubleQ)
<?> "double quoted string"
@ -182,32 +184,32 @@ nixString = doubleQuoted <|> indented <?> "string"
escapeCode = choice [ c <$ char e | (c,e) <- escapeCodes ] <|> anyChar
-- | Gets all of the arguments for a function.
argExpr :: Parser (Formals NExpr)
argExpr :: Parser (Params NExpr)
argExpr = choice [atLeft, onlyname, atRight] <* symbolic ':' where
-- An argument not in curly braces. There's some potential ambiguity
-- in the case of, for example `x:y`. Is it a lambda function `x: y`, or
-- a URI `x:y`? Nix syntax says it's the latter. So we need to fail if
-- there's a valid URI parse here.
onlyname = choice [nixUri >> unexpected "valid uri",
FormalName <$> identifier]
Param <$> identifier]
-- Parameters named by an identifier on the left (`args @ {x, y}`)
atLeft = try $ do
name <- identifier <* symbolic '@'
ps <- params
return $ FormalSet ps (Just name)
(constructor, params) <- params
return $ ParamSet (constructor params) (Just name)
-- Parameters named by an identifier on the right, or none (`{x, y} @ args`)
atRight = do
ps <- params
(constructor, params) <- params
name <- optional $ symbolic '@' *> identifier
return $ FormalSet ps name
return $ ParamSet (constructor params) name
-- Return the parameters set.
params = do
(args, dotdots) <- braces getParams
let pset = if dotdots then VariadicParamSet else FixedParamSet
return $ pset $ Map.fromList args
let constructor = if dotdots then VariadicParamSet else FixedParamSet
return (constructor, Map.fromList args)
-- Collects the parameters within curly braces. Returns the parameters and
-- a boolean indicating if the parameters are variadic.
@ -240,9 +242,9 @@ keyName = dynamicKey <|> staticKey where
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
nixSet = Fix <$> (isRec <*> braces nixBinders) <?> "set" where
isRec = (try (reserved "rec" *> pure NRecSet) <?> "recursive set")
<|> pure NSet
parseNixFile :: MonadIO m => FilePath -> m (Result NExpr)
parseNixFile = parseFromFileEx $ nixExpr <* eof

81
Nix/Parser/Operators.hs Normal file
View file

@ -0,0 +1,81 @@
module Nix.Parser.Operators where
import Data.Data (Data(..))
import Data.Foldable (concat)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Typeable (Typeable)
import GHC.Exts
import GHC.Generics
import Nix.Expr
import Prelude hiding (readFile, concat, concatMap, elem, mapM,
sequence, minimum, foldr)
data NSpecialOp = NHasAttrOp | NSelectOp | NAppOp
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 = \case
Right (NUnaryDef name op) -> [(op, OperatorInfo i NAssocNone name)]
_ -> []
getBinaryOperator :: NBinaryOp -> OperatorInfo
getBinaryOperator = (m Map.!) where
m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $
nixOperators
buildEntry i = \case
Right (NBinaryDef assoc ops) -> do
[(op, OperatorInfo i assoc name) | (name,op) <- ops]
_ -> []
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 " "

88
Nix/Pretty.hs
View file

@ -5,9 +5,12 @@ 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 Data.Text (Text, pack, unpack, replace, strip)
import Data.List (isPrefixOf)
import Nix.Expr
import Nix.Parser.Library (reservedNames)
import Nix.Parser.Operators
import Nix.StringOperations
import Text.PrettyPrint.ANSI.Leijen
import qualified Data.Text as Text
@ -53,12 +56,12 @@ wrapParens op sub
| otherwise = parens $ withoutParens sub
prettyString :: NString NixDoc -> Doc
prettyString (NString DoubleQuoted parts) = dquotes . hcat . map prettyPart $ parts
prettyString (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)
prettyString (Indented parts)
= group $ nest 2 (squote <> squote <$$> content) <$$> squote <> squote
where
content = vsep . map prettyLine . stripLastIfEmpty . splitLines $ parts
@ -69,15 +72,13 @@ prettyString (NString Indented parts)
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 mname) = prettyParamSet s <> case mname of
prettyParams :: Params NixDoc -> Doc
prettyParams (Param n) = text $ unpack n
prettyParams (ParamSet s mname) = prettyParamSet s <> case mname of
Nothing -> empty
Just name -> text "@" <> text (unpack name)
prettyParamSet :: FormalParamSet NixDoc -> Doc
prettyParamSet :: ParamSet NixDoc -> Doc
prettyParamSet params = lbrace <+> middle <+> rbrace
where
prettyArgs = case params of
@ -85,6 +86,9 @@ prettyParamSet params = lbrace <+> middle <+> rbrace
VariadicParamSet args -> map prettySetArg (toList args) ++ [text "..."]
middle = hcat $ punctuate (comma <> space) prettyArgs
prettySetArg (n, maybeDef) = case maybeDef of
Nothing -> text (unpack n)
Just v -> text (unpack n) <+> text "?" <+> withoutParens v
prettyBind :: Binding NixDoc -> Doc
prettyBind (NamedVar n v) = prettySelector n <+> equals <+> withoutParens v <> semi
@ -98,27 +102,15 @@ prettyKeyName (StaticKey key)
prettyKeyName (StaticKey key) = text . unpack $ key
prettyKeyName (DynamicKey key) = runAntiquoted prettyString withoutParens key
prettySelector :: NSelector NixDoc -> Doc
prettySelector :: NAttrPath 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
-- | Translate an atom into its nix representation.
atomText :: NAtom -> Text
atomText (NInt i) = pack (show i)
atomText (NBool b) = if b then "true" else "false"
atomText NNull = "null"
atomText (NUri uri) = uri
prettyAtom :: NAtom -> NixDoc
prettyAtom atom = simpleExpr $ text $ unpack $ atomText atom
@ -131,12 +123,27 @@ prettyNix = withoutParens . cata phi where
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 (NSet []) = simpleExpr $ lbrace <> rbrace
phi (NSet xs) = simpleExpr $ group $
nest 2 (vsep $ lbrace : map prettyBind xs) <$> rbrace
phi (NRecSet []) = simpleExpr $ recPrefix <> lbrace <> rbrace
phi (NRecSet xs) = simpleExpr $ group $
nest 2 (vsep $ recPrefix <> lbrace : map prettyBind xs) <$> rbrace
phi (NAbs args body) = leastPrecedence $
(prettyFormals args <> colon) </> (nest 2 $ withoutParens body)
phi (NOper oper) = prettyOper oper
(prettyParams args <> colon) </> (nest 2 $ withoutParens body)
phi (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
phi (NUnary op r1) =
NixDoc (text (operatorName opInfo) <> wrapParens opInfo r1) opInfo
where opInfo = getUnaryOperator op
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
@ -144,7 +151,15 @@ prettyNix = withoutParens . cata phi where
= NixDoc (wrapParens hasAttrOp r <+> text "?" <+> prettySelector attr) hasAttrOp
phi (NApp fun arg)
= NixDoc (wrapParens appOp fun <+> wrapParens appOpNonAssoc arg) appOp
phi (NEnvPath p) = simpleExpr $ text ("<" ++ p ++ ">")
phi (NLiteralPath p) = simpleExpr $ text $ case p of
"./" -> "./."
"../" -> "../."
".." -> "../."
txt | "/" `isPrefixOf` txt -> txt
| "./" `isPrefixOf` txt -> txt
| "../" `isPrefixOf` txt -> txt
| otherwise -> "./" ++ txt
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
@ -158,5 +173,4 @@ prettyNix = withoutParens . cata phi where
phi (NAssert cond body) = leastPrecedence $
text "assert" <+> withoutParens cond <> semi <+> withoutParens body
recPrefix Rec = text "rec" <> space
recPrefix NonRec = empty
recPrefix = text "rec" <> space

87
Nix/StringOperations.hs Normal file
View file

@ -0,0 +1,87 @@
-- | Functions for manipulating nix strings.
module Nix.StringOperations where
import Nix.Expr
import Data.List (intercalate)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Prelude hiding (elem)
import Data.Tuple (swap)
-- | 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', as they don't have any
-- informational content.
removePlainEmpty :: (Eq v, Monoid v) => [Antiquoted v r] -> [Antiquoted v r]
removePlainEmpty = filter f where
f (Plain x) = x /= mempty
f _ = True
-- | Equivalent to case splitting on 'Antiquoted' strings.
runAntiquoted :: (v -> a) -> (r -> a) -> Antiquoted v r -> a
runAntiquoted f _ (Plain v) = f v
runAntiquoted _ f (Antiquoted r) = f r
-- | 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 [] = Indented []
stripIndent xs =
Indented . removePlainEmpty . mergePlain . unsplitLines $ ls'
where
ls = stripEmptyOpening $ splitLines xs
ls' = map (dropSpaces minIndent) ls
minIndent = case stripEmptyLines ls of
[] -> 0
nonEmptyLs -> minimum $ map (countSpaces . mergePlain) nonEmptyLs
stripEmptyLines = filter $ \case
[Plain t] -> not $ T.null $ T.strip t
_ -> 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)

439
Nix/Types.hs
View file

@ -1,439 +0,0 @@
{-# 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 isFromEnv p)
| isFromEnv = pack ("<" ++ p ++ ">")
-- If it's not an absolute path, we need to prefix with ./
| otherwise = case pack p of
"./" -> "./."
"../" -> "../."
".." -> "../."
txt | "/" `T.isPrefixOf` txt -> txt
| "./" `T.isPrefixOf` txt -> txt
| "../" `T.isPrefixOf` txt -> txt
| otherwise -> "./" <> txt
-- | '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 = case stripEmptyLines ls of
[] -> 0
nonEmptyLs -> minimum $ map (countSpaces . mergePlain) nonEmptyLs
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 on the left 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)
-- | For functions which are called with a set as an argument.
data FormalParamSet r
= FixedParamSet (Map Text (Maybe r)) -- ^ E.g. `{foo, bar}`
| VariadicParamSet (Map Text (Maybe r)) -- ^ E.g. `{foo, bar, ...}`
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) (Maybe Text)
deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show, Foldable, Traversable)
-- | A functor-ized nix expression type, which lets us do things like traverse
-- expressions and map functions over them. The actual NExpr type is defined
-- below.
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 = mkFixedParamSet
mkFixedParamSet :: [(Text, Maybe NExpr)] -> Formals NExpr
mkFixedParamSet ps = FormalSet (FixedParamSet $ Map.fromList ps) Nothing
mkVariadicParamSet :: [(Text, Maybe NExpr)] -> Formals NExpr
mkVariadicParamSet ps = FormalSet (VariadicParamSet $ Map.fromList ps) Nothing
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 = NamedVar . mkSelector
-- | 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 m r
= NVConstant NAtom
| NVStr Text
| NVList [r]
| NVSet (Map Text r)
| NVFunction (Formals r) (NValue m -> m r)
deriving (Generic, Typeable, Functor)
instance Show f => Show (NValueF m 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 m = Fix (NValueF m)
valueText :: Functor m => NValue m -> 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"

11
hnix.cabal
View file

@ -1,5 +1,5 @@
Name: hnix
Version: 0.2.3
Version: 0.3.0
Synopsis: Haskell implementation of the Nix language
Description:
Haskell implementation of the Nix language.
@ -24,8 +24,10 @@ Library
Exposed-modules:
Nix.Eval
Nix.Parser
Nix.Types
Nix.Expr
Nix.Pretty
Nix.Parser.Operators
Nix.StringOperations
Other-modules:
Nix.Parser.Library
Default-extensions:
@ -39,6 +41,7 @@ Library
KindSignatures
LambdaCase
MultiWayIf
NoImplicitPrelude
OverloadedStrings
PatternGuards
RankNTypes
@ -52,12 +55,13 @@ Library
, parsers >= 0.10
, unordered-containers
, data-fix
, deepseq
if flag(parsec)
Cpp-options: -DUSE_PARSEC
Build-depends: parsec
else
Build-depends: trifecta
ghc-options: -Wall
ghc-options: -Wall -fno-warn-name-shadowing
Executable hnix
Default-language: Haskell2010
@ -84,6 +88,7 @@ Executable hnix
, containers
, ansi-wl-pprint
, data-fix
, deepseq
Ghc-options: -Wall
Test-suite hnix-tests

2
project.nix
View file

@ -10,7 +10,7 @@ in
mkDerivation {
pname = "hnix";
version = "0.2.3";
version = "0.3.0";
src = let
notNamed = list: name: !(elem (baseNameOf name) list);
in filterSource (n: _: notNamed [".git" "dist" "benchmarks"] n) ./.;

5
tests/EvalTests.hs
View file

@ -10,7 +10,10 @@ import Test.Tasty.TH
import Nix.Eval
import Nix.Parser
import Nix.Types
import Nix.Expr
import Data.Monoid (Monoid(..))
import Prelude (String)
case_basic_sum :: Assertion
case_basic_sum = constantEqualStr "2" "1 + 1"

2
tests/Main.hs
View file

@ -5,6 +5,8 @@ import Test.Tasty
import qualified ParserTests
import qualified EvalTests
import Prelude (IO, ($))
main :: IO ()
main = defaultMain $ testGroup "hnix"
[ ParserTests.tests

101
tests/ParserTests.hs
View file

@ -10,8 +10,11 @@ import Test.Tasty.TH
import qualified Data.Map as Map
import Nix.Types
import Nix.Expr
import Nix.Parser
import Nix.StringOperations
import Prelude
case_constant_int :: Assertion
case_constant_int = assertParseString "234" $ mkInt 234
@ -57,7 +60,7 @@ case_constant_uri = do
case_simple_set :: Assertion
case_simple_set = do
assertParseString "{ a = 23; b = 4; }" $ Fix $ NSet NonRec
assertParseString "{ a = 23; b = 4; }" $ Fix $ NSet
[ NamedVar (mkSelector "a") $ mkInt 23
, NamedVar (mkSelector "b") $ mkInt 4
]
@ -65,49 +68,49 @@ case_simple_set = do
case_set_inherit :: Assertion
case_set_inherit = do
assertParseString "{ e = 3; inherit a b; }" $ Fix $ NSet NonRec
assertParseString "{ e = 3; inherit a b; }" $ Fix $ NSet
[ NamedVar (mkSelector "e") $ mkInt 3
, Inherit Nothing [mkSelector "a", mkSelector "b"]
]
assertParseString "{ inherit; }" $ Fix $ NSet NonRec [ Inherit Nothing [] ]
assertParseString "{ inherit; }" $ Fix $ NSet [ 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
case_set_scoped_inherit = assertParseString "{ inherit (a) b c; e = 4; inherit(a)b c; }" $ Fix $ NSet
[ 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
case_set_rec = assertParseString "rec { a = 3; b = a; }" $ Fix $ NRecSet
[ 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
assertParseString "{ \"\" = null; }" $ Fix $ NSet
[ NamedVar [DynamicKey (Plain "")] mkNull ]
assertParseString "{ a.b = 3; a.c = 4; }" $ Fix $ NSet NonRec
assertParseString "{ a.b = 3; a.c = 4; }" $ Fix $ NSet
[ NamedVar [StaticKey "a", StaticKey "b"] $ mkInt 3
, NamedVar [StaticKey "a", StaticKey "c"] $ mkInt 4
]
assertParseString "{ ${let a = \"b\"; in a} = 4; }" $ Fix $ NSet NonRec
assertParseString "{ ${let a = \"b\"; in a} = 4; }" $ Fix $ NSet
[ NamedVar [DynamicKey (Antiquoted letExpr)] $ mkInt 4 ]
assertParseString "{ \"a${let a = \"b\"; in a}c\".e = 4; }" $ Fix $ NSet NonRec
assertParseString "{ \"a${let a = \"b\"; in a}c\".e = 4; }" $ Fix $ NSet
[ 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"]
letExpr = Fix $ NLet [ NamedVar (mkSelector "a") (mkStr "b") ] (mkSym "a")
str = 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_set_inherit_direct = assertParseString "{ inherit ({a = 3;}); }" $ Fix $ NSet
[ flip Inherit [] $ Just $ Fix $ NSet [NamedVar (mkSelector "a") $ mkInt 3]
]
case_inherit_selector :: Assertion
case_inherit_selector = do
assertParseString "{ inherit \"a\"; }" $ Fix $ NSet NonRec
assertParseString "{ inherit \"a\"; }" $ Fix $ NSet
[ Inherit Nothing [ [DynamicKey (Plain "a")] ] ]
assertParseFail "{ inherit a.x; }"
@ -121,7 +124,7 @@ case_int_null_list = assertParseString "[1 2 3 null 4]" $ Fix (NList (map (Fix .
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 (NSelect (Fix (NSet [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))
@ -132,43 +135,45 @@ case_mixed_list = do
assertParseFail "[${\"test\")]"
case_simple_lambda :: Assertion
case_simple_lambda = assertParseString "a: a" $ Fix $ NAbs (FormalName "a") (mkSym "a")
case_simple_lambda = assertParseString "a: a" $ Fix $ NAbs (Param "a") (mkSym "a")
case_lambda_or_uri :: Assertion
case_lambda_or_uri = do
assertParseString "a :b" $ Fix $ NAbs (FormalName "a") (mkSym "b")
assertParseString "a :b" $ Fix $ NAbs (Param "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"]
assertParseString "a:{}" $ Fix $ NAbs (Param "a") $ Fix $ NSet []
assertParseString "a:[a]" $ Fix $ NAbs (Param "a") $ Fix $ NList [mkSym "a"]
assertParseFail "def:"
case_lambda_pattern :: Assertion
case_lambda_pattern = do
assertParseString "{b, c ? 1}: b" $
Fix $ NAbs (FormalSet args Nothing) (mkSym "b")
Fix $ NAbs (fixed args Nothing) (mkSym "b")
assertParseString "{ b ? x: x }: b" $
Fix $ NAbs (FormalSet args2 Nothing) (mkSym "b")
Fix $ NAbs (fixed args2 Nothing) (mkSym "b")
assertParseString "a@{b,c ? 1}: b" $
Fix $ NAbs (FormalSet args (Just "a")) (mkSym "b")
Fix $ NAbs (fixed args (Just "a")) (mkSym "b")
assertParseString "{b,c?1}@a: c" $
Fix $ NAbs (FormalSet args (Just "a")) (mkSym "c")
Fix $ NAbs (fixed args (Just "a")) (mkSym "c")
assertParseString "{b,c?1,...}@a: c" $
Fix $ NAbs (FormalSet vargs (Just "a")) (mkSym "c")
Fix $ NAbs (variadic vargs (Just "a")) (mkSym "c")
assertParseString "{...}: 1" $
Fix $ NAbs (FormalSet (VariadicParamSet mempty) Nothing) (mkInt 1)
Fix $ NAbs (variadic mempty Nothing) (mkInt 1)
assertParseFail "a@b: a"
assertParseFail "{a}@{b}: a"
where
args = FixedParamSet $ Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
vargs = VariadicParamSet $ Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
args2 = FixedParamSet $ Map.fromList [("b", Just lam)]
lam = Fix $ NAbs (FormalName "x") (mkSym "x")
fixed args mname = ParamSet (FixedParamSet args) mname
variadic args mname = ParamSet (VariadicParamSet args) mname
args = Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
vargs = Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
args2 = Map.fromList [("b", Just lam)]
lam = Fix $ NAbs (Param "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)
lam = Fix (NAbs (Param "a") asym)
asym = mkSym "a"
case_simple_let :: Assertion
@ -214,7 +219,7 @@ case_identifier_special_chars = do
assertParseFail "'a"
makeStringParseTest :: String -> Assertion
makeStringParseTest str = assertParseString ("\"" ++ str ++ "\"") $ mkStr DoubleQuoted $ pack str
makeStringParseTest str = assertParseString ("\"" ++ str ++ "\"") $ mkStr $ pack str
case_simple_string :: Assertion
case_simple_string = mapM_ makeStringParseTest ["abcdef", "a", "A", " a a ", ""]
@ -224,18 +229,18 @@ 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 " \" ' "
assertParseString "\"\\$\\n\\t\\r\\\\\"" $ mkStr "$\n\t\r\\"
assertParseString "\" \\\" \\' \"" $ mkStr " \" ' "
case_string_antiquote :: Assertion
case_string_antiquote = do
assertParseString "\"abc${ if true then \"def\" else \"abc\" } g\"" $
Fix $ NStr $ NString DoubleQuoted
Fix $ NStr $ DoubleQuoted
[ Plain "abc"
, Antiquoted $ Fix $ NIf (mkBool True) (mkStr DoubleQuoted "def") (mkStr DoubleQuoted "abc")
, Antiquoted $ Fix $ NIf (mkBool True) (mkStr "def") (mkStr "abc")
, Plain " g"
]
assertParseString "\"\\${a}\"" $ mkStr DoubleQuoted "${a}"
assertParseString "\"\\${a}\"" $ mkStr "${a}"
assertParseFail "\"a"
assertParseFail "${true}"
assertParseFail "\"${true\""
@ -248,16 +253,16 @@ case_select = do
assertParseString "a.e . d or null" $ Fix $ NSelect (mkSym "a")
[ StaticKey "e", StaticKey "d" ]
(Just mkNull)
assertParseString "{}.\"\"or null" $ Fix $ NSelect (Fix (NSet NonRec []))
assertParseString "{}.\"\"or null" $ Fix $ NSelect (Fix (NSet []))
[ 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 (NSet [])) (mkPath False "./def")
assertParseString "{}.\"\"./def" $ Fix $ NApp
(Fix $ NSelect (Fix (NSet NonRec [])) [DynamicKey (Plain "")] Nothing)
(Fix $ NSelect (Fix (NSet [])) [DynamicKey (Plain "")] Nothing)
(mkPath False "./def")
where select = Fix $ NSelect (mkSym "f") (mkSelector "b") Nothing
@ -270,11 +275,11 @@ case_fun_app = do
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
assertParseString "''a''" $ mkIndentedStr "a"
assertParseString "''\n foo\n bar''" $ mkIndentedStr "foo\nbar"
assertParseString "'' ''" $ mkIndentedStr ""
assertParseString "'''''''" $ mkIndentedStr "''"
assertParseString "'' ${null}\n a${null}''" $ Fix $ NStr $ Indented
[ Antiquoted mkNull
, Plain "\na"
, Antiquoted mkNull
@ -285,7 +290,7 @@ case_indented_string = do
case_indented_string_escape :: Assertion
case_indented_string_escape = assertParseString
"'' ''\\n ''\\t ''\\\\ ''${ \\ \\n ' ''' ''" $
mkStr Indented "\n \t \\ ${ \\ \\n ' '' "
mkIndentedStr "\n \t \\ ${ \\ \\n ' '' "
case_operator_fun_app :: Assertion
case_operator_fun_app = do
@ -301,8 +306,8 @@ case_operators = do
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)])
(Fix $ NSet [NamedVar (mkSelector "a") (mkInt 3)])
(Fix $ NRecSet [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")) $