diff --git a/language-nix.cabal b/language-nix.cabal --- a/language-nix.cabal +++ b/language-nix.cabal @@ -3,22 +3,23 @@ -- see: https://github.com/sol/hpack name: language-nix -version: 2 +version: 2.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/nixos/cabal2nix#readme -bug-reports: https://github.com/nixos/cabal2nix/issues +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.2 build-type: Simple cabal-version: >= 1.10 source-repository head type: git - location: https://github.com/nixos/cabal2nix + location: https://github.com/peti/language-nix library hs-source-dirs: @@ -26,10 +27,12 @@ ghc-options: -Wall build-depends: base < 5 + , base-compat + , Cabal , deepseq , lens - , pretty >= 1.1.2 - , regex-posix + , pretty + , QuickCheck exposed-modules: Language.Nix Language.Nix.Binding @@ -45,10 +48,11 @@ ghc-options: -Wall build-depends: base < 5 + , base-compat + , Cabal , deepseq , lens - , pretty >= 1.1.2 - , regex-posix - , doctest + , pretty , QuickCheck + , doctest default-language: Haskell2010 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,34 +1,71 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} module Language.Nix.Binding ( Binding, binding, localName, reference ) where import Control.DeepSeq import Control.Lens -import Text.PrettyPrint.HughesPJClass +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 -- | A 'Binding' represents an identifier that refers to some other 'Path'. +-- +-- >>> :set -XOverloadedStrings +-- >>> "inherit (foo.bar) abc" :: Binding +-- Bind (Identifier "abc") (Path [Identifier "foo",Identifier "bar",Identifier "abc"]) +-- +-- prop> \b -> Just (b :: Binding) == simpleParse (display b) declareLenses [d| data Binding = Bind { localName :: Identifier, reference :: Path } - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) |] binding :: Iso' Binding (Identifier,Path) binding = iso (\(Bind l r) -> (l,r)) (uncurry Bind) -instance NFData Binding where rnf (Bind l r) = l `deepseq` rnf r +instance NFData Binding where + rnf (Bind l r) = l `deepseq` rnf r -instance Pretty Binding where - pPrint b = case (init ps, last ps) of - ([], i') -> if i == i' - then text "inherit" <+> pPrint i' <> semi - else pPrint i <+> equals <+> pPrint p <> semi - (p', i') -> if i == i' - then text "inherit" <+> parens (pPrint (path # p')) <+> pPrint i' <> semi - else pPrint i <+> equals <+> pPrint p <> semi +instance Arbitrary Binding where + arbitrary = review binding <$> arbitrary - where - (i, p) = view binding b - ps = view path p +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 + + where + (i, p) = view binding b + ps = view path p + + parse = parseAssignment +++ parseInherit + +instance IsString Binding where + fromString s = fromMaybe (error ("invalid Nix binding: " ++ s)) (simpleParse s) + +parseAssignment :: ReadP r Binding +parseAssignment = do l <- skipSpaces >> parse + _ <- skipSpaces >> ReadP.char '=' + r <- skipSpaces >> parse + 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 + 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,5 +1,7 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} module Language.Nix.Identifier ( @@ -8,14 +10,17 @@ -- @Identifier@s are an instance of the 'IsString' class. -- -- Reasonable people restrict themselves to identifiers of the form - -- @[a-zA-Z\_][a-zA-Z0-9\_\'\-]*@, because these don't need quoting. The - -- methods of the 'Pretty' class can be used to pretty-print an identifier - -- with proper quoting: + -- @[a-zA-Z_][a-zA-Z0-9_'-]*@, because these don't need quoting. The + -- methods of the 'Text' class can be used to parse and pretty-print an + -- identifier with proper quoting: -- - -- >>> pPrint (ident # "test") + -- >>> disp (ident # "test") -- test - -- >>> pPrint (ident # "foo.bar") + -- >>> disp (ident # "foo.bar") -- "foo.bar" + -- + -- prop> \str -> Just (ident # str) == simpleParse (quote str) + -- prop> \i -> Just (i :: Identifier) == simpleParse (display i) Identifier , -- | An isomorphism that allows conversion of 'Identifier' from/to the @@ -35,30 +40,68 @@ quote , -- | Checks whether a given string needs quoting when interpreted as an - -- 'Identifier'. + -- 'Identifier'. Simple identifiers that don't need quoting match the + -- regular expression @^[a-zA-Z_][a-zA-Z0-9_'-]*$@. needsQuoting + , -- | 'ReadP' parser for simple identifiers, i.e. those that don't need + -- quoting. + parseSimpleIdentifier + + , -- | 'ReadP' parser for quoted identifiers, i.e. those that /do/ need + -- quoting. + parseQuotedIdentifier + ) where import Control.DeepSeq import Control.Lens +import Data.Char import Data.String -import Text.PrettyPrint.HughesPJClass -import Text.Regex.Posix +import Distribution.Compat.ReadP as ReadP +import Distribution.Text +import GHC.Generics ( Generic ) +import Prelude.Compat +import Test.QuickCheck +import Text.PrettyPrint as PP declareLenses [d| newtype Identifier = Identifier { ident :: String } - deriving (Show, Eq, Ord, IsString) + deriving (Show, Eq, Ord, IsString, Generic) |] -instance Pretty Identifier where - pPrint i = text (i ^. ident . to quote) +instance NFData Identifier where + rnf (Identifier str) = rnf str -instance NFData Identifier where rnf (Identifier str) = rnf str +instance Arbitrary Identifier where + arbitrary = Identifier <$> arbitrary + shrink (Identifier i) = map Identifier (shrink i) +instance Text Identifier where + disp = view (ident . to quote . to text) + parse = parseQuotedIdentifier <++ parseSimpleIdentifier + +parseSimpleIdentifier :: ReadP r Identifier +parseSimpleIdentifier = do + c <- satisfy (\x -> x == '_' || isAlpha x) + cs <- munch (\x -> x `elem` "_'-" || isAlphaNum x) + return (Identifier (c:cs)) + +parseQuotedIdentifier :: ReadP r Identifier +parseQuotedIdentifier = Identifier . read . fst + <$> gather (between (ReadP.char '"') (ReadP.char '"') (many qString)) + where + qString :: ReadP r String + qString = quotedPair <++ munch1 (`notElem` "\\\"") + + quotedPair :: ReadP r String + quotedPair = do + c1 <- ReadP.char '\\' + c2 <- get + return [c1,c2] + needsQuoting :: String -> Bool -needsQuoting str = not (str =~ grammar) - where grammar :: String -- TODO: should be a compiled regular expression - grammar = "^[a-zA-Z\\_][a-zA-Z0-9\\_\\'\\-]*$" +needsQuoting s = null r || not (any (null . snd) r) + where r = readP_to_S parseSimpleIdentifier s quote :: String -> String quote s = if needsQuoting s then show s else s 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,11 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} module Language.Nix.Path ( Path, path ) where import Control.DeepSeq 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 Text.PrettyPrint.HughesPJClass ( Pretty (..), char, hcat, punctuate ) +import Prelude.Compat +import Test.QuickCheck +import Text.PrettyPrint as PP -- | Paths are non-empty lists of identifiers in Nix. -- @@ -17,35 +26,51 @@ -- >>> path # [] -- Path *** Exception: Nix paths cannot be empty -- --- 'Identifier' is an instance of 'IsString': +-- 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) +-- foo.foo.bar.bar +-- +-- prop> \p -> Just (p :: Path) == simpleParse (display p) +-- +-- Paths are instances of strings and can be implicitly converted: +-- -- >>> :set -XOverloadedStrings --- >>> pPrint $ path # ["yo","bar"] +-- >>> disp $ ("yo.bar" :: Path) -- yo.bar +-- >>> disp $ (" yo . bar " :: Path) +-- yo.bar -- --- Freaky quoted identifiers are fine except in the first segment: +-- Freaky quoted identifiers are fine throughout: -- --- >>> pPrint $ path # ["yo","b\"ar"] +-- >>> disp $ path # ["yo","b\"ar"] -- yo."b\"ar" --- >>> pPrint $ path # ["5ident"] --- *** Exception: invalid Nix path: [Identifier "5ident"] --- >>> pPrint $ path # ["5ident","foo","bar"] --- *** Exception: invalid Nix path: [Identifier "5ident",Identifier "foo",Identifier "bar"] +-- >>> disp ("\"5ident\"" :: Path) +-- "5ident" +-- >>> disp $ path # ["5ident","foo.bar","foo\nbar"] +-- "5ident"."foo.bar"."foo\nbar" declareLenses [d| newtype Path = Path [Identifier] - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) |] -instance NFData Path where rnf (Path p) = rnf p +instance NFData Path where + rnf (Path p) = rnf p -instance Pretty Path where - pPrint p = hcat $ punctuate (char '.') $ pPrint <$> p^.path +instance Text Path where + disp p = hcat $ punctuate (PP.char '.') (map disp (p^.path)) + parse = review path <$> sepBy (skipSpaces >> parse) (skipSpaces >> ReadP.char '.') +instance IsString Path where + fromString s = fromMaybe (error ("invalid Nix path: " ++ s)) (simpleParse s) + +instance Arbitrary Path where + arbitrary = Path <$> listOf1 arbitrary + +-- | Use this isomorphism to construct a path from a list of identifiers, or to +-- access that list for a given path. + path :: Iso' Path [Identifier] -path = iso (\(Path p) -> p) mkPath - where - mkPath :: [Identifier] -> Path - mkPath [] = error "Nix paths cannot be empty" - mkPath p@(s0:_) - | s0^.ident.to needsQuoting = error ("invalid Nix path: " ++ show p) - | otherwise = Path p +path = iso (\(Path p) -> p) (\p -> if null p then error "Nix paths cannot be empty" else Path p)