diff --git a/language-nix.cabal b/language-nix.cabal --- a/language-nix.cabal +++ b/language-nix.cabal @@ -1,60 +1,33 @@ --- This file has been generated from package.yaml by hpack version 0.12.0. --- --- see: https://github.com/sol/hpack - -name: language-nix -version: 2.1.0.1 -synopsis: Data types and useful functions to represent and manipulate the Nix language. -description: Data types and useful functions to represent and manipulate the Nix language. -category: Distribution, Language -homepage: https://github.com/peti/language-nix#readme -bug-reports: https://github.com/peti/language-nix/issues -author: Peter Simons -maintainer: simons@cryp.to -license: BSD3 -license-file: LICENSE -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 -build-type: Simple -cabal-version: >= 1.10 +name: language-nix +version: 2.2.0 +synopsis: Data types and functions to represent the Nix language +description: Data types and useful functions to represent and manipulate the Nix + language. +license: BSD3 +license-file: LICENSE +author: Peter Simons +maintainer: simons@cryp.to +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1 +category: Distribution, Language, Nix +homepage: https://github.com/peti/language-nix#readme +bug-reports: https://github.com/peti/language-nix/issues +build-type: Simple +cabal-version: >= 1.10 source-repository head - type: git + type: git location: https://github.com/peti/language-nix library - hs-source-dirs: - src - ghc-options: -Wall - build-depends: - base < 5 - , base-compat - , Cabal - , deepseq - , lens - , pretty - , QuickCheck - exposed-modules: - Language.Nix - Language.Nix.Binding - Language.Nix.Identifier - Language.Nix.Path - other-modules: - Paths_language_nix - default-language: Haskell2010 - -test-suite spec - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: - test - ghc-options: -Wall - build-depends: - base < 5 - , base-compat - , Cabal - , deepseq - , lens - , pretty - , QuickCheck - , doctest + exposed-modules: Language.Nix + Language.Nix.Binding + Language.Nix.Identifier + Language.Nix.Path + other-modules: Paths_language_nix + hs-source-dirs: src + build-depends: base < 5, QuickCheck, deepseq, lens, parsec-class, pretty default-language: Haskell2010 + other-extensions: FlexibleContexts + TemplateHaskell + GeneralizedNewtypeDeriving + DeriveGeneric diff --git a/src/Language/Nix/Binding.hs b/src/Language/Nix/Binding.hs --- a/src/Language/Nix/Binding.hs +++ b/src/Language/Nix/Binding.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} module Language.Nix.Binding ( Binding, binding, localName, reference ) where @@ -8,14 +8,12 @@ import Control.Lens import Data.Maybe import Data.String -import Distribution.Compat.ReadP as ReadP -import Distribution.Text import GHC.Generics ( Generic ) import Language.Nix.Identifier import Language.Nix.Path -import Prelude.Compat import Test.QuickCheck -import Text.PrettyPrint as PP +import Text.Parsec.Class as P +import Text.PrettyPrint.HughesPJClass as PP -- | A 'Binding' represents an identifier that refers to some other 'Path'. -- @@ -23,7 +21,7 @@ -- >>> "inherit (foo.bar) abc" :: Binding -- Bind (Identifier "abc") (Path [Identifier "foo",Identifier "bar",Identifier "abc"]) -- --- prop> \b -> Just (b :: Binding) == simpleParse (display b) +-- prop> \b -> Just (b :: Binding) == parseM "Binding" (prettyShow b) declareLenses [d| data Binding = Bind { localName :: Identifier, reference :: Path } deriving (Show, Eq, Ord, Generic) @@ -38,34 +36,37 @@ instance Arbitrary Binding where arbitrary = review binding <$> arbitrary -instance Text Binding where - disp b = case (init ps, last ps) of - ([], i') -> if i == i' - then text "inherit" <+> disp i' - else disp i <+> equals <+> disp p - (p', i') -> if i == i' - then text "inherit" <+> parens (disp (path # p')) <+> disp i' - else disp i <+> equals <+> disp p +instance CoArbitrary Binding - where - (i, p) = view binding b - ps = view path p +instance Pretty Binding where + pPrint b = case (init ps, last ps) of + ([], i') -> if i == i' + then text "inherit" <+> pPrint i' + else pPrint i <+> equals <+> pPrint p + (p', i') -> if i == i' + then text "inherit" <+> parens (pPrint (path # p')) <+> pPrint i' + else pPrint i <+> equals <+> pPrint p - parse = parseAssignment +++ parseInherit + where + (i, p) = view binding b + ps = view path p +instance HasParser Binding where + parser = try parseInherit <|> parseAssignment + instance IsString Binding where - fromString s = fromMaybe (error ("invalid Nix binding: " ++ s)) (simpleParse s) + fromString = parse "Language.Nix.Binding.Binding" -parseAssignment :: ReadP r Binding -parseAssignment = do l <- skipSpaces >> parse - _ <- skipSpaces >> ReadP.char '=' - r <- skipSpaces >> parse +parseAssignment :: CharParser st tok m Binding +parseAssignment = do l <- spaces >> parser + _ <- spaces >> P.char '=' + r <- spaces >> parser return (binding # (l,r)) -parseInherit :: ReadP r Binding -parseInherit = do _ <- skipSpaces >> ReadP.string "inherit" - p <- option [] $ between (skipSpaces >> ReadP.char '(') - (skipSpaces >> ReadP.char ')') - (skipSpaces >> view path <$> parse) - i <- skipSpaces >> parse +parseInherit :: CharParser st tok m Binding +parseInherit = do _ <- spaces >> P.string "inherit" >> lookAhead (P.space <|> P.char '(') + p <- option [] $ try $ between (spaces >> P.char '(') + (spaces >> P.char ')') + (spaces >> view path <$> parser) + i <- spaces >> parser return (binding # (i, path # (p ++ [i]))) diff --git a/src/Language/Nix/Identifier.hs b/src/Language/Nix/Identifier.hs --- a/src/Language/Nix/Identifier.hs +++ b/src/Language/Nix/Identifier.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} module Language.Nix.Identifier @@ -12,13 +12,12 @@ import Control.DeepSeq import Control.Lens import Data.Char +import Data.Either import Data.String -import Distribution.Compat.ReadP as ReadP -import Distribution.Text import GHC.Generics ( Generic ) -import Prelude.Compat import Test.QuickCheck -import Text.PrettyPrint as PP +import Text.Parsec.Class as P +import Text.PrettyPrint.HughesPJClass as PP -- | Identifiers in Nix are essentially strings. They can be constructed -- (and viewed) with the 'ident' isomorphism. For the sake of convenience, @@ -29,13 +28,13 @@ -- methods of the 'Text' class can be used to parse and pretty-print an -- identifier with proper quoting: -- --- >>> disp (ident # "test") +-- >>> pPrint (ident # "test") -- test --- >>> disp (ident # "foo.bar") +-- >>> pPrint (ident # "foo.bar") -- "foo.bar" -- --- prop> \str -> Just (ident # str) == simpleParse (quote str) --- prop> \i -> Just (i :: Identifier) == simpleParse (display i) +-- prop> \str -> Just (ident # str) == parseM "Ident" (quote str) +-- prop> \i -> Just (i :: Identifier) == parseM "Ident" (prettyShow i) declareLenses [d| newtype Identifier = Identifier { ident :: String } deriving (Show, Eq, Ord, IsString, Generic) |] @@ -50,42 +49,47 @@ rnf (Identifier str) = rnf str instance Arbitrary Identifier where - arbitrary = Identifier <$> arbitrary + arbitrary = Identifier <$> listOf1 arbitraryUnicodeChar shrink (Identifier i) = map Identifier (shrink i) -instance Text Identifier where - disp = view (ident . to quote . to text) - parse = parseQuotedIdentifier <++ parseSimpleIdentifier +instance CoArbitrary Identifier --- | 'ReadP' parser for simple identifiers, i.e. those that don't need --- quoting. -parseSimpleIdentifier :: ReadP r Identifier +instance Pretty Identifier where + pPrint = view (ident . to quote . to text) + +instance HasParser Identifier where + parser = parseQuotedIdentifier <|> parseSimpleIdentifier + +-- | Parsec parser for simple identifiers, i.e. those that don't need quoting. +parseSimpleIdentifier :: CharParser st tok m Identifier parseSimpleIdentifier = do c <- satisfy (\x -> x == '_' || isAlpha x) - cs <- munch (\x -> x `elem` "_'-" || isAlphaNum x) + cs <- many (satisfy (\x -> x `elem` "_'-" || isAlphaNum x)) return (Identifier (c:cs)) -- | 'ReadP' parser for quoted identifiers, i.e. those that /do/ need -- quoting. -parseQuotedIdentifier :: ReadP r Identifier -parseQuotedIdentifier = Identifier . read . fst - <$> gather (between (ReadP.char '"') (ReadP.char '"') (many qString)) +parseQuotedIdentifier :: CharParser st tok m Identifier +parseQuotedIdentifier = Identifier <$> qstring where - qString :: ReadP r String - qString = quotedPair <++ munch1 (`notElem` "\\\"") + qstring :: CharParser st tok m String + qstring = do txt <- between (P.char '"') (P.char '"') (many qtext) + return (read ('"' : concat txt ++ ['"'])) - quotedPair :: ReadP r String + qtext :: CharParser st tok m String + qtext = quotedPair <|> many1 (P.noneOf "\\\"") + + quotedPair :: CharParser st tok m String quotedPair = do - c1 <- ReadP.char '\\' - c2 <- get + c1 <- P.char '\\' + c2 <- anyChar return [c1,c2] -- | Checks whether a given string needs quoting when interpreted as an -- 'Identifier'. Simple identifiers that don't need quoting match the -- regular expression @^[a-zA-Z_][a-zA-Z0-9_'-]*$@. needsQuoting :: String -> Bool -needsQuoting s = null r || not (any (null . snd) r) - where r = readP_to_S parseSimpleIdentifier s +needsQuoting = isLeft . runParser (parseSimpleIdentifier >> eof) () "" -- | Helper function to quote a given identifier string if necessary. -- diff --git a/src/Language/Nix/Path.hs b/src/Language/Nix/Path.hs --- a/src/Language/Nix/Path.hs +++ b/src/Language/Nix/Path.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} module Language.Nix.Path ( Path, path ) where @@ -8,16 +7,14 @@ import Control.Lens import Data.Maybe import Data.String -import Distribution.Compat.ReadP as ReadP -import Distribution.Text import GHC.Generics ( Generic ) import Language.Nix.Identifier -import Prelude.Compat import Test.QuickCheck -import Text.PrettyPrint as PP +import Text.Parsec.Class as P +import Text.PrettyPrint.HughesPJClass as PP -- $setup --- >>> import Control.Exception +-- >>> import Control.Exception as Excpt -- | Paths are non-empty lists of identifiers in Nix. -- @@ -27,33 +24,33 @@ -- Any attempt to construct the empty path throws an 'error': -- -- >>> :set -XScopedTypeVariables --- >>> either (\(_::SomeException) -> "empty paths are illegal") show <$> try (evaluate (path # [])) +-- >>> either (\(_::SomeException) -> "empty paths are illegal") show <$> Excpt.try (evaluate (path # [])) -- "empty paths are illegal" -- -- Paths can be pretty-printed and parsed with the 'Text' class: -- --- >>> simpleParse "foo.\"foo.bar\".bar" :: Maybe Path --- Just (Path [Identifier "foo",Identifier "foo.bar",Identifier "bar"]) --- >>> maybe empty disp (simpleParse "foo.\"foo\".\"bar\".bar" :: Maybe Path) +-- >>> parse "Path" "foo.\"foo.bar\".bar" :: Path +-- Path [Identifier "foo",Identifier "foo.bar",Identifier "bar"] +-- >>> pPrint (parse "Path" "foo.\"foo\".\"bar\".bar" :: Path) -- foo.foo.bar.bar -- --- prop> \p -> Just (p :: Path) == simpleParse (display p) +-- prop> \p -> Just (p :: Path) == parseM "Path" (prettyShow p) -- -- Paths are instances of strings and can be implicitly converted: -- -- >>> :set -XOverloadedStrings --- >>> disp $ ("yo.bar" :: Path) +-- >>> pPrint $ ("yo.bar" :: Path) -- yo.bar --- >>> disp $ (" yo . bar " :: Path) +-- >>> pPrint $ (" yo . bar" :: Path) -- yo.bar -- -- Freaky quoted identifiers are fine throughout: -- --- >>> disp $ path # ["yo","b\"ar"] +-- >>> pPrint $ path # ["yo","b\"ar"] -- yo."b\"ar" --- >>> disp ("\"5ident\"" :: Path) +-- >>> pPrint ("\"5ident\"" :: Path) -- "5ident" --- >>> disp $ path # ["5ident","foo.bar","foo\nbar"] +-- >>> pPrint $ path # ["5ident","foo.bar","foo\nbar"] -- "5ident"."foo.bar"."foo\nbar" declareLenses [d| newtype Path = Path [Identifier] @@ -63,15 +60,19 @@ instance NFData Path where rnf (Path p) = rnf p -instance Text Path where - disp p = hcat $ punctuate (PP.char '.') (map disp (p^.path)) - parse = review path <$> sepBy (skipSpaces >> parse) (skipSpaces >> ReadP.char '.') +instance Pretty Path where + pPrint p = hcat $ punctuate (PP.char '.') (map pPrint (p^.path)) +instance HasParser Path where + parser = review path <$> (spaces >> parser) `sepBy` (spaces >> P.char '.') + instance IsString Path where - fromString s = fromMaybe (error ("invalid Nix path: " ++ s)) (simpleParse s) + fromString = parse "Language.Nix.Path.Path" instance Arbitrary Path where arbitrary = Path <$> listOf1 arbitrary + +instance CoArbitrary Path -- | Use this isomorphism to construct a path from a list of identifiers, or to -- access that list for a given path. diff --git a/test/Main.hs b/test/Main.hs deleted file mode 100644 --- a/test/Main.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main ( main ) where - -import Test.DocTest - -main :: IO () -main = doctest [ "-isrc", "src" ]