language-nix 2 → 2.1
raw patch · 4 files changed
+168/−59 lines, 4 filesdep +Cabaldep +base-compatdep −regex-posixdep ~pretty
Dependencies added: Cabal, base-compat
Dependencies removed: regex-posix
Dependency ranges changed: pretty
Files
- language-nix.cabal +13/−9
- src/Language/Nix/Binding.hs +51/−14
- src/Language/Nix/Identifier.hs +59/−16
- src/Language/Nix/Path.hs +45/−20
language-nix.cabal view
@@ -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
src/Language/Nix/Binding.hs view
@@ -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])))
src/Language/Nix/Identifier.hs view
@@ -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
src/Language/Nix/Path.hs view
@@ -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)