hnix 0.2.1 → 0.3.2
raw patch · 15 files changed
+1176/−651 lines, 15 filesdep +deepseqdep +semigroupsdep ~base
Dependencies added: deepseq, semigroups
Dependency ranges changed: base
Files
- Nix/Atoms.hs +48/−0
- Nix/Eval.hs +139/−39
- Nix/Expr.hs +10/−0
- Nix/Expr/Shorthands.hs +225/−0
- Nix/Expr/Types.hs +217/−0
- Nix/Expr/Types/Annotated.hs +89/−0
- Nix/Parser.hs +131/−84
- Nix/Parser/Library.hs +13/−2
- Nix/Parser/Operators.hs +81/−0
- Nix/Pretty.hs +59/−40
- Nix/StringOperations.hs +87/−0
- Nix/Types.hs +0/−430
- hnix.cabal +13/−3
- tests/Main.hs +4/−0
- tests/ParserTests.hs +60/−53
+ Nix/Atoms.hs view
@@ -0,0 +1,48 @@+module Nix.Atoms where++import Prelude+import Data.Text (Text, pack)+import GHC.Generics+import Data.Data+import Data.HashMap.Strict (HashMap)++-- | 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)++class ToAtom t where+ toAtom :: t -> NAtom++instance ToAtom Bool where toAtom = NBool+instance ToAtom Int where toAtom = NInt . fromIntegral+instance ToAtom Integer where toAtom = NInt++class FromAtom t where+ fromAtom :: NAtom -> t+ fromAtoms :: [NAtom] -> t+ fromAtomSet :: HashMap Text NAtom -> t++-- | Convert a primitive into something which can be made from a+-- constant. So for example `convert 1 :: Expression`+convert :: (ToAtom prim, FromAtom t) => prim -> t+convert = fromAtom . toAtom++-- | Conversion to environment variables for constants.+atomToEnvString :: NAtom -> Text+atomToEnvString = \case+ NInt i -> pack $ show i+ NBool True -> "1"+ NBool False -> ""+ NNull -> ""+ NUri uri -> uri
Nix/Eval.hs view
@@ -1,63 +1,159 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecursiveDo #-} module Nix.Eval where import Control.Applicative import Control.Arrow import Control.Monad hiding (mapM, sequence)+import Control.Monad.Fix import Data.Fix import Data.Foldable (foldl') import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as Text import Data.Traversable as T-import Nix.Types+import Data.Typeable (Typeable)+import GHC.Generics+import Nix.Pretty (atomText)+import Nix.StringOperations (runAntiquoted)+import Nix.Atoms+import Nix.Expr import Prelude hiding (mapM, sequence) -buildArgument :: Formals NValue -> NValue -> NValue+-- | 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 :: NExpr -> NValue -> IO NValue+evalExpr :: MonadFix m => NExpr -> NValue m -> m (NValue m) evalExpr = cata phi where- phi :: NExprF (NValue -> IO NValue) -> NValue -> IO NValue phi (NSym var) = \env -> case env of Fix (NVSet s) -> maybe err return $ Map.lookup var s _ -> error "invalid evaluation environment" where err = error ("Undefined variable: " ++ show var) phi (NConstant x) = const $ return $ Fix $ NVConstant x phi (NStr str) = fmap (Fix . NVStr) . flip evalString str- phi (NOper _x) = error "Operators are not yet defined"- phi (NSelect _x _attr _or) = error "Select expressions are not yet supported"- phi (NHasAttr _x _attr) = error "Has attr expressions are not yet supported"+ phi (NLiteralPath _) = error "Path expressions are not yet supported"+ phi (NEnvPath _) = error "Path expressions are not yet supported" - phi (NList l) = \env ->+ 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+ aset' <- aset env+ ks <- evalSelector True env attr+ case extract aset' ks of+ Just v -> pure v+ Nothing -> case alternative of+ Just v -> v env+ Nothing -> error "could not look up attribute in value"+ extract (Fix (NVSet s)) (k:ks) = case Map.lookup k s of+ Just v -> extract v ks+ Nothing -> Nothing+ extract _ (_:_) = Nothing+ extract v [] = Just v++ phi (NHasAttr aset attr) = \env -> aset env >>= \case+ Fix (NVSet s) -> evalSelector True env attr >>= \case+ [keyName] -> pure $ Fix $ NVConstant $ NBool $ keyName `Map.member` s+ _ -> error "attribute name argument to hasAttr is not a single-part name"+ _ -> error "argument to hasAttr has wrong type"++ phi (NList l) = \env -> Fix . NVList <$> mapM ($ env) l - -- TODO: recursive sets- phi (NSet _b binds) = \env ->- Fix . NVSet <$> evalBinds True env binds+ phi (NSet binds) = \env -> Fix . NVSet <$> evalBinds True env binds - -- TODO: recursive binding+ phi (NRecSet binds) = \env -> case env of+ (Fix (NVSet env')) -> do+ rec+ mergedEnv <- pure $ Fix $ NVSet $ evaledBinds `Map.union` env'+ evaledBinds <- evalBinds True mergedEnv binds+ pure mergedEnv+ _ -> error "invalid evaluation environment"+ phi (NLet binds e) = \env -> case env of (Fix (NVSet env')) -> do- letenv <- evalBinds False env binds- let newenv = Map.union letenv env'- e . Fix . NVSet $ newenv+ rec+ mergedEnv <- pure $ Fix $ NVSet $ evaledBinds `Map.union` env'+ evaledBinds <- evalBinds True mergedEnv binds+ e mergedEnv _ -> error "invalid evaluation environment" - phi (NIf cond t f) = \env -> do+ phi (NIf cond t f) = \env -> do (Fix cval) <- cond env case cval of NVConstant (NBool True) -> t env@@ -88,29 +184,33 @@ f arg' _ -> error "Attempt to call non-function" - phi (NAbs a b) = \env -> do+ phi (NAbs a b) = \env -> do -- jww (2014-06-28): arglists should not receive the current -- environment, but rather should recursively view their own arg -- set args <- traverse ($ env) a return $ Fix $ NVFunction args b -evalString :: NValue -> NString (NValue -> IO NValue) -> IO Text-evalString env (NString _ parts)- = Text.concat <$> mapM (runAntiquoted return (fmap valueText . ($ env))) parts-evalString env (NUri t) = return t+evalString :: Monad m+ => NValue m -> NString (NValue m -> m (NValue m)) -> m Text+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 :: Bool -> NValue -> [Binding (NValue -> IO NValue)] ->- IO (Map.Map Text NValue)+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)] -> Map.Map Text NValue+ buildResult :: [([Text], NValue m)] -> Map.Map Text (NValue m) buildResult = foldl' insert Map.empty . map (first reverse) where insert _ ([], _) = error "invalid selector with no components" insert m (p:ps, v) = modifyPath ps (insertIfNotMember p v) where alreadyDefinedErr = error $ "attribute " ++ attr ++ " already defined" attr = show $ Text.intercalate "." $ reverse (p:ps) - modifyPath :: [Text] -> (Map.Map Text NValue -> Map.Map Text NValue) -> Map.Map Text NValue modifyPath [] f = f m modifyPath (x:parts) f = modifyPath parts $ \m' -> case Map.lookup x m' of Nothing -> Map.singleton x $ g Map.empty@@ -123,12 +223,12 @@ | otherwise = alreadyDefinedErr -- TODO: Inherit- go :: Binding (NValue -> IO NValue) -> [IO ([Text], NValue)] go (NamedVar x y) = [liftM2 (,) (evalSelector allowDynamic env x) (y env)]+ go _ = [] -- HACK! But who cares right now - evalSelector :: Bool -> NValue -> NSelector (NValue -> IO NValue) -> IO [Text]- evalSelector dyn e = mapM evalKeyName where- evalKeyName (StaticKey k) = return k- evalKeyName (DynamicKey k)- | dyn = runAntiquoted (evalString e) (fmap valueText . ($ e)) k- | otherwise = error "dynamic attribute not allowed in this context"+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)+ | dyn = runAntiquoted (evalString env) (fmap valueText . ($ env)) k+ | otherwise = error "dynamic attribute not allowed in this context"
+ Nix/Expr.hs view
@@ -0,0 +1,10 @@+-- | Wraps the expression submodules.+module Nix.Expr (+ module Nix.Expr.Types,+ module Nix.Expr.Types.Annotated,+ module Nix.Expr.Shorthands+ ) where++import Nix.Expr.Types+import Nix.Expr.Shorthands+import Nix.Expr.Types.Annotated
+ Nix/Expr/Shorthands.hs view
@@ -0,0 +1,225 @@+-- | A bunch of shorthands for making nix expressions.+--+-- Functions with an @F@ suffix return a more general type without the outer+-- 'Fix' wrapper.+module Nix.Expr.Shorthands where++import Prelude+import Data.Monoid+import Data.Text (Text)+import Data.Fix+import qualified Data.Map as Map+import Nix.Atoms+import Nix.Expr.Types++-- | Make an integer literal expression.+mkInt :: Integer -> NExpr+mkInt = Fix . mkIntF++mkIntF :: Integer -> NExprF a+mkIntF = NConstant . NInt++-- | Make a regular (double-quoted) string.+mkStr :: Text -> NExpr+mkStr = Fix . NStr . DoubleQuoted . \case+ "" -> []+ x -> [Plain x]++-- | Make an indented string.+mkIndentedStr :: Text -> NExpr+mkIndentedStr = Fix . NStr . Indented . \case+ "" -> []+ x -> [Plain x]++-- | Make a literal URI expression.+mkUri :: Text -> NExpr+mkUri = Fix . mkUriF++mkUriF :: Text -> NExprF a+mkUriF = 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 . mkPathF b++mkPathF :: Bool -> FilePath -> NExprF a+mkPathF False = NLiteralPath+mkPathF True = NEnvPath++-- | Make a path expression which pulls from the NIX_PATH env variable.+mkEnvPath :: FilePath -> NExpr+mkEnvPath = Fix . mkEnvPathF++mkEnvPathF :: FilePath -> NExprF a+mkEnvPathF = mkPathF True++-- | Make a path expression which references a relative path.+mkRelPath :: FilePath -> NExpr+mkRelPath = Fix . mkRelPathF++mkRelPathF :: FilePath -> NExprF a+mkRelPathF = mkPathF False++-- | Make a variable (symbol)+mkSym :: Text -> NExpr+mkSym = Fix . mkSymF++mkSymF :: Text -> NExprF a+mkSymF = NSym++mkSelector :: Text -> NAttrPath NExpr+mkSelector = (:[]) . StaticKey++mkBool :: Bool -> NExpr+mkBool = Fix . mkBoolF++mkBoolF :: Bool -> NExprF a+mkBoolF = NConstant . NBool++mkNull :: NExpr+mkNull = Fix mkNullF++mkNullF :: NExprF a+mkNullF = 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++mkLets :: [Binding NExpr] -> NExpr -> NExpr+mkLets bindings = Fix . NLet bindings++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++mkDot :: NExpr -> Text -> NExpr+mkDot e key = Fix $ NSelect e [StaticKey key] Nothing++mkDots :: NExpr -> [Text] -> NExpr+mkDots e keys = Fix $ NSelect e (StaticKey <$> keys) Nothing++-- | An `inherit` clause without an expression to pull from.+inherit :: [NKeyName e] -> Binding e+inherit = Inherit Nothing++-- | An `inherit` clause with an expression to pull from.+inheritFrom :: e -> [NKeyName e] -> Binding e+inheritFrom expr = Inherit (Just expr)++-- | Shorthand for producing a binding of a name to an expression.+bindTo :: Text -> NExpr -> Binding NExpr+bindTo name val = NamedVar (mkSelector name) val++-- | Infix version of bindTo.+($=) :: Text -> NExpr -> Binding NExpr+name $= value = bindTo name value++infixr 2 $=++-- | 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"++-- | A let statement with multiple assignments.+letsE :: [(Text, NExpr)] -> NExpr -> NExpr+letsE pairs = Fix . NLet (map (uncurry bindTo) pairs)++-- | Wrapper for a single-variable @let@.+letE :: Text -> NExpr -> NExpr -> NExpr+letE varName varExpr = letsE [(varName, varExpr)]++-- | Make an attribute set (non-recursive).+attrsE :: [(Text, NExpr)] -> NExpr+attrsE pairs = Fix $ NSet (map (uncurry bindTo) pairs)++-- | Make an attribute set (recursive).+recAttrsE :: [(Text, NExpr)] -> NExpr+recAttrsE pairs = Fix $ NRecSet (map (uncurry bindTo) pairs)++-- | Logical negation.+mkNot :: NExpr -> NExpr+mkNot = Fix . NUnary NNot++-- | Dot-reference into an attribute set.+(!.) :: NExpr -> Text -> NExpr+(!.) = mkDot+infixl 8 !.++mkBinop :: NBinaryOp -> NExpr -> NExpr -> NExpr+mkBinop op e1 e2 = Fix (NBinary op e1 e2)++-- | Various nix binary operators+($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->),+ ($//), ($+), ($-), ($*), ($/), ($++)+ :: NExpr -> NExpr -> NExpr+e1 $== e2 = mkBinop NEq e1 e2+e1 $!= e2 = mkBinop NNEq e1 e2+e1 $< e2 = mkBinop NLt e1 e2+e1 $<= e2 = mkBinop NLte e1 e2+e1 $> e2 = mkBinop NGt e1 e2+e1 $>= e2 = mkBinop NGte e1 e2+e1 $&& e2 = mkBinop NAnd e1 e2+e1 $|| e2 = mkBinop NOr e1 e2+e1 $-> e2 = mkBinop NImpl e1 e2+e1 $// e2 = mkBinop NUpdate e1 e2+e1 $+ e2 = mkBinop NPlus e1 e2+e1 $- e2 = mkBinop NMinus e1 e2+e1 $* e2 = mkBinop NMult e1 e2+e1 $/ e2 = mkBinop NDiv e1 e2+e1 $++ e2 = mkBinop NConcat e1 e2++-- | Function application expression.+(@@) :: NExpr -> NExpr -> NExpr+(@@) = mkApp+infixl 1 @@++-- | Lambda shorthand.+(==>) :: Params NExpr -> NExpr -> NExpr+(==>) = mkFunction++infixr 1 ==>
+ Nix/Expr/Types.hs view
@@ -0,0 +1,217 @@+{-# 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.Types where++import Control.Monad hiding (forM_, mapM, sequence)+import Data.Data+import Data.Fix+import Data.Foldable+import Data.Functor.Classes (Show1(..))+import Data.Map (Map)+import Data.Text (Text, pack)+import Data.Traversable+import GHC.Exts+import GHC.Generics+import Nix.Atoms+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, Foldable, Traversable, Show)++instance Show1 NExprF where+ showsPrec1 = showsPrec++-- | We make an `IsString` for expressions, where the string is interpreted+-- as an identifier. This is the most common use-case...+instance IsString NExpr where+ fromString = Fix . NSym . fromString++-- | The monomorphic expression type is a fixed point of the polymorphic one.+type NExpr = Fix NExprF++-- | 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) ![NKeyName 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, Foldable, Traversable, 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)++instance IsString (Params r) where+ fromString = Param . fromString++-- | 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, Foldable, Traversable, 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, Foldable, Traversable, 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)++-- | Most key names are just static text, so this instance is convenient.+instance IsString (NKeyName r) where+ fromString = StaticKey . fromString++-- | 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 = fmapDefault++-- Deriving this instance automatically is not possible because @r@+-- occurs not only as last argument in @Antiquoted (NString r) r@+instance Foldable NKeyName where+ foldMap = foldMapDefault++-- Deriving this instance automatically is not possible because @r@+-- occurs not only as last argument in @Antiquoted (NString r) r@+instance Traversable NKeyName where+ traverse f = \case+ DynamicKey (Plain str) -> DynamicKey . Plain <$> traverse f str+ DynamicKey (Antiquoted e) -> DynamicKey . Antiquoted <$> f e+ StaticKey key -> pure (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
+ Nix/Expr/Types/Annotated.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+-- | The source location annotated nix expression type and supporting types.+--+module Nix.Expr.Types.Annotated+ ( module Nix.Expr.Types.Annotated+ , Delta(..)+ )where++import Control.Monad hiding (forM_, mapM, sequence)+import Data.Data+import Data.Fix+import Data.Function (on)+import Data.Functor.Classes (Show1(..))+import Data.Functor.Compose+import Data.Semigroup+import GHC.Generics+import Nix.Expr.Types+import Nix.Parser.Library (Delta(..))+import Prelude hiding (concat, concatMap, elem, foldr,+ mapM, minimum, readFile, sequence)++-- | A location in a source file+data SrcSpan = SrcSpan{ spanBegin :: Delta+ , spanEnd :: Delta+ }+ deriving (Ord, Eq, Generic, Typeable, Data, Show)++-- | A type constructor applied to a type along with an annotation+--+-- Intended to be used with 'Fix':+-- @type MyType = Fix (Compose (Ann Annotation) F)@+data Ann ann a = Ann{ annotation :: ann+ , annotated :: a+ }+ deriving (Ord, Eq, Data, Generic, Typeable, Functor, Foldable, Traversable, Read, Show)++instance Show ann => Show1 (Ann ann) where+ showsPrec1 = showsPrec++instance Semigroup SrcSpan where+ s1 <> s2 = SrcSpan ((min `on` spanBegin) s1 s2)+ ((max `on` spanEnd) s1 s2)++type AnnF ann f = Compose (Ann ann) f++annToAnnF :: Ann ann (f (Fix (AnnF ann f))) -> Fix (AnnF ann f)+annToAnnF (Ann ann a) = AnnE ann a++type NExprLocF = AnnF SrcSpan NExprF++-- | A nix expression with source location at each subexpression.+type NExprLoc = Fix NExprLocF++pattern AnnE ann a = Fix (Compose (Ann ann a))++stripAnnotation :: Functor f => Fix (AnnF ann f) -> Fix f+stripAnnotation = ana (annotated . getCompose . unFix)++nApp :: NExprLoc -> NExprLoc -> NExprLoc+nApp e1@(AnnE s1 _) e2@(AnnE s2 _) = AnnE (s1 <> s2) (NApp e1 e2)++nUnary :: Ann SrcSpan NUnaryOp -> NExprLoc -> NExprLoc+nUnary (Ann s1 u) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NUnary u e1)++nBinary :: Ann SrcSpan NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc+nBinary (Ann s1 b) e1@(AnnE s2 _) e2@(AnnE s3 _) =+ AnnE (s1 <> s2 <> s3) (NBinary b e1 e2)++nSelectLoc :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc -> NExprLoc+nSelectLoc e1@(AnnE s1 _) (Ann s2 ats) d = case d of+ Nothing -> AnnE (s1 <> s2) (NSelect e1 ats Nothing)+ Just (e2@(AnnE s3 _)) -> AnnE (s1 <> s2 <> s3) (NSelect e1 ats (Just e2))++nHasAttr :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc+nHasAttr e1@(AnnE s1 _) (Ann s2 ats) = AnnE (s1 <> s2) (NHasAttr e1 ats)++nAbs :: Ann SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc+nAbs (Ann s1 ps) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NAbs ps e1)++nStr :: Ann SrcSpan (NString NExprLoc) -> NExprLoc+nStr (Ann s1 s) = AnnE s1 (NStr s)
Nix/Parser.hs view
@@ -1,89 +1,121 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -module Nix.Parser (parseNixFile, parseNixString, Result(..)) where+module Nix.Parser (+ parseNixFile,+ parseNixFileLoc,+ parseNixString,+ parseNixStringLoc,+ parseNixText,+ parseNixTextLoc,+ Result(..)+ ) where import Control.Applicative import Control.Monad import Control.Monad.IO.Class-import Data.Fix import Data.Foldable hiding (concat) import qualified Data.Map as Map import Data.Text hiding (head, map, foldl1', foldl', concat) import Nix.Parser.Library-import Nix.Types+import Nix.Parser.Operators+import Nix.Expr+import Nix.StringOperations import Prelude hiding (elem) --- | The lexer for this parser is defined in 'Nix.Parser.Library'.+--------------------------------------------------------------------------------++annotateLocation :: Parser a -> Parser (Ann SrcSpan a)+annotateLocation p = do+ begin <- position+ res <- p+ end <- position+ let span = SrcSpan begin end+ pure $ Ann span res++annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc+annotateLocation1 = fmap annToAnnF . annotateLocation++--------------------------------------------------------------------------------+ nixExpr :: Parser NExpr-nixExpr = whiteSpace *> (nixToplevelForm <|> foldl' makeParser nixTerm nixOperators)+nixExpr = stripAnnotation <$> nixExprLoc++-- | The lexer for this parser is defined in 'Nix.Parser.Library'.+nixExprLoc :: Parser NExprLoc+nixExprLoc = whiteSpace *> (nixToplevelForm <|> foldl' makeParser nixTerm nixOperators) where+ makeParser :: Parser NExprLoc -> Either NSpecialOp NOperatorDef -> Parser NExprLoc makeParser term (Left NSelectOp) = nixSelect term- makeParser term (Left NAppOp) = chainl1 term $ pure $ \a b -> Fix (NApp a b)+ makeParser term (Left NAppOp) = chainl1 term $ pure $ \a b -> (nApp a b) makeParser term (Left NHasAttrOp) = nixHasAttr term makeParser term (Right (NUnaryDef name op))- = build <$> many (void $ symbol name) <*> term- where build = flip $ foldl' (\t' () -> mkOper op t')+ = build <$> many (annotateLocation (void $ symbol name)) <*> term+ where build :: [Ann SrcSpan ()] -> NExprLoc -> NExprLoc+ build = flip $ foldl' (\t' (Ann s ()) -> nUnary (Ann s op) t') makeParser term (Right (NBinaryDef assoc ops)) = case assoc of NAssocLeft -> chainl1 term op NAssocRight -> chainr1 term op NAssocNone -> term <**> (flip <$> op <*> term <|> pure id)- where op = choice . map (\(n,o) -> mkOper2 o <$ reservedOp n) $ ops+ where op :: Parser (NExprLoc -> NExprLoc -> NExprLoc)+ op = choice . map (\(n,o) -> (\(Ann a ()) -> nBinary (Ann a o)) <$> annotateLocation (reservedOp n)) $ ops antiStart :: Parser String antiStart = try (string "${") <?> show ("${" :: String) -nixAntiquoted :: Parser a -> Parser (Antiquoted a NExpr)-nixAntiquoted p = Antiquoted <$> (antiStart *> nixExpr <* symbolic '}') <|> Plain <$> p+nixAntiquoted :: Parser a -> Parser (Antiquoted a NExprLoc)+nixAntiquoted p = Antiquoted <$> (antiStart *> nixExprLoc <* symbolic '}') <|> Plain <$> p selDot :: Parser () selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath)) *> whiteSpace <?> "." -nixSelector :: Parser (NSelector NExpr)-nixSelector = keyName `sepBy1` selDot where+nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))+nixSelector = annotateLocation $ keyName `sepBy1` selDot -nixSelect :: Parser NExpr -> Parser NExpr+nixSelect :: Parser NExprLoc -> Parser NExprLoc nixSelect term = build <$> term- <*> optional ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixExpr))+ <*> optional ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixExprLoc)) where+ build :: NExprLoc -> Maybe (Ann SrcSpan (NAttrPath NExprLoc), Maybe NExprLoc) -> NExprLoc build t Nothing = t- build t (Just (s,o)) = Fix $ NSelect t s o+ build t (Just (s,o)) = nSelectLoc t s o -nixHasAttr :: Parser NExpr -> Parser NExpr+nixHasAttr :: Parser NExprLoc -> Parser NExprLoc nixHasAttr term = build <$> term <*> optional (reservedOp "?" *> nixSelector) where+ build :: NExprLoc -> Maybe (Ann SrcSpan (NAttrPath NExprLoc)) -> NExprLoc build t Nothing = t- build t (Just s) = Fix $ NHasAttr t s+ build t (Just s) = nHasAttr t s -- | A self-contained unit.-nixTerm :: Parser NExpr+nixTerm :: Parser NExprLoc nixTerm = nixSelect $ choice [ nixInt, nixBool, nixNull, nixParens, nixList, nixPath, nixSPath, nixUri , nixStringExpr, nixSet, nixSym ] -nixToplevelForm :: Parser NExpr+nixToplevelForm :: Parser NExprLoc nixToplevelForm = choice [nixLambda, nixLet, nixIf, nixAssert, nixWith] -nixSym :: Parser NExpr-nixSym = mkSym <$> identifier+nixSym :: Parser NExprLoc+nixSym = annotateLocation1 $ mkSymF <$> identifier -nixInt :: Parser NExpr-nixInt = mkInt <$> token decimal <?> "integer"+nixInt :: Parser NExprLoc+nixInt = annotateLocation1 $ mkIntF <$> token decimal <?> "integer" -nixBool :: Parser NExpr-nixBool = try (true <|> false) <?> "bool" where- true = mkBool True <$ symbol "true"- false = mkBool False <$ symbol "false"+nixBool :: Parser NExprLoc+nixBool = annotateLocation1 $ try (true <|> false) <?> "bool" where+ true = mkBoolF True <$ symbol "true"+ false = mkBoolF False <$ symbol "false" -nixNull :: Parser NExpr-nixNull = mkNull <$ try (symbol "null") <?> "null"+nixNull :: Parser NExprLoc+nixNull = annotateLocation1 $ mkNullF <$ try (symbol "null") <?> "null" -nixParens :: Parser NExpr-nixParens = parens nixExpr <?> "parens"+nixParens :: Parser NExprLoc+nixParens = parens nixExprLoc <?> "parens" -nixList :: Parser NExpr-nixList = brackets (Fix . NList <$> many nixTerm) <?> "list"+nixList :: Parser NExprLoc+nixList = annotateLocation1 $ brackets (NList <$> many nixTerm) <?> "list" pathChars :: String pathChars = ['A'..'Z'] ++ ['a'..'z'] ++ "._-+" ++ ['0'..'9']@@ -93,12 +125,12 @@ -- | A path surrounded by angle brackets, indicating that it should be -- looked up in the NIX_PATH environment variable at evaluation.-nixSPath :: Parser NExpr-nixSPath = mkPath True <$> try (char '<' *> some (oneOf pathChars <|> slash) <* symbolic '>')+nixSPath :: Parser NExprLoc+nixSPath = annotateLocation1 $ mkPathF True <$> try (char '<' *> some (oneOf pathChars <|> slash) <* symbolic '>') <?> "spath" -nixPath :: Parser NExpr-nixPath = token $ fmap (mkPath False) $ ((++)+nixPath :: Parser NExprLoc+nixPath = annotateLocation1 $ token $ fmap (mkPathF False) $ ((++) <$> (try ((++) <$> many (oneOf pathChars) <*> fmap (:[]) slash) <?> "path") <*> fmap concat ( some (some (oneOf pathChars)@@ -107,49 +139,50 @@ ) <?> "path" -nixLet :: Parser NExpr-nixLet = fmap Fix $ NLet+nixLet :: Parser NExprLoc+nixLet = annotateLocation1 $ NLet <$> (reserved "let" *> nixBinders)- <*> (whiteSpace *> reserved "in" *> nixExpr)+ <*> (whiteSpace *> reserved "in" *> nixExprLoc) <?> "let" -nixIf :: Parser NExpr-nixIf = fmap Fix $ NIf- <$> (reserved "if" *> nixExpr)- <*> (whiteSpace *> reserved "then" *> nixExpr)- <*> (whiteSpace *> reserved "else" *> nixExpr)+nixIf :: Parser NExprLoc+nixIf = annotateLocation1 $ NIf+ <$> (reserved "if" *> nixExprLoc)+ <*> (whiteSpace *> reserved "then" *> nixExprLoc)+ <*> (whiteSpace *> reserved "else" *> nixExprLoc) <?> "if" -nixAssert :: Parser NExpr-nixAssert = fmap Fix $ NAssert- <$> (reserved "assert" *> nixExpr)- <*> (semi *> nixExpr)+nixAssert :: Parser NExprLoc+nixAssert = annotateLocation1 $ NAssert+ <$> (reserved "assert" *> nixExprLoc)+ <*> (semi *> nixExprLoc) -nixWith :: Parser NExpr-nixWith = fmap Fix $ NWith- <$> (reserved "with" *> nixExpr)- <*> (semi *> nixExpr)+nixWith :: Parser NExprLoc+nixWith = annotateLocation1 $ NWith+ <$> (reserved "with" *> nixExprLoc)+ <*> (semi *> nixExprLoc) -nixLambda :: Parser NExpr-nixLambda = Fix <$> (NAbs <$> (try argExpr <?> "lambda arguments") <*> nixExpr) <?> "lambda"+nixLambda :: Parser NExprLoc+nixLambda = (nAbs <$> annotateLocation (try argExpr <?> "lambda arguments") <*> nixExprLoc) <?> "lambda" -nixStringExpr :: Parser NExpr-nixStringExpr = Fix . NStr <$> nixString+nixStringExpr :: Parser NExprLoc+nixStringExpr = nStr <$> annotateLocation nixString uriAfterColonC :: Parser Char uriAfterColonC = alphaNum <|> oneOf "%/?:@&=+$,-_.!~*'" -nixUri :: Parser NExpr-nixUri = token $ fmap (mkUri . pack) $ (++)+nixUri :: Parser NExprLoc+nixUri = annotateLocation1 $ token $ fmap (mkUriF . pack) $ (++) <$> try ((++) <$> (scheme <* char ':') <*> fmap (\x -> [':',x]) uriAfterColonC) <*> many uriAfterColonC where scheme = (:) <$> letter <*> many (alphaNum <|> oneOf "+-.") -nixString :: Parser (NString NExpr)+nixString :: Parser (NString NExprLoc) nixString = doubleQuoted <|> indented <?> "string" where- doubleQuoted = NString DoubleQuoted . removePlainEmpty . mergePlain+ doubleQuoted :: Parser (NString NExprLoc)+ doubleQuoted = DoubleQuoted . removePlainEmpty . mergePlain <$> (doubleQ *> many (stringChar doubleQ (void $ char '\\') doubleEscape) <* token doubleQ) <?> "double quoted string"@@ -157,6 +190,7 @@ doubleQ = void $ char '"' doubleEscape = Plain . singleton <$> (char '\\' *> escapeCode) + indented :: Parser (NString NExprLoc) indented = stripIndent <$> (indentedQ *> many (stringChar indentedQ indentedQ indentedEscape) <* token indentedQ)@@ -169,7 +203,7 @@ stringChar end escStart esc = esc- <|> Antiquoted <$> (antiStart *> nixExpr <* char '}') -- don't skip trailing space+ <|> Antiquoted <$> (antiStart *> nixExprLoc <* char '}') -- don't skip trailing space <|> Plain . singleton <$> char '$' <|> Plain . pack <$> some plainChar where plainChar = notFollowedBy (end <|> void (char '$') <|> escStart) *> anyChar@@ -177,70 +211,83 @@ escapeCode = choice [ c <$ char e | (c,e) <- escapeCodes ] <|> anyChar -- | Gets all of the arguments for a function.-argExpr :: Parser (Formals NExpr)+argExpr :: Parser (Params NExprLoc) 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.- getParams :: Parser ([(Text, Maybe NExpr)], Bool)+ getParams :: Parser ([(Text, Maybe NExprLoc)], Bool) getParams = go [] where -- Attempt to parse `...`. If this succeeds, stop and return True. -- Otherwise, attempt to parse an argument, optionally with a -- default. If this fails, then return what has been accumulated -- so far. go acc = (token (string "...") >> return (acc, True)) <|> getMore acc- getMore acc = do+ getMore acc = -- Could be nothing, in which just return what we have so far. option (acc, False) $ do -- Get an argument name and an optional default.- pair <- liftA2 (,) identifier (optional $ symbolic '?' *> nixExpr)+ pair <- liftA2 (,) identifier (optional $ symbolic '?' *> nixExprLoc) -- Either return this, or attempt to get a comma and restart. option (acc ++ [pair], False) $ symbolic ',' >> go (acc ++ [pair]) -nixBinders :: Parser [Binding NExpr]+nixBinders :: Parser [Binding NExprLoc] nixBinders = (inherit <|> namedVar) `endBy` symbolic ';' where- inherit = Inherit <$> (reserved "inherit" *> optional scope) <*> many ((:[]) <$> keyName)- <?> "inherited binding"- namedVar = NamedVar <$> nixSelector <*> (symbolic '=' *> nixExpr)+ inherit = Inherit <$> (reserved "inherit" *> optional scope)+ <*> many keyName+ <?> "inherited binding"+ namedVar = NamedVar <$> (annotated <$> nixSelector) <*> (symbolic '=' *> nixExprLoc) <?> "variable binding"- scope = parens nixExpr <?> "inherit scope"+ scope = parens nixExprLoc <?> "inherit scope" -keyName :: Parser (NKeyName NExpr)+keyName :: Parser (NKeyName NExprLoc) keyName = dynamicKey <|> staticKey where staticKey = StaticKey <$> identifier dynamicKey = DynamicKey <$> nixAntiquoted nixString -nixSet :: Parser NExpr-nixSet = Fix <$> (NSet <$> isRec <*> braces nixBinders) <?> "set" where- isRec = (try (reserved "rec" *> pure Rec) <?> "recursive set")- <|> pure NonRec+nixSet :: Parser NExprLoc+nixSet = annotateLocation1 $ (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 +parseNixFileLoc :: MonadIO m => FilePath -> m (Result NExprLoc)+parseNixFileLoc = parseFromFileEx $ nixExprLoc <* eof+ parseNixString :: String -> Result NExpr parseNixString = parseFromString $ nixExpr <* eof++parseNixStringLoc :: String -> Result NExprLoc+parseNixStringLoc = parseFromString $ nixExprLoc <* eof++parseNixText :: Text -> Result NExpr+parseNixText = parseNixString . unpack++parseNixTextLoc :: Text -> Result NExprLoc+parseNixTextLoc = parseNixStringLoc . unpack
Nix/Parser/Library.hs view
@@ -1,8 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}-module Nix.Parser.Library ( module Nix.Parser.Library, module X) where+module Nix.Parser.Library+ ( module Nix.Parser.Library+ , module X+ , Trifecta.Delta(..)+ ) where +import Prelude import Control.Applicative import Control.Monad import Control.Monad.IO.Class@@ -30,7 +35,7 @@ #endif newtype NixParser p a = NixParser { runNixParser :: p a }- deriving (Functor, Applicative, Alternative, Monad, MonadPlus, Parsing, CharParsing, LookAheadParsing)+ deriving (Functor, Applicative, Alternative, Monad, MonadPlus, Parsing, CharParsing, LookAheadParsing, Trifecta.DeltaParsing) instance TokenParsing p => TokenParsing (NixParser p) where someSpace = NixParser $ buildSomeSpaceParser someSpace commentStyle@@ -103,6 +108,7 @@ -------------------------------------------------------------------------------- parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a) parseFromString :: Parser a -> String -> Result a+position :: Parser Trifecta.Delta #if USE_PARSEC data Result a = Success a@@ -117,6 +123,8 @@ parseFromString p = either (Failure . text . show) Success . Parsec.parse (runNixParser p) "<string>" . pack +position = error "position not implemented for Parsec parser"+ #else type Parser = NixParser Trifecta.Parser@@ -124,4 +132,7 @@ parseFromFileEx p = Trifecta.parseFromFileEx (runNixParser p) parseFromString p = Trifecta.parseString (runNixParser p) (Trifecta.Directed "<string>" 0 0 0 0)++position = Trifecta.position+ #endif
+ Nix/Parser/Operators.hs view
@@ -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 " "
Nix/Pretty.hs view
@@ -5,11 +5,17 @@ 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.Atoms+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+import qualified Data.HashSet as HashSet -- | This type represents a pretty printed nix expression -- together with some information about the expression.@@ -51,12 +57,12 @@ | 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 '"' = "\\\"" 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@@ -67,54 +73,45 @@ 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 FixedParamSet args -> map prettySetArg (toList args)- + 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 prettyBind (Inherit s ns)- = text "inherit" <+> scope <> fillSep (map prettySelector ns) <> semi+ = text "inherit" <+> scope <> fillSep (map prettyKeyName ns) <> semi where scope = maybe empty ((<> space) . parens . withoutParens) s prettyKeyName :: NKeyName NixDoc -> Doc+prettyKeyName (StaticKey key)+ | HashSet.member (unpack key) reservedNames = dquotes $ text $ unpack 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@@ -127,12 +124,27 @@ 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) </> 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@@ -140,7 +152,15 @@ = 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@@ -154,5 +174,4 @@ phi (NAssert cond body) = leastPrecedence $ text "assert" <+> withoutParens cond <> semi <+> withoutParens body - recPrefix Rec = text "rec" <> space- recPrefix NonRec = empty+ recPrefix = text "rec" <> space
+ Nix/StringOperations.hs view
@@ -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)
− Nix/Types.hs
@@ -1,430 +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 s p)- | s = pack ("<" ++ p ++ ">")- | otherwise = pack p---- | 'Antiquoted' represents an expression that is either--- antiquoted (surrounded by ${...}) or plain (not antiquoted).-data Antiquoted v r = Plain v | Antiquoted r- deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show)---- | Merge adjacent 'Plain' values with 'mappend'.-mergePlain :: Monoid v => [Antiquoted v r] -> [Antiquoted v r]-mergePlain [] = []-mergePlain (Plain a: Plain b: xs) = mergePlain (Plain (a <> b) : xs)-mergePlain (x:xs) = x : mergePlain xs---- | Remove 'Plain' values equal to 'mempty'.-removePlainEmpty :: (Eq v, Monoid v) => [Antiquoted v r] -> [Antiquoted v r]-removePlainEmpty = filter f where- f (Plain x) = x /= mempty- f _ = True--runAntiquoted :: (v -> a) -> (r -> a) -> Antiquoted v r -> a-runAntiquoted f _ (Plain v) = f v-runAntiquoted _ f (Antiquoted r) = f r--data StringKind = DoubleQuoted | Indented- deriving (Eq, Ord, Generic, Typeable, Data, Show)---- | A 'NixString' is a list of things that are either a plain string--- or an antiquoted expression. After the antiquotes have been evaluated,--- the final string is constructed by concating all the parts.-data NString r = NString StringKind [Antiquoted Text r] | NUri Text- deriving (Eq, Ord, Generic, Typeable, Data, Functor, Show)---- | Split a stream representing a string with antiquotes on line breaks.-splitLines :: [Antiquoted Text r] -> [[Antiquoted Text r]]-splitLines = uncurry (flip (:)) . go where- go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls where- (l : ls) = T.split (=='\n') t- f prefix (finished, current) = ((Plain prefix : current) : finished, [])- go (Antiquoted a : xs) = (Antiquoted a :) <$> go xs- go [] = ([],[])---- | Join a stream of strings containing antiquotes again. This is the inverse--- of 'splitLines'.-unsplitLines :: [[Antiquoted Text r]] -> [Antiquoted Text r]-unsplitLines = intercalate [Plain "\n"]---- | Form an indented string by stripping spaces equal to the minimal indent.-stripIndent :: [Antiquoted Text r] -> NString r-stripIndent [] = NString Indented []-stripIndent xs = NString Indented . removePlainEmpty . mergePlain . unsplitLines $ ls'- where- ls = stripEmptyOpening $ splitLines xs- ls' = map (dropSpaces minIndent) ls-- minIndent = 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 at the right side of an equals sign.--- For example, @a@ is a 'KeyName' in @{ a = 3; }@, @let a = 3; in ...@, @{}.a@ or @{} ? a@.------ Nix supports both static keynames (just an identifier) and dynamic identifiers.--- Dynamic identifiers can be either a string (e.g.: @{ "a" = 3; }@) or an antiquotation--- (e.g.: @let a = "example"; in { ${a} = 3; }.example@).------ Note: There are some places where a dynamic keyname is not allowed. In particular, those include:------ * the RHS of a @binding@ inside @let@: @let ${"a"} = 3; in ...@ produces a syntax error.--- * the attribute names of an 'inherit': @inherit ${"a"};@ is forbidden.------ Note: In Nix, a simple string without antiquotes such as @"foo"@ is allowed even if--- the context requires a static keyname, but the parser still considers it a--- 'DynamicKey' for simplicity.-data NKeyName r- = DynamicKey (Antiquoted (NString r) r)- | StaticKey Text- deriving (Eq, Ord, Generic, Typeable, Data, Show)---- deriving this instance automatically is not possible--- because r occurs not only as last argument in Antiquoted (NString r) r-instance Functor NKeyName where- fmap f (DynamicKey (Plain str)) = DynamicKey . Plain $ fmap f str- fmap f (DynamicKey (Antiquoted e)) = DynamicKey . Antiquoted $ f e- fmap _ (StaticKey key) = StaticKey key--type NSelector r = [NKeyName r]--data NOperF r- = NUnary NUnaryOp r- | NBinary NBinaryOp r r- deriving (Eq, Ord, Generic, Typeable, Data, Functor, Show)--data NUnaryOp = NNeg | NNot deriving (Eq, Ord, Generic, Typeable, Data, Show)-data NSpecialOp = NHasAttrOp | NSelectOp | NAppOp- deriving (Eq, Ord, Generic, Typeable, Data, Show)-data NBinaryOp- = NEq- | NNEq- | NLt- | NLte- | NGt- | NGte- | NAnd- | NOr- | NImpl- | NUpdate-- | NPlus- | NMinus- | NMult- | NDiv- | NConcat- deriving (Eq, Ord, Generic, Typeable, Data, Show)--data NAssoc = NAssocNone | NAssocLeft | NAssocRight- deriving (Eq, Ord, Generic, Typeable, Data, Show)--data NOperatorDef- = NUnaryDef String NUnaryOp- | NBinaryDef NAssoc [(String, NBinaryOp)]- deriving (Eq, Ord, Generic, Typeable, Data, Show)--nixOperators :: [Either NSpecialOp NOperatorDef]-nixOperators =- [ Left NSelectOp- , Left NAppOp- , Right $ NUnaryDef "-" NNeg- , Left NHasAttrOp- ] ++ map Right- [ NBinaryDef NAssocRight [("++", NConcat)]- , NBinaryDef NAssocLeft [("*", NMult), ("/", NDiv)]- , NBinaryDef NAssocLeft [("+", NPlus), ("-", NMinus)]- , NUnaryDef "!" NNot- , NBinaryDef NAssocRight [("//", NUpdate)]- , NBinaryDef NAssocLeft [("<", NLt), (">", NGt), ("<=", NLte), (">=", NGte)]- , NBinaryDef NAssocNone [("==", NEq), ("!=", NNEq)]- , NBinaryDef NAssocLeft [("&&", NAnd)]- , NBinaryDef NAssocLeft [("||", NOr)]- , NBinaryDef NAssocNone [("->", NImpl)]- ]--data OperatorInfo = OperatorInfo- { precedence :: Int- , associativity :: NAssoc- , operatorName :: String- } deriving (Eq, Ord, Generic, Typeable, Data, Show)--getUnaryOperator :: NUnaryOp -> OperatorInfo-getUnaryOperator = (m Map.!) where- m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $ nixOperators- buildEntry i (Right (NUnaryDef name op)) = [(op, OperatorInfo i NAssocNone name)]- buildEntry _ _ = []--getBinaryOperator :: NBinaryOp -> OperatorInfo-getBinaryOperator = (m Map.!) where- m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $ nixOperators- buildEntry i (Right (NBinaryDef assoc ops)) =- [ (op, OperatorInfo i assoc name) | (name,op) <- ops ]- buildEntry _ _ = []--getSpecialOperatorPrec :: NSpecialOp -> Int-getSpecialOperatorPrec = (m Map.!) where- m = Map.fromList . catMaybes . zipWith buildEntry [1..] . reverse $ nixOperators- buildEntry _ (Right _) = Nothing- buildEntry i (Left op) = Just (op, i)--selectOp :: OperatorInfo-selectOp = OperatorInfo (getSpecialOperatorPrec NSelectOp) NAssocLeft "."--hasAttrOp :: OperatorInfo-hasAttrOp = OperatorInfo (getSpecialOperatorPrec NHasAttrOp) NAssocLeft "?"--appOp :: OperatorInfo-appOp = OperatorInfo (getSpecialOperatorPrec NAppOp) NAssocLeft " "--data NSetBind = Rec | NonRec- deriving (Ord, Eq, Generic, Typeable, Data, Show)---- | A single line of the bindings section of a let expression or of--- a set.-data Binding r- = NamedVar (NSelector r) r- | Inherit (Maybe r) [NSelector r]- deriving (Typeable, Data, Ord, Eq, Functor, Show)---- | 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 name val = NamedVar (mkSelector name) val---- | Append a list of bindings to a set or let expression.--- For example, adding `[a = 1, b = 2]` to `let c = 3; in 4` produces--- `let a = 1; b = 2; c = 3; in 4`.-appendBindings :: [Binding NExpr] -> NExpr -> NExpr-appendBindings newBindings (Fix e) = case e of- NLet bindings e' -> Fix $ NLet (bindings <> newBindings) e'- NSet bindType bindings -> Fix $ NSet bindType (bindings <> newBindings)- _ -> error "Can only append bindings to a set or a let"---- | Applies a transformation to the body of a nix function.-modifyFunctionBody :: (NExpr -> NExpr) -> NExpr -> NExpr-modifyFunctionBody f (Fix e) = case e of- NAbs params body -> Fix $ NAbs params (f body)- _ -> error "Not a function"---- | An 'NValue' is the most reduced form of an 'NExpr' after evaluation--- is completed.-data NValueF r- = NVConstant NAtom- | NVStr Text- | NVList [r]- | NVSet (Map Text r)- | NVFunction (Formals r) (NValue -> IO r)- deriving (Generic, Typeable, Functor)--instance Show f => Show (NValueF f) where- showsPrec = flip go where- go (NVConstant atom) = showsCon1 "NVConstant" atom- go (NVStr text) = showsCon1 "NVStr" text- go (NVList list) = showsCon1 "NVList" list- go (NVSet attrs) = showsCon1 "NVSet" attrs- go (NVFunction r _) = showsCon1 "NVFunction" r-- showsCon1 :: Show a => String -> a -> Int -> String -> String- showsCon1 con a d = showParen (d > 10) $ showString (con ++ " ") . showsPrec 11 a--type NValue = Fix NValueF--valueText :: NValue -> Text-valueText = cata phi where- phi (NVConstant a) = atomText a- phi (NVStr t) = t- phi (NVList _) = error "Cannot coerce a list to a string"- phi (NVSet _) = error "Cannot coerce a set to a string"- phi (NVFunction _ _) = error "Cannot coerce a function to a string"
hnix.cabal view
@@ -1,5 +1,5 @@ Name: hnix-Version: 0.2.1+Version: 0.3.2 Synopsis: Haskell implementation of the Nix language Description: Haskell implementation of the Nix language.@@ -22,12 +22,18 @@ Library Default-language: Haskell2010 Exposed-modules:+ Nix.Atoms Nix.Eval Nix.Parser- Nix.Types+ Nix.Expr Nix.Pretty+ Nix.Parser.Operators+ Nix.StringOperations Other-modules: Nix.Parser.Library+ Nix.Expr.Types+ Nix.Expr.Types.Annotated+ Nix.Expr.Shorthands Default-extensions: DataKinds DeriveDataTypeable@@ -39,6 +45,7 @@ KindSignatures LambdaCase MultiWayIf+ NoImplicitPrelude OverloadedStrings PatternGuards RankNTypes@@ -52,12 +59,14 @@ , parsers >= 0.10 , unordered-containers , data-fix+ , deepseq+ , semigroups >= 0.18 && < 0.19 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 +93,7 @@ , containers , ansi-wl-pprint , data-fix+ , deepseq Ghc-options: -Wall Test-suite hnix-tests
tests/Main.hs view
@@ -3,8 +3,12 @@ import Test.Tasty import qualified ParserTests+import qualified EvalTests +import Prelude (IO, ($))+ main :: IO () main = defaultMain $ testGroup "hnix" [ ParserTests.tests+ , EvalTests.tests ]
tests/ParserTests.hs view
@@ -10,9 +10,13 @@ import qualified Data.Map as Map -import Nix.Types+import Nix.Atoms+import Nix.Expr import Nix.Parser+import Nix.StringOperations +import Prelude+ case_constant_int :: Assertion case_constant_int = assertParseString "234" $ mkInt 234 @@ -57,7 +61,7 @@ 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,50 +69,50 @@ 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"]+ , Inherit Nothing $ StaticKey <$> ["a", "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- [ Inherit (Just (mkSym "a")) [mkSelector "b", mkSelector "c"]+case_set_scoped_inherit = assertParseString "{ inherit (a) b c; e = 4; inherit(a)b c; }" $ Fix $ NSet+ [ Inherit (Just (mkSym "a")) $ StaticKey <$> ["b", "c"] , NamedVar (mkSelector "e") $ mkInt 4- , Inherit (Just (mkSym "a")) [mkSelector "b", mkSelector "c"]+ , Inherit (Just (mkSym "a")) $ StaticKey <$> ["b", "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- [ Inherit Nothing [ [DynamicKey (Plain "a")] ] ]+ assertParseString "{ inherit \"a\"; }" $ Fix $ NSet+ [Inherit Nothing [DynamicKey (Plain "a")]] assertParseFail "{ inherit a.x; }" case_int_list :: Assertion@@ -121,7 +125,7 @@ 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 +136,45 @@ 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@@ -188,7 +194,8 @@ case_let_scoped_inherit :: Assertion case_let_scoped_inherit = do assertParseString "let a = null; inherit (b) c; in c" $ Fix $ NLet- [ NamedVar (mkSelector "a") mkNull, Inherit (Just $ mkSym "b") [mkSelector "c"] ]+ [ NamedVar (mkSelector "a") mkNull+ , Inherit (Just $ mkSym "b") [StaticKey "c"] ] (mkSym "c") assertParseFail "let inherit (b) c in c" @@ -214,7 +221,7 @@ 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 +231,18 @@ 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 +255,16 @@ 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 +277,11 @@ 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 +292,7 @@ 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 +308,8 @@ 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")) $