split into more modules, rename some things, add docs
This commit is contained in:
Allen Nelson
parent
f60f12f9a0
commit
d3a1e7207f
48
Nix/Eval.hs
48
Nix/Eval.hs
|
|
@ -13,10 +13,50 @@ import qualified Data.Map as Map
|
|||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Traversable as T
|
||||
import Nix.Types
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Generics
|
||||
import Nix.Pretty (atomText)
|
||||
import Nix.StringOperations (runAntiquoted)
|
||||
import Nix.Expr
|
||||
import Prelude hiding (mapM, sequence)
|
||||
|
||||
<<<<<<< f60f12f9a023dac427afc7194baf610b149f3ea0
|
||||
buildArgument :: Formals (NValue m) -> NValue m -> NValue m
|
||||
=======
|
||||
-- | 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.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"
|
||||
|
||||
buildArgument :: Formals NValue -> NValue -> NValue
|
||||
>>>>>>> split into more modules, rename some things, add docs
|
||||
buildArgument paramSpec arg = either error (Fix . NVSet) $ case paramSpec of
|
||||
FormalName name -> return $ Map.singleton name arg
|
||||
FormalSet s Nothing -> lookupParamSet s
|
||||
|
|
@ -40,6 +80,10 @@ 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 (NOper _x) = error "Operators are not yet defined"
|
||||
phi (NPath _ _) = error "Path expressions are not yet supported"
|
||||
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 (NOper x) = \env -> case x of
|
||||
NUnary op arg -> arg env >>= \case
|
||||
|
|
@ -186,7 +230,7 @@ evalBinds allowDynamic env xs = buildResult <$> sequence (concatMap go xs) where
|
|||
go (NamedVar x y) = [liftM2 (,) (evalSelector allowDynamic env x) (y env)]
|
||||
go _ = [] -- HACK! But who cares right now
|
||||
|
||||
evalSelector :: Monad m => Bool -> NValue m -> NSelector (NValue m -> m (NValue m)) -> m [Text]
|
||||
evalSelector :: Monad m => Bool -> NValue m -> NAttrPath (NValue m -> m (NValue m)) -> m [Text]
|
||||
evalSelector dyn env = mapM evalKeyName where
|
||||
evalKeyName (StaticKey k) = return k
|
||||
evalKeyName (DynamicKey k)
|
||||
|
|
|
|||
294
Nix/Expr.hs
Normal file
294
Nix/Expr.hs
Normal file
|
|
@ -0,0 +1,294 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE DeriveFoldable #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
-- | The nix expression type and supporting types.
|
||||
module Nix.Expr where
|
||||
|
||||
import Control.Monad hiding (forM_, mapM, sequence)
|
||||
import Data.Data
|
||||
import Data.Fix
|
||||
import Data.Foldable
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Monoid
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Traversable
|
||||
import GHC.Exts
|
||||
import GHC.Generics
|
||||
import Prelude hiding (readFile, concat, concatMap, elem, mapM,
|
||||
sequence, minimum, foldr)
|
||||
|
||||
-- | 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
|
||||
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.
|
||||
data Binding r
|
||||
= NamedVar (NAttrPath r) r
|
||||
| Inherit (Maybe r) [NAttrPath 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))
|
||||
-- ^ 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))
|
||||
-- ^ 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)
|
||||
|
||||
-- | 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
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Functor, Show)
|
||||
|
||||
-- | A 'KeyName' is something that can appear at the right side of an
|
||||
-- equals sign.
|
||||
-- For example, @a@ is a 'KeyName' in @{ a = 3; }@, @let a = 3;
|
||||
-- in ...@, @{}.a@ or @{} ? a@.
|
||||
--
|
||||
-- Nix supports both static keynames (just an identifier) and dynamic
|
||||
-- identifiers. Dynamic identifiers can be either a string (e.g.:
|
||||
-- @{ "a" = 3; }@) or an antiquotation (e.g.: @let a = "example";
|
||||
-- in { ${a} = 3; }.example@).
|
||||
--
|
||||
-- Note: There are some places where a dynamic keyname is not allowed.
|
||||
-- In particular, those include:
|
||||
--
|
||||
-- * The RHS of a @binding@ inside @let@: @let ${"a"} = 3; in ...@
|
||||
-- produces a syntax error.
|
||||
-- * The attribute names of an 'inherit': @inherit ${"a"};@ is forbidden.
|
||||
--
|
||||
-- Note: In Nix, a simple string without antiquotes such as @"foo"@ is
|
||||
-- allowed even if the context requires a static keyname, but the
|
||||
-- parser still considers it a 'DynamicKey' for simplicity.
|
||||
data NKeyName r
|
||||
= DynamicKey (Antiquoted (NString r) r)
|
||||
| StaticKey Text
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
||||
-- | Deriving this instance automatically is not possible because @r@
|
||||
-- occurs not only as last argument in @Antiquoted (NString r) r@
|
||||
instance Functor NKeyName where
|
||||
fmap f (DynamicKey (Plain str)) = DynamicKey . Plain $ fmap f str
|
||||
fmap f (DynamicKey (Antiquoted e)) = DynamicKey . Antiquoted $ f e
|
||||
fmap _ (StaticKey key) = StaticKey key
|
||||
|
||||
-- | A selector (for example in a @let@ or an attribute set) is made up
|
||||
-- of strung-together key names.
|
||||
type NAttrPath r = [NKeyName r]
|
||||
|
||||
-- | 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)
|
||||
|
||||
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)
|
||||
|
||||
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 . NPath b
|
||||
|
||||
-- | Make a path expression which pulls from the NIX_PATH env variable.
|
||||
mkEnvPath :: FilePath -> NExpr
|
||||
mkEnvPath = mkPath True
|
||||
|
||||
-- | Make a path expression which references a relative path.
|
||||
mkRelPath :: FilePath -> NExpr
|
||||
mkRelPath = mkPath False
|
||||
|
||||
mkSym :: Text -> NExpr
|
||||
mkSym = Fix . NSym
|
||||
|
||||
mkSelector :: Text -> NAttrPath NExpr
|
||||
mkSelector = (:[]) . StaticKey
|
||||
|
||||
mkBool :: Bool -> NExpr
|
||||
mkBool = Fix . NConstant . NBool
|
||||
|
||||
mkNull :: NExpr
|
||||
mkNull = Fix (NConstant NNull)
|
||||
|
||||
mkOper :: NUnaryOp -> NExpr -> NExpr
|
||||
mkOper op = Fix . 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"
|
||||
|
||||
|
|
@ -16,7 +16,9 @@ import Data.Foldable hiding (concat)
|
|||
import qualified Data.Map as Map
|
||||
import Data.Text hiding (head, map, foldl1', foldl', concat)
|
||||
import Nix.Parser.Library
|
||||
import Nix.Types
|
||||
import Nix.Parser.Operators
|
||||
import Nix.Expr
|
||||
import Nix.StringOperations
|
||||
import Prelude hiding (elem)
|
||||
|
||||
-- | The lexer for this parser is defined in 'Nix.Parser.Library'.
|
||||
|
|
@ -45,7 +47,7 @@ selDot :: Parser ()
|
|||
selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath)) *> whiteSpace
|
||||
<?> "."
|
||||
|
||||
nixSelector :: Parser (NSelector NExpr)
|
||||
nixSelector :: Parser (NAttrPath NExpr)
|
||||
nixSelector = keyName `sepBy1` selDot where
|
||||
|
||||
nixSelect :: Parser NExpr -> Parser NExpr
|
||||
|
|
|
|||
81
Nix/Parser/Operators.hs
Normal file
81
Nix/Parser/Operators.hs
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
module Nix.Parser.Operators where
|
||||
|
||||
import Data.Data (Data(..))
|
||||
import Data.Foldable (concat)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Exts
|
||||
import GHC.Generics
|
||||
import Nix.Expr
|
||||
import Prelude hiding (readFile, concat, concatMap, elem, mapM,
|
||||
sequence, minimum, foldr)
|
||||
|
||||
data NSpecialOp = NHasAttrOp | NSelectOp | NAppOp
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
||||
data NAssoc = NAssocNone | NAssocLeft | NAssocRight
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
||||
data NOperatorDef
|
||||
= NUnaryDef String NUnaryOp
|
||||
| NBinaryDef NAssoc [(String, NBinaryOp)]
|
||||
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
||||
nixOperators :: [Either NSpecialOp NOperatorDef]
|
||||
nixOperators =
|
||||
[ Left NSelectOp
|
||||
, Left NAppOp
|
||||
, Right $ NUnaryDef "-" NNeg
|
||||
, Left NHasAttrOp
|
||||
] ++ map Right
|
||||
[ NBinaryDef NAssocRight [("++", NConcat)]
|
||||
, NBinaryDef NAssocLeft [("*", NMult), ("/", NDiv)]
|
||||
, NBinaryDef NAssocLeft [("+", NPlus), ("-", NMinus)]
|
||||
, NUnaryDef "!" NNot
|
||||
, NBinaryDef NAssocRight [("//", NUpdate)]
|
||||
, NBinaryDef NAssocLeft [("<", NLt), (">", NGt), ("<=", NLte), (">=", NGte)]
|
||||
, NBinaryDef NAssocNone [("==", NEq), ("!=", NNEq)]
|
||||
, NBinaryDef NAssocLeft [("&&", NAnd)]
|
||||
, NBinaryDef NAssocLeft [("||", NOr)]
|
||||
, NBinaryDef NAssocNone [("->", NImpl)]
|
||||
]
|
||||
|
||||
data OperatorInfo = OperatorInfo
|
||||
{ precedence :: Int
|
||||
, associativity :: NAssoc
|
||||
, operatorName :: String
|
||||
} deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
||||
|
||||
getUnaryOperator :: NUnaryOp -> OperatorInfo
|
||||
getUnaryOperator = (m Map.!) where
|
||||
m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $
|
||||
nixOperators
|
||||
buildEntry i = \case
|
||||
Right (NUnaryDef name op) -> [(op, OperatorInfo i NAssocNone name)]
|
||||
_ -> []
|
||||
|
||||
getBinaryOperator :: NBinaryOp -> OperatorInfo
|
||||
getBinaryOperator = (m Map.!) where
|
||||
m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $
|
||||
nixOperators
|
||||
buildEntry i = \case
|
||||
Right (NBinaryDef assoc ops) -> do
|
||||
[(op, OperatorInfo i assoc name) | (name,op) <- ops]
|
||||
_ -> []
|
||||
|
||||
getSpecialOperatorPrec :: NSpecialOp -> Int
|
||||
getSpecialOperatorPrec = (m Map.!) where
|
||||
m = Map.fromList . catMaybes . zipWith buildEntry [1..] . reverse $
|
||||
nixOperators
|
||||
buildEntry _ (Right _) = Nothing
|
||||
buildEntry i (Left op) = Just (op, i)
|
||||
|
||||
selectOp :: OperatorInfo
|
||||
selectOp = OperatorInfo (getSpecialOperatorPrec NSelectOp) NAssocLeft "."
|
||||
|
||||
hasAttrOp :: OperatorInfo
|
||||
hasAttrOp = OperatorInfo (getSpecialOperatorPrec NHasAttrOp) NAssocLeft "?"
|
||||
|
||||
appOp :: OperatorInfo
|
||||
appOp = OperatorInfo (getSpecialOperatorPrec NAppOp) NAssocLeft " "
|
||||
|
|
@ -5,9 +5,12 @@ import Prelude hiding ((<$>))
|
|||
import Data.Fix
|
||||
import Data.Map (toList)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Text (Text, unpack, replace, strip)
|
||||
import Nix.Types
|
||||
import Data.Text (Text, pack, unpack, replace, strip)
|
||||
import Data.List (isPrefixOf)
|
||||
import Nix.Expr
|
||||
import Nix.Parser.Library (reservedNames)
|
||||
import Nix.Parser.Operators
|
||||
import Nix.StringOperations
|
||||
import Text.PrettyPrint.ANSI.Leijen
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
|
@ -98,7 +101,7 @@ prettyKeyName (StaticKey key)
|
|||
prettyKeyName (StaticKey key) = text . unpack $ key
|
||||
prettyKeyName (DynamicKey key) = runAntiquoted prettyString withoutParens key
|
||||
|
||||
prettySelector :: NSelector NixDoc -> Doc
|
||||
prettySelector :: NAttrPath NixDoc -> Doc
|
||||
prettySelector = hcat . punctuate dot . map prettyKeyName
|
||||
|
||||
prettySetArg :: (Text, Maybe NixDoc) -> Doc
|
||||
|
|
@ -120,6 +123,12 @@ 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"
|
||||
|
||||
prettyAtom :: NAtom -> NixDoc
|
||||
prettyAtom atom = simpleExpr $ text $ unpack $ atomText atom
|
||||
|
||||
|
|
@ -144,7 +153,17 @@ 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 (NSym name) = simpleExpr $ text (unpack name)
|
||||
phi (NLet binds body) = leastPrecedence $ group $ nest 2 $
|
||||
vsep (text "let" : map prettyBind binds) <$> text "in" <+> withoutParens body
|
||||
|
|
|
|||
87
Nix/StringOperations.hs
Normal file
87
Nix/StringOperations.hs
Normal file
|
|
@ -0,0 +1,87 @@
|
|||
-- | Functions for manipulating nix strings.
|
||||
module Nix.StringOperations where
|
||||
|
||||
import Nix.Expr
|
||||
import Data.List (intercalate)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Prelude hiding (elem)
|
||||
import Data.Tuple (swap)
|
||||
|
||||
|
||||
-- | Merge adjacent 'Plain' values with 'mappend'.
|
||||
mergePlain :: Monoid v => [Antiquoted v r] -> [Antiquoted v r]
|
||||
mergePlain [] = []
|
||||
mergePlain (Plain a: Plain b: xs) = mergePlain (Plain (a <> b) : xs)
|
||||
mergePlain (x:xs) = x : mergePlain xs
|
||||
|
||||
-- | Remove 'Plain' values equal to 'mempty', as they don't have any
|
||||
-- informational content.
|
||||
removePlainEmpty :: (Eq v, Monoid v) => [Antiquoted v r] -> [Antiquoted v r]
|
||||
removePlainEmpty = filter f where
|
||||
f (Plain x) = x /= mempty
|
||||
f _ = True
|
||||
|
||||
-- | Equivalent to case splitting on 'Antiquoted' strings.
|
||||
runAntiquoted :: (v -> a) -> (r -> a) -> Antiquoted v r -> a
|
||||
runAntiquoted f _ (Plain v) = f v
|
||||
runAntiquoted _ f (Antiquoted r) = f r
|
||||
|
||||
-- | Split a stream representing a string with antiquotes on line breaks.
|
||||
splitLines :: [Antiquoted Text r] -> [[Antiquoted Text r]]
|
||||
splitLines = uncurry (flip (:)) . go where
|
||||
go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls where
|
||||
(l : ls) = T.split (=='\n') t
|
||||
f prefix (finished, current) = ((Plain prefix : current) : finished, [])
|
||||
go (Antiquoted a : xs) = (Antiquoted a :) <$> go xs
|
||||
go [] = ([],[])
|
||||
|
||||
-- | Join a stream of strings containing antiquotes again. This is the inverse
|
||||
-- of 'splitLines'.
|
||||
unsplitLines :: [[Antiquoted Text r]] -> [Antiquoted Text r]
|
||||
unsplitLines = intercalate [Plain "\n"]
|
||||
|
||||
-- | Form an indented string by stripping spaces equal to the minimal indent.
|
||||
stripIndent :: [Antiquoted Text r] -> NString r
|
||||
stripIndent [] = 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 $ \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)
|
||||
|
|
@ -24,7 +24,7 @@ Library
|
|||
Exposed-modules:
|
||||
Nix.Eval
|
||||
Nix.Parser
|
||||
Nix.Types
|
||||
Nix.Expr
|
||||
Nix.Pretty
|
||||
Other-modules:
|
||||
Nix.Parser.Library
|
||||
|
|
@ -52,6 +52,7 @@ Library
|
|||
, parsers >= 0.10
|
||||
, unordered-containers
|
||||
, data-fix
|
||||
, deepseq
|
||||
if flag(parsec)
|
||||
Cpp-options: -DUSE_PARSEC
|
||||
Build-depends: parsec
|
||||
|
|
@ -84,6 +85,7 @@ Executable hnix
|
|||
, containers
|
||||
, ansi-wl-pprint
|
||||
, data-fix
|
||||
, deepseq
|
||||
Ghc-options: -Wall
|
||||
|
||||
Test-suite hnix-tests
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ import Test.Tasty.TH
|
|||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Nix.Types
|
||||
import Nix.Expr
|
||||
import Nix.Parser
|
||||
|
||||
case_constant_int :: Assertion
|
||||
|
|
|
|||
Loading…
Reference in a new issue