From be1434726a7ccde4eb1b31fb4543eac8a7a65fcc Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 1 Jul 2014 01:12:28 -0500 Subject: [PATCH] Add initial support for parsing operators --- Nix/Eval.hs | 6 ++-- Nix/Internal.hs | 6 ++-- Nix/Parser.hs | 39 ++++++++++++++++++----- Nix/Parser/Library.hs | 4 +++ Nix/Types.hs | 73 +++++++++++++++++++++++++++++-------------- hnix.cabal | 2 ++ 6 files changed, 93 insertions(+), 37 deletions(-) diff --git a/Nix/Eval.hs b/Nix/Eval.hs index 301e033..c9f08e1 100644 --- a/Nix/Eval.hs +++ b/Nix/Eval.hs @@ -37,9 +37,9 @@ evalExpr = cata phi phi (NList l) = \env -> Fix . NVList <$> mapM ($ env) l - phi (NConcat l) = \env -> - Fix . NVConstant . NStr . T.concat - <$> mapM (fmap valueText . ($ env)) l + -- phi (NConcat l) = \env -> + -- Fix . NVConstant . NStr . T.concat + -- <$> mapM (fmap valueText . ($ env)) l phi (NArgSet _xs) = error "Cannot evaluate an argument set" diff --git a/Nix/Internal.hs b/Nix/Internal.hs index 57ce560..da9780d 100644 --- a/Nix/Internal.hs +++ b/Nix/Internal.hs @@ -1,5 +1,5 @@ module Nix.Internal (trace) where ---import Debug.Trace -trace :: String -> b -> b -trace _ x = x +import Debug.Trace +--trace :: String -> b -> b +--trace _ x = x diff --git a/Nix/Parser.hs b/Nix/Parser.hs index 6c6d462..3daa922 100644 --- a/Nix/Parser.hs +++ b/Nix/Parser.hs @@ -3,26 +3,47 @@ module Nix.Parser (parseNixFile, Result(..)) where import Control.Applicative -import Control.Monad hiding (forM_, mapM, sequence) +import Control.Monad import Control.Monad.IO.Class import Data.Char import Data.Foldable +import Data.List (foldl1') import qualified Data.Map as Map -import Data.Text hiding (concat, concatMap, head, map) +import Data.Text hiding (head, map, foldl1') import Nix.Types import Nix.Internal import Nix.Parser.Library import qualified Prelude -import Prelude hiding (readFile, concat, concatMap, elem, mapM, - sequence) +import Prelude hiding (elem) nixApp :: Parser NExpr -nixApp = go <$> some (whiteSpace *> nixTerm True) +nixApp = go <$> some (whiteSpace *> nixExpr True) where go [] = error "some has failed us" go [x] = x go (f:xs) = Fix (NApp f (go xs)) +nixExpr :: Bool -> Parser NExpr +nixExpr allowLambdas = + buildExpressionParser table (nixTerm allowLambdas) "expression" + where + table :: OperatorTable Parser NExpr + table = + [ [ prefix "-" NNeg ] + , [ binary "++" NConcat AssocRight ] + , [ binary "*" NMult AssocLeft, + binary "/" NDiv AssocLeft ] + , [ binary "+" NPlus AssocLeft, + binary "-" NMinus AssocLeft ] + ] + + binary name fun = + Infix (pure (\x y -> Fix (NOper (fun x y))) <* symbol name) + prefix name fun = + Prefix (pure (Fix . NOper . fun) <* symbol name) + -- postfix name fun = + -- Postfix (pure (Fix . NOper . fun) <* symbol name) + nixTerm :: Bool -> Parser NExpr nixTerm allowLambdas = choice [ nixInt @@ -92,9 +113,11 @@ symName = do stringish :: Parser NExpr stringish = (char '"' *> - (Fix . NConcat <$> manyTill stringChar (char '"'))) + (merge <$> manyTill stringChar (char '"'))) <|> (char '$' *> between (symbolic '{') (symbolic '}') nixApp) where + merge = foldl1' (\x y -> Fix (NOper (NConcat x y))) + stringChar :: Parser NExpr stringChar = char '\\' *> oneChar <|> (string "${" *> nixApp <* char '}') @@ -111,8 +134,8 @@ argExpr = (Fix . NArgSet . Map.fromList <$> argList) "arglist" argName = (,) <$> (symName <* whiteSpace) - <*> optional (try (symbolic '?' *> nixApp)) -1 + <*> optional (symbolic '?' *> nixTerm False) + nvPair :: Parser (NExpr, NExpr) nvPair = (,) <$> keyName <*> (symbolic '=' *> nixApp) diff --git a/Nix/Parser/Library.hs b/Nix/Parser/Library.hs index 9b25233..95671f9 100644 --- a/Nix/Parser/Library.hs +++ b/Nix/Parser/Library.hs @@ -4,9 +4,11 @@ module Nix.Parser.Library ( #if USE_PARSEC module Text.Parsec + , module Text.Parsec.Expr , module Text.Parsec.Text #else module Text.Trifecta + , module Text.Parser.Expression , module Text.Parser.LookAhead #endif ) @@ -17,6 +19,7 @@ module Nix.Parser.Library import Control.Applicative import Data.Text.IO import Text.Parsec hiding ((<|>), many, optional) +import Text.Parsec.Expr import Text.Parsec.Text import Text.PrettyPrint.ANSI.Leijen (Doc, text) @@ -42,6 +45,7 @@ parseFromFileEx p path = #else +import Text.Parser.Expression import Text.Parser.LookAhead import Text.Trifecta diff --git a/Nix/Types.hs b/Nix/Types.hs index 982cd4e..b318966 100644 --- a/Nix/Types.hs +++ b/Nix/Types.hs @@ -43,12 +43,45 @@ atomText (NPath p) = pack p atomText (NBool b) = if b then "true" else "false" atomText (NSym s) = s atomText NNull = "null" + +data NOperF r + = NNot r + | NNeg r + + | NEq r r + | NNEq r r + | NLt r r + | NLte r r + | NGt r r + | NGte r r + | NAnd r r + | NOr r r + | NImpl r r + | NUpdate r r + | NHasAttr r r + + | NPlus r r + | NMinus r r + | NMult r r + | NDiv r r + | NConcat r r + deriving (Eq, Ord, Generic, Typeable, Data, Functor) + + -- show (NConcat l) = go l + -- where + -- go [] = "" + -- go [x] = show x + -- go (x:xs) = show x ++ " ++ " ++ go xs + + + -- phi (NConcat l) = "NConcat " ++ show l data NExprF r = NConstant NAtom + | NOper (NOperF r) + | NList [r] - | NConcat [r] -- ^ A "concat" is a list of things which must combine to form a string. | NArgSet (Map Text (Maybe r)) | NSet Bool [(r, r)] @@ -62,7 +95,7 @@ data NExprF r | NApp r r | NAbs r r -- ^ The untyped lambda calculus core - deriving (Ord, Eq, Generic, Typeable, Data) + deriving (Ord, Eq, Generic, Typeable, Data, Functor) type NExpr = Fix NExprF @@ -70,23 +103,23 @@ instance Show (Fix NExprF) where show (Fix f) = show f instance Eq (Fix NExprF) where Fix x == Fix y = x == y instance Ord (Fix NExprF) where compare (Fix x) (Fix y) = compare x y -instance Functor NExprF where - fmap _ (NConstant a) = NConstant a - fmap f (NList r) = NList (fmap f r) - fmap f (NConcat r) = NConcat (fmap f r) - fmap f (NArgSet h) = NArgSet (fmap (fmap f) h) - fmap f (NSet b h) = NSet b $ map go h - where go (k, v) = (f k, f v) - fmap f (NLet r r1) = NLet (f r) (f r1) - fmap f (NIf r r1 r2) = NIf (f r) (f r1) (f r2) - fmap f (NWith r r1) = NWith (f r) (f r1) - fmap f (NAssert r r1) = NAssert (f r) (f r1) - fmap f (NVar r) = NVar (f r) - fmap f (NApp r r1) = NApp (f r) (f r1) - fmap f (NAbs r r1) = NAbs (f r) (f r1) +-- instance Functor NExprF where +-- fmap _ (NConstant a) = NConstant a +-- fmap f (NList r) = NList (fmap f r) +-- fmap f (NArgSet h) = NArgSet (fmap (fmap f) h) +-- fmap f (NSet b h) = NSet b $ map go h +-- where go (k, v) = (f k, f v) +-- fmap f (NLet r r1) = NLet (f r) (f r1) +-- fmap f (NIf r r1 r2) = NIf (f r) (f r1) (f r2) +-- fmap f (NWith r r1) = NWith (f r) (f r1) +-- fmap f (NAssert r r1) = NAssert (f r) (f r1) +-- fmap f (NVar r) = NVar (f r) +-- fmap f (NApp r r1) = NApp (f r) (f r1) +-- fmap f (NAbs r r1) = NAbs (f r) (f r1) instance Show f => Show (NExprF f) where show (NConstant x) = show x + -- show (NOper x) = show x show (NList l) = "[ " ++ go l ++ " ]" where @@ -94,12 +127,6 @@ instance Show f => Show (NExprF f) where go [x] = show x go (x:xs) = show x ++ ", " ++ go xs - show (NConcat l) = go l - where - go [] = "" - go [x] = show x - go (x:xs) = show x ++ " ++ " ++ go xs - show (NArgSet h) = "{ " ++ go (Map.toList h) ++ " }" where go [] = "" @@ -126,8 +153,8 @@ instance Show f => Show (NExprF f) where dumpExpr :: NExpr -> String dumpExpr = cata phi where phi (NConstant x) = "NConstant " ++ show x + -- phi (NOper x) = "NOper " ++ show x phi (NList l) = "NList [" ++ show l ++ "]" - phi (NConcat l) = "NConcat " ++ show l phi (NArgSet xs) = "NArgSet " ++ show xs phi (NSet b xs) = "NSet " ++ show b ++ " " ++ show xs phi (NLet v e) = "NLet " ++ v ++ " " ++ e diff --git a/hnix.cabal b/hnix.cabal index e8f27ca..5ed20ce 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -29,6 +29,7 @@ Library Default-extensions: DataKinds DeriveDataTypeable + DeriveFunctor DeriveGeneric FlexibleContexts FlexibleInstances @@ -62,6 +63,7 @@ executable hnix Default-extensions: DataKinds DeriveDataTypeable + DeriveFunctor DeriveGeneric FlexibleContexts FlexibleInstances