remove types for rec/nonrec, make unit tests pass
This commit is contained in:
Allen Nelson
parent
50a3d0d0db
commit
29acdfe988
100
Nix/Eval.hs
100
Nix/Eval.hs
|
|
@ -27,7 +27,7 @@ data NValueF m r
|
|||
| NVStr Text
|
||||
| NVList [r]
|
||||
| NVSet (Map.Map Text r)
|
||||
| NVFunction (Formals r) (NValue m -> m r)
|
||||
| NVFunction (Params r) (NValue m -> m r)
|
||||
deriving (Generic, Typeable, Functor)
|
||||
|
||||
instance Show f => Show (NValueF m f) where
|
||||
|
|
@ -51,20 +51,19 @@ valueText = cata phi where
|
|||
phi (NVSet _) = error "Cannot coerce a set to a string"
|
||||
phi (NVFunction _ _) = error "Cannot coerce a function to a string"
|
||||
|
||||
buildArgument :: Formals (NValue m) -> NValue m -> NValue m
|
||||
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
|
||||
FixedParamSet s Nothing -> lookupParamSet s
|
||||
FixedParamSet s (Just name) -> Map.insert name arg <$> lookupParamSet s
|
||||
VariadicParamSet _ _ ->
|
||||
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
|
||||
|
|
@ -75,41 +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 (NPath _ _) = error "Path expressions are not yet supported"
|
||||
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
|
||||
|
|
@ -135,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"
|
||||
|
|
@ -193,9 +192,12 @@ 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))] ->
|
||||
|
|
|
|||
227
Nix/Expr.hs
227
Nix/Expr.hs
|
|
@ -23,6 +23,58 @@ 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.
|
||||
|
|
@ -34,53 +86,57 @@ data NAtom
|
|||
| 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)
|
||||
|
||||
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.
|
||||
-- | 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)
|
||||
|
||||
-- | For functions which are called with a set as an argument.
|
||||
data FormalParamSet r
|
||||
= FixedParamSet (Map Text (Maybe r))
|
||||
-- ^ Parameters for a function that expects an attribute set. The values
|
||||
-- | @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@.
|
||||
| FixedParamSet (Map Text (Maybe r)) (Maybe Text)
|
||||
-- ^ Parameters for a function that expects an attribute set. The values
|
||||
-- are @Just@ if they specify a default argument. For a fixed set, no
|
||||
-- arguments beyond what is specified in the map may be given.
|
||||
| VariadicParamSet (Map Text (Maybe r))
|
||||
| VariadicParamSet (Map Text (Maybe r)) (Maybe Text)
|
||||
-- ^ Same as the 'FixedParamSet', but extra arguments are allowed.
|
||||
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
|
||||
-- ^ For functions with a single named argument, such as @x: x + 1@.
|
||||
| FormalSet (FormalParamSet r) (Maybe Text)
|
||||
-- ^ For functions that expect an attribute set argument, and unpack values
|
||||
-- from it. For example, @{x, y}: x + y@.
|
||||
deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show,
|
||||
Foldable, Traversable)
|
||||
|
||||
-- | For the two different kinds of strings.
|
||||
data StringKind = DoubleQuoted | Indented
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
-- | '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 = NString StringKind [Antiquoted Text r] | NUri Text
|
||||
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;
|
||||
-- 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
|
||||
|
|
@ -114,71 +170,11 @@ instance Functor NKeyName where
|
|||
-- of strung-together key names.
|
||||
type NAttrPath r = [NKeyName r]
|
||||
|
||||
-- | 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
|
||||
= NConstant NAtom
|
||||
-- ^ Constants: ints, bools, and null.
|
||||
| NStr (NString r)
|
||||
-- ^ A string, with interpolated expressions.
|
||||
| NList [r]
|
||||
-- ^ A list literal.
|
||||
| NSet NSetBind [Binding r]
|
||||
-- ^ An attribute set literal, possibly recursive.
|
||||
| NAbs (Formals r) r
|
||||
-- ^ A lambda abstraction.
|
||||
| NPath Bool FilePath
|
||||
-- ^ A path expression, which is evaluated to a store path. The boolean
|
||||
-- argument of 'NPath' is 'True' if the path refers to something 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@.
|
||||
| NOper (NOperF r)
|
||||
-- ^ Binary or unary operators.
|
||||
| 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.
|
||||
| NApp r r
|
||||
-- ^ Apply a function to an argument.
|
||||
| NSym Text
|
||||
-- ^ A variable. For example, in the expression @f a@, @f@ is represented
|
||||
-- as @NSym "f"@ and @a@ as @NSym "a"@.
|
||||
| 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)
|
||||
|
||||
type NExpr = Fix NExprF
|
||||
|
||||
-- | '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)
|
||||
|
||||
-- | For the the 'IsString' instance, we use a plain doublequoted string.
|
||||
instance IsString (NString r) where
|
||||
fromString "" = NString DoubleQuoted []
|
||||
fromString x = NString DoubleQuoted . (:[]) . Plain . pack $ x
|
||||
|
||||
-- | Operator expressions are unary or binary.
|
||||
data NOperF r
|
||||
= NUnary NUnaryOp r
|
||||
| NBinary NBinaryOp r r
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Functor, Show)
|
||||
|
||||
-- | 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 (!=)
|
||||
|
|
@ -197,19 +193,36 @@ data NBinaryOp
|
|||
| 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 (FixedParamSet _ n) = n
|
||||
paramName (VariadicParamSet _ n) = n
|
||||
|
||||
-- | Make an integer literal expression.
|
||||
mkInt :: Integer -> NExpr
|
||||
mkInt = Fix . NConstant . NInt
|
||||
|
||||
mkStr :: StringKind -> Text -> NExpr
|
||||
mkStr kind x = Fix . NStr . NString kind $ if x == ""
|
||||
then []
|
||||
else [Plain x]
|
||||
-- | 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 . NStr . NUri
|
||||
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 b = Fix . NPath b
|
||||
mkPath False = Fix . NLiteralPath
|
||||
mkPath True = Fix . NEnvPath
|
||||
|
||||
-- | Make a path expression which pulls from the NIX_PATH env variable.
|
||||
mkEnvPath :: FilePath -> NExpr
|
||||
|
|
@ -219,6 +232,7 @@ mkEnvPath = mkPath True
|
|||
mkRelPath :: FilePath -> NExpr
|
||||
mkRelPath = mkPath False
|
||||
|
||||
-- | Make a variable (symbol)
|
||||
mkSym :: Text -> NExpr
|
||||
mkSym = Fix . NSym
|
||||
|
||||
|
|
@ -232,28 +246,28 @@ mkNull :: NExpr
|
|||
mkNull = Fix (NConstant NNull)
|
||||
|
||||
mkOper :: NUnaryOp -> NExpr -> NExpr
|
||||
mkOper op = Fix . NOper . NUnary op
|
||||
mkOper op = Fix . NUnary op
|
||||
|
||||
mkOper2 :: NBinaryOp -> NExpr -> NExpr -> NExpr
|
||||
mkOper2 op a = Fix . NOper . NBinary op a
|
||||
mkOper2 op a = Fix . NBinary op a
|
||||
|
||||
mkFormalSet :: [(Text, Maybe NExpr)] -> Formals NExpr
|
||||
mkFormalSet = mkFixedParamSet
|
||||
mkParamset :: [(Text, Maybe NExpr)] -> Params NExpr
|
||||
mkParamset = mkFixedParamSet
|
||||
|
||||
mkFixedParamSet :: [(Text, Maybe NExpr)] -> Formals NExpr
|
||||
mkFixedParamSet ps = FormalSet (FixedParamSet $ Map.fromList ps) Nothing
|
||||
mkFixedParamSet :: [(Text, Maybe NExpr)] -> Params NExpr
|
||||
mkFixedParamSet ps = FixedParamSet (Map.fromList ps) Nothing
|
||||
|
||||
mkVariadicParamSet :: [(Text, Maybe NExpr)] -> Formals NExpr
|
||||
mkVariadicParamSet ps = FormalSet (VariadicParamSet $ Map.fromList ps) Nothing
|
||||
mkVariadicParamSet :: [(Text, Maybe NExpr)] -> Params NExpr
|
||||
mkVariadicParamSet ps = VariadicParamSet (Map.fromList ps) Nothing
|
||||
|
||||
mkApp :: NExpr -> NExpr -> NExpr
|
||||
mkApp e = Fix . NApp e
|
||||
|
||||
mkRecSet :: [Binding NExpr] -> NExpr
|
||||
mkRecSet = Fix . NSet Rec
|
||||
mkRecSet = Fix . NRecSet
|
||||
|
||||
mkNonRecSet :: [Binding NExpr] -> NExpr
|
||||
mkNonRecSet = Fix . NSet NonRec
|
||||
mkNonRecSet = Fix . NSet
|
||||
|
||||
mkLet :: [Binding NExpr] -> NExpr -> NExpr
|
||||
mkLet bs = Fix . NLet bs
|
||||
|
|
@ -270,7 +284,7 @@ mkAssert e = Fix . NWith e
|
|||
mkIf :: NExpr -> NExpr -> NExpr -> NExpr
|
||||
mkIf e1 e2 = Fix . NIf e1 e2
|
||||
|
||||
mkFunction :: Formals NExpr -> NExpr -> NExpr
|
||||
mkFunction :: Params NExpr -> NExpr -> NExpr
|
||||
mkFunction params = Fix . NAbs params
|
||||
|
||||
-- | Shorthand for producing a binding of a name to an expression.
|
||||
|
|
@ -283,7 +297,8 @@ bindTo name val = NamedVar (mkSelector name) val
|
|||
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)
|
||||
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.
|
||||
|
|
|
|||
|
|
@ -156,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"
|
||||
|
|
@ -184,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 $ 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 $ 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.
|
||||
|
|
@ -242,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
|
||||
|
|
|
|||
112
Nix/Pretty.hs
112
Nix/Pretty.hs
|
|
@ -56,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
|
||||
|
|
@ -72,22 +72,24 @@ 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
|
||||
Nothing -> empty
|
||||
Just name -> text "@" <> text (unpack name)
|
||||
|
||||
prettyParamSet :: FormalParamSet NixDoc -> Doc
|
||||
prettyParamSet params = lbrace <+> middle <+> rbrace
|
||||
where
|
||||
prettyArgs = case params of
|
||||
FixedParamSet args -> map prettySetArg (toList args)
|
||||
|
||||
VariadicParamSet args -> map prettySetArg (toList args) ++ [text "..."]
|
||||
middle = hcat $ punctuate (comma <> space) prettyArgs
|
||||
prettyParams :: Params NixDoc -> Doc
|
||||
prettyParams (Param n) = text $ unpack n
|
||||
prettyParams paramSet = prettyParamSet <> argName where
|
||||
prettyParamSet = lbrace <+> middle <+> rbrace
|
||||
middle = hcat $ punctuate (comma <> space) prettyArgs
|
||||
prettyArgs = case isVariadic of
|
||||
False -> map prettySetArg (toList args)
|
||||
True -> map prettySetArg (toList args) ++ [text "..."]
|
||||
(isVariadic, args) = case paramSet of
|
||||
VariadicParamSet args _ -> (True, args)
|
||||
FixedParamSet args _ -> (False, args)
|
||||
_ -> (False, mempty)
|
||||
prettySetArg (n, maybeDef) = case maybeDef of
|
||||
Nothing -> text (unpack n)
|
||||
Just v -> text (unpack n) <+> text "?" <+> withoutParens v
|
||||
argName = case paramName paramSet of
|
||||
Nothing -> empty
|
||||
Just name -> text "@" <> text (unpack name)
|
||||
|
||||
prettyBind :: Binding NixDoc -> Doc
|
||||
prettyBind (NamedVar n v) = prettySelector n <+> equals <+> withoutParens v <> semi
|
||||
|
|
@ -104,30 +106,12 @@ prettyKeyName (DynamicKey key) = runAntiquoted prettyString withoutParens key
|
|||
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 (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
|
||||
|
|
@ -140,12 +124,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
|
||||
|
|
@ -153,17 +152,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 (NPath isFromEnv p)
|
||||
| isFromEnv = simpleExpr $ text ("<" ++ p ++ ">")
|
||||
-- If it's not an absolute path, we need to prefix with ./
|
||||
| otherwise = simpleExpr $ text $ case p of
|
||||
"./" -> "./."
|
||||
"../" -> "../."
|
||||
".." -> "../."
|
||||
txt | "/" `isPrefixOf` txt -> txt
|
||||
| "./" `isPrefixOf` txt -> txt
|
||||
| "../" `isPrefixOf` txt -> txt
|
||||
| otherwise -> "./" ++ txt
|
||||
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
|
||||
|
|
@ -177,5 +174,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
|
||||
|
|
|
|||
|
|
@ -44,9 +44,9 @@ 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 [] = Indented []
|
||||
stripIndent xs =
|
||||
NString Indented . removePlainEmpty . mergePlain . unsplitLines $ ls'
|
||||
Indented . removePlainEmpty . mergePlain . unsplitLines $ ls'
|
||||
where
|
||||
ls = stripEmptyOpening $ splitLines xs
|
||||
ls' = map (dropSpaces minIndent) ls
|
||||
|
|
|
|||
|
|
@ -61,7 +61,7 @@ Library
|
|||
Build-depends: parsec
|
||||
else
|
||||
Build-depends: trifecta
|
||||
ghc-options: -Wall
|
||||
ghc-options: -Wall -fno-warn-name-shadowing
|
||||
|
||||
Executable hnix
|
||||
Default-language: Haskell2010
|
||||
|
|
|
|||
|
|
@ -60,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
|
||||
]
|
||||
|
|
@ -68,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; }"
|
||||
|
||||
|
|
@ -124,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))
|
||||
|
|
@ -135,43 +135,43 @@ 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 (FixedParamSet args Nothing) (mkSym "b")
|
||||
assertParseString "{ b ? x: x }: b" $
|
||||
Fix $ NAbs (FormalSet args2 Nothing) (mkSym "b")
|
||||
Fix $ NAbs (FixedParamSet args2 Nothing) (mkSym "b")
|
||||
assertParseString "a@{b,c ? 1}: b" $
|
||||
Fix $ NAbs (FormalSet args (Just "a")) (mkSym "b")
|
||||
Fix $ NAbs (FixedParamSet args (Just "a")) (mkSym "b")
|
||||
assertParseString "{b,c?1}@a: c" $
|
||||
Fix $ NAbs (FormalSet args (Just "a")) (mkSym "c")
|
||||
Fix $ NAbs (FixedParamSet args (Just "a")) (mkSym "c")
|
||||
assertParseString "{b,c?1,...}@a: c" $
|
||||
Fix $ NAbs (FormalSet vargs (Just "a")) (mkSym "c")
|
||||
Fix $ NAbs (VariadicParamSet vargs (Just "a")) (mkSym "c")
|
||||
assertParseString "{...}: 1" $
|
||||
Fix $ NAbs (FormalSet (VariadicParamSet mempty) Nothing) (mkInt 1)
|
||||
Fix $ NAbs (VariadicParamSet 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")
|
||||
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
|
||||
|
|
@ -217,7 +217,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 ", ""]
|
||||
|
|
@ -227,18 +227,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\""
|
||||
|
|
@ -251,16 +251,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
|
||||
|
||||
|
|
@ -273,11 +273,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
|
||||
|
|
@ -288,7 +288,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
|
||||
|
|
@ -304,8 +304,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")) $
|
||||
|
|
|
|||
Loading…
Reference in a new issue