Add initial support for parsing operators

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"
 

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

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)
 

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
 

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

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