diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,19 +1,26 @@ -opyright (c) 2014 John Wiegley +Copyright (c) 2014, John Wiegley All rights reserved. -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. +1. Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -THE SOFTWARE. +2. Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors +may be used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Nix/Eval.hs b/Nix/Eval.hs --- a/Nix/Eval.hs +++ b/Nix/Eval.hs @@ -30,6 +30,7 @@ | NVSet (Map.Map Text r) | NVFunction (Params r) (NValue m -> m r) | NVLiteralPath FilePath + | NVEnvPath FilePath deriving (Generic, Typeable, Functor) instance Show f => Show (NValueF m f) where @@ -40,6 +41,7 @@ go (NVSet attrs) = showsCon1 "NVSet" attrs go (NVFunction r _) = showsCon1 "NVFunction" r go (NVLiteralPath p) = showsCon1 "NVLiteralPath" p + go (NVEnvPath p) = showsCon1 "NVEnvPath" p showsCon1 :: Show a => String -> a -> Int -> String -> String showsCon1 con a d = showParen (d > 10) $ showString (con ++ " ") . showsPrec 11 a @@ -54,6 +56,7 @@ phi (NVSet _) = error "Cannot coerce a set to a string" phi (NVFunction _ _) = error "Cannot coerce a function to a string" phi (NVLiteralPath p) = Text.pack p + phi (NVEnvPath p) = Text.pack p buildArgument :: Params (NValue m) -> NValue m -> NValue m buildArgument paramSpec arg = either error (Fix . NVSet) $ case paramSpec of @@ -79,7 +82,7 @@ phi (NConstant x) = const $ return $ Fix $ NVConstant x phi (NStr str) = fmap (Fix . NVStr) . flip evalString str phi (NLiteralPath p) = const $ return $ Fix $ NVLiteralPath p - phi (NEnvPath _) = error "Path expressions are not yet supported" + phi (NEnvPath p) = const $ return $ Fix $ NVEnvPath p phi (NUnary op arg) = \env -> arg env >>= \case Fix (NVConstant c) -> pure $ Fix $ NVConstant $ case (op, c) of diff --git a/Nix/Expr/Shorthands.hs b/Nix/Expr/Shorthands.hs --- a/Nix/Expr/Shorthands.hs +++ b/Nix/Expr/Shorthands.hs @@ -11,6 +11,8 @@ import qualified Data.Map as Map import Nix.Atoms import Nix.Expr.Types +import Text.Regex.TDFA.Text () +import Text.Regex.TDFA ((=~)) -- | Make an integer literal expression. mkInt :: Integer -> NExpr @@ -126,10 +128,21 @@ mkFunction params = Fix . NAbs params mkDot :: NExpr -> Text -> NExpr -mkDot e key = Fix $ NSelect e [StaticKey key] Nothing +mkDot e key = mkDots e [key] mkDots :: NExpr -> [Text] -> NExpr -mkDots e keys = Fix $ NSelect e (StaticKey <$> keys) Nothing +mkDots e keys = Fix $ NSelect e (toKey <$> keys) Nothing + where + toKey :: Text -> NKeyName NExpr + toKey k = (if isPlainSymbol k then StaticKey else dynamicKey) k + -- | Make a dynamic key name that is only enclosed in double quotes + -- (no antiquotes). + dynamicKey :: Text -> NKeyName NExpr + dynamicKey k = DynamicKey $ Plain $ DoubleQuoted [Plain k] + -- | Check if it’s a valid nix symbol + -- the nix lexer regex for IDs (symbols) is [a-zA-Z\_][a-zA-Z0-9\_\'\-]* + isPlainSymbol :: Text -> Bool + isPlainSymbol s = s =~ ("^[a-zA-Z_][a-zA-Z0-9_'-]*$" :: Text) -- | An `inherit` clause without an expression to pull from. inherit :: [NKeyName e] -> Binding e diff --git a/Nix/Expr/Types.hs b/Nix/Expr/Types.hs --- a/Nix/Expr/Types.hs +++ b/Nix/Expr/Types.hs @@ -12,9 +12,10 @@ import Control.Monad hiding (forM_, mapM, sequence) import Data.Data +import Data.Eq.Deriving import Data.Fix import Data.Foldable -import Data.Functor.Classes (Show1(..), showsUnaryWith, liftShowsPrec2) +import Data.Functor.Classes (Eq1(..), Eq2(..), Show1(..), showsUnaryWith, liftShowsPrec2) import Data.Map (Map, toList) import Data.Text (Text, pack) import Data.Traversable @@ -116,6 +117,13 @@ deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show, Foldable, Traversable) +instance Eq1 ParamSet where + liftEq eq (FixedParamSet a) (FixedParamSet b) = + liftEq (liftEq (liftEq eq)) (Data.Map.toList a) (Data.Map.toList b) + liftEq eq (VariadicParamSet a) (VariadicParamSet b) = + liftEq (liftEq (liftEq eq)) (Data.Map.toList a) (Data.Map.toList b) + liftEq _ _ _ = False + -- It's not possible to derive this automatically as there is no Show1 instance -- for Map. We define one locally here. instance Show1 ParamSet where @@ -187,6 +195,11 @@ instance IsString (NKeyName r) where fromString = StaticKey . fromString +instance Eq1 NKeyName where + liftEq eq (DynamicKey a) (DynamicKey b) = liftEq2 (liftEq eq) eq a b + liftEq _ (StaticKey a) (StaticKey b) = a == b + liftEq _ _ _ = False + -- Deriving this instance automatically is not possible because @r@ -- occurs not only as last argument in @Antiquoted (NString r) r@ instance Show1 NKeyName where @@ -243,6 +256,13 @@ paramName :: Params r -> Maybe Text paramName (Param n) = Just n paramName (ParamSet _ n) = n + +$(deriveEq1 ''NExprF) +$(deriveEq1 ''NString) +$(deriveEq1 ''Binding) +$(deriveEq1 ''Params) +$(deriveEq1 ''Antiquoted) +$(deriveEq2 ''Antiquoted) $(deriveShow1 ''NExprF) $(deriveShow1 ''NString) diff --git a/Nix/Parser.hs b/Nix/Parser.hs --- a/Nix/Parser.hs +++ b/Nix/Parser.hs @@ -105,11 +105,11 @@ nixBool :: Parser NExprLoc nixBool = annotateLocation1 $ try (true <|> false) "bool" where - true = mkBoolF True <$ symbol "true" - false = mkBoolF False <$ symbol "false" + true = mkBoolF True <$ reserved "true" + false = mkBoolF False <$ reserved "false" nixNull :: Parser NExprLoc -nixNull = annotateLocation1 $ mkNullF <$ try (symbol "null") "null" +nixNull = annotateLocation1 $ mkNullF <$ try (reserved "null") "null" nixParens :: Parser NExprLoc nixParens = parens nixExprLoc "parens" diff --git a/Nix/Pretty.hs b/Nix/Pretty.hs --- a/Nix/Pretty.hs +++ b/Nix/Pretty.hs @@ -70,7 +70,7 @@ f ([Plain t] : xs) | Text.null (strip t) = xs f xs = xs prettyLine = hcat . map prettyPart - prettyPart (Plain t) = text . unpack . replace "$" "''$" . replace "''" "'''" $ t + prettyPart (Plain t) = text . unpack . replace "${" "''${" . replace "''" "'''" $ t prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r) prettyParams :: Params NixDoc -> Doc diff --git a/hnix.cabal b/hnix.cabal --- a/hnix.cabal +++ b/hnix.cabal @@ -1,5 +1,5 @@ Name: hnix -Version: 0.3.4 +Version: 0.4.0 Synopsis: Haskell implementation of the Nix language Description: Haskell implementation of the Nix language. @@ -62,6 +62,8 @@ , data-fix , deepseq , semigroups >= 0.18 && < 0.19 + , regex-tdfa + , regex-tdfa-text if flag(parsec) Cpp-options: -DUSE_PARSEC Build-depends: parsec @@ -105,6 +107,8 @@ Other-modules: ParserTests EvalTests + ShorthandTests + PrettyTests Build-depends: base >= 4.3 && < 5 , containers diff --git a/main/Main.hs b/main/Main.hs --- a/main/Main.hs +++ b/main/Main.hs @@ -3,21 +3,20 @@ import Nix.Parser import Nix.Pretty +import Nix.Expr import System.Environment import System.IO import Text.PrettyPrint.ANSI.Leijen nix :: FilePath -> IO () -nix path = do - res <- parseNixFile path - case res of - Failure e -> hPutStrLn stderr $ "Parse failed: " ++ show e - Success n -> do - displayIO stdout $ renderPretty 0.4 80 (prettyNix n) +nix path = parseNixFile path >>= displayNExpr nixString :: String -> IO () -nixString s = case parseNixString s of +nixString = displayNExpr . parseNixString + +displayNExpr :: Result NExpr -> IO () +displayNExpr = \case Success n -> displayIO stdout $ renderPretty 0.4 80 (prettyNix n) Failure e -> hPutStrLn stderr $ "Parse failed: " ++ show e diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -4,6 +4,8 @@ import qualified ParserTests import qualified EvalTests +import qualified ShorthandTests +import qualified PrettyTests import Prelude (IO, ($)) @@ -11,4 +13,6 @@ main = defaultMain $ testGroup "hnix" [ ParserTests.tests , EvalTests.tests + , ShorthandTests.tests + , PrettyTests.tests ] diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs --- a/tests/ParserTests.hs +++ b/tests/ParserTests.hs @@ -220,6 +220,14 @@ assertParseFail ".a" assertParseFail "'a" +case_identifier_keyword_prefix :: Assertion +case_identifier_keyword_prefix = do + assertParseString "true-name" $ mkSym "true-name" + assertParseString "trueName" $ mkSym "trueName" + assertParseString "null-name" $ mkSym "null-name" + assertParseString "nullName" $ mkSym "nullName" + assertParseString "[ null-name ]" $ mkList [ mkSym "null-name" ] + makeStringParseTest :: String -> Assertion makeStringParseTest str = assertParseString ("\"" ++ str ++ "\"") $ mkStr $ pack str diff --git a/tests/PrettyTests.hs b/tests/PrettyTests.hs new file mode 100644 --- /dev/null +++ b/tests/PrettyTests.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +module PrettyTests (tests) where + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.TH + +import Nix.Expr +import Nix.Pretty + +case_indented_antiquotation :: Assertion +case_indented_antiquotation = do + assertPretty (mkIndentedStr "echo $foo") "''echo $foo''" + assertPretty (mkIndentedStr "echo ${foo}") "''echo ''${foo}''" + +case_string_antiquotation :: Assertion +case_string_antiquotation = do + -- TODO: plain $ doesn't need to be escaped here either + assertPretty (mkStr "echo $foo") "\"echo \\$foo\"" + assertPretty (mkStr "echo ${foo}") "\"echo \\${foo}\"" + +tests :: TestTree +tests = $testGroupGenerator + +-------------------------------------------------------------------------------- +assertPretty :: NExpr -> String -> Assertion +assertPretty e s = assertEqual ("When pretty-printing " ++ show e) s . show $ prettyNix e diff --git a/tests/ShorthandTests.hs b/tests/ShorthandTests.hs new file mode 100644 --- /dev/null +++ b/tests/ShorthandTests.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE TemplateHaskell, OverloadedStrings #-} +module ShorthandTests (tests) where + +import Prelude + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.TH + +import Control.Monad (forM_) +import Data.Monoid ((<>)) +import Data.Fix + +import Nix.Expr + + +case_mkDotsSymbolEscaping :: Assertion +case_mkDotsSymbolEscaping = do + let check xs errmsg assert = + forM_ xs $ \x -> assertBool (errmsg <> ": " <> show x) $ assert x + check plain "not a plain value" $ assertIsSingle + check nonPlain "not a non-plain value" $ not . assertIsSingle + where + plain = [ "abc09", "_A_'-", "AbC" ] + nonPlain = [ "abc def", "\\", "'abc", "\"", "-foo", "a.b.c" ] + assertIsSingle = isPlainSingle . getKey . mkDot "dummy" + getKey (Fix (NSelect _ [key] _)) = key + getKey _ = error "invalid" + isPlainSingle (StaticKey _) = True + isPlainSingle (DynamicKey (Plain (DoubleQuoted [Plain _]))) = False + isPlainSingle _ = error "invalid" + + +--------------------------- + +tests :: TestTree +tests = $(testGroupGenerator) + +