From 1b82727a17ac99d07b43b84154d4544c0f5a7927 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Benno=20F=C3=BCnfst=C3=BCck?= Date: Sat, 27 Sep 2014 20:11:17 +0200 Subject: [PATCH] Use data-fix for Fix and fix path parsing bug --- Nix/Eval.hs | 1 + Nix/Parser.hs | 13 +++++++++---- Nix/Pretty.hs | 1 + Nix/Types.hs | 23 +---------------------- default.nix | 4 ++-- hnix.cabal | 3 +++ main/Nix.hs | 3 ++- tests/ParserTests.hs | 3 ++- 8 files changed, 21 insertions(+), 30 deletions(-) diff --git a/Nix/Eval.hs b/Nix/Eval.hs index 8419ed9..f0fe749 100644 --- a/Nix/Eval.hs +++ b/Nix/Eval.hs @@ -3,6 +3,7 @@ module Nix.Eval where import Control.Applicative import Control.Arrow import Control.Monad hiding (mapM, sequence) +import Data.Fix import Data.Foldable (foldl') import qualified Data.Map as Map import Data.Text (Text) diff --git a/Nix/Parser.hs b/Nix/Parser.hs index 64f7897..c677a95 100644 --- a/Nix/Parser.hs +++ b/Nix/Parser.hs @@ -5,11 +5,12 @@ module Nix.Parser (parseNixFile, parseNixString, Result(..)) where import Control.Applicative import Control.Monad import Control.Monad.IO.Class -import Data.Foldable +import Data.Fix +import Data.Foldable hiding (concat) import qualified Data.Map as Map -import Data.Text hiding (head, map, foldl1', foldl') -import Nix.Types +import Data.Text hiding (head, map, foldl1', foldl', concat) import Nix.Parser.Library +import Nix.Types import Prelude hiding (elem) -- | The lexer for this parser is defined in 'Nix.Parser.Library'. @@ -95,7 +96,11 @@ nixSPath = mkPath True <$> try (char '<' *> some (oneOf pathChars <|> slash) <* nixPath :: Parser NExpr nixPath = token $ fmap (mkPath False) $ ((++) <$> (try ((++) <$> many (oneOf pathChars) <*> fmap (:[]) slash) "path") - <*> some (oneOf pathChars <|> slash)) + <*> fmap concat + ( some (some (oneOf pathChars) + <|> liftA2 (:) slash (some (oneOf pathChars))) + ) + ) "path" nixLet :: Parser NExpr diff --git a/Nix/Pretty.hs b/Nix/Pretty.hs index d49d0de..db25f03 100644 --- a/Nix/Pretty.hs +++ b/Nix/Pretty.hs @@ -1,5 +1,6 @@ module Nix.Pretty where +import Data.Fix import Data.Map (toList) import Data.Maybe (isJust) import Data.Text (Text, unpack, replace, strip) diff --git a/Nix/Types.hs b/Nix/Types.hs index 7ff3fe4..8936005 100644 --- a/Nix/Types.hs +++ b/Nix/Types.hs @@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} @@ -12,6 +11,7 @@ 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) @@ -27,14 +27,6 @@ import GHC.Generics import Prelude hiding (readFile, concat, concatMap, elem, mapM, sequence, minimum, foldr) -newtype Fix (f :: * -> *) = Fix { outF :: f (Fix f) } - -cata :: Functor f => (f a -> a) -> Fix f -> a -cata f = f . fmap (cata f) . outF - -cataM :: (Traversable f, Monad m) => (f a -> m a) -> Fix f -> m a -cataM f = f <=< mapM (cataM f) . outF - -- | 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 @@ -287,14 +279,6 @@ data Formals r | FormalRightAt (FormalParamSet r) Text deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show, Foldable, Traversable) --- | @formalsAsMap@ combines the outer and inner name bindings of --- 'Formals' -formalsAsMap :: Formals r -> Map Text (Maybe r) -formalsAsMap (FormalName n) = Map.singleton n Nothing -formalsAsMap (FormalSet (FormalParamSet s)) = s -formalsAsMap (FormalLeftAt n (FormalParamSet s)) = Map.insert n Nothing s -formalsAsMap (FormalRightAt (FormalParamSet s) n) = Map.insert n Nothing s - data NExprF r -- value types = NConstant NAtom @@ -321,10 +305,6 @@ data NExprF r type NExpr = Fix NExprF -instance Show (Fix NExprF) where showsPrec p (Fix f) = showsPrec p 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 - mkInt :: Integer -> NExpr mkInt = Fix . NConstant . NInt @@ -379,7 +359,6 @@ instance Show f => Show (NValueF f) where showsCon1 con a d = showParen (d > 10) $ showString (con ++ " ") . showsPrec 11 a type NValue = Fix NValueF -instance Show (Fix NValueF) where showsPrec p (Fix f) = showsPrec p f valueText :: NValue -> Text valueText = cata phi where diff --git a/default.nix b/default.nix index bf95da4..8f259bc 100644 --- a/default.nix +++ b/default.nix @@ -1,5 +1,5 @@ { cabal, parsers, trifecta, text, ansiWlPprint, parsec, transformers -, tasty, tastyHunit, tastyTh, unorderedContainers +, tasty, tastyHunit, tastyTh, unorderedContainers, dataFix , useParsec ? true }: @@ -11,7 +11,7 @@ cabal.mkDerivation (self: rec { isExecutable = true; noHaddock = true; buildDepends = [ - ansiWlPprint text transformers parsers + ansiWlPprint text transformers parsers dataFix ] ++ (if useParsec then [ parsec ] else [ trifecta ]); testDepends = [ tasty tastyHunit tastyTh unorderedContainers diff --git a/hnix.cabal b/hnix.cabal index d63a9a2..438ebe1 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -49,6 +49,7 @@ Library , transformers , parsers >= 0.10 , unordered-containers + , data-fix if flag(parsec) Cpp-options: -DUSE_PARSEC Build-depends: parsec @@ -80,6 +81,7 @@ Executable hnix , hnix , containers , ansi-wl-pprint + , data-fix Ghc-options: -Wall Test-suite hnix-tests @@ -93,6 +95,7 @@ Test-suite hnix-tests base >= 4.3 && < 5 , containers , text + , data-fix , hnix , tasty , tasty-th diff --git a/main/Nix.hs b/main/Nix.hs index b28575f..96b885c 100644 --- a/main/Nix.hs +++ b/main/Nix.hs @@ -5,9 +5,10 @@ import Nix.Pretty import Nix.Eval import Nix.Types -import Text.PrettyPrint.ANSI.Leijen +import Data.Fix import System.Environment import System.IO +import Text.PrettyPrint.ANSI.Leijen import qualified Data.Map as Map diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs index 1d59794..d3d8f67 100644 --- a/tests/ParserTests.hs +++ b/tests/ParserTests.hs @@ -2,10 +2,11 @@ {-# LANGUAGE OverloadedStrings #-} module ParserTests (tests) where +import Data.Fix +import Data.Text (pack) import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.TH -import Data.Text (pack) import qualified Data.Map as Map