@@ -0,0 +1,85 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+
3+module Language.Nix.Identifier ( Identifier, string, quotedString, needsQuoting ) where
4+
5+import Data.Char
6+import Data.Function
7+import Control.Lens
8+import Data.String
9+import Distribution.Nix.Util.PrettyPrinting ( Pretty(..), text )
10+import Text.Regex.Posix
11+
12+-- | Identifiers in Nix are essentially strings. Reasonable people restrict
13+-- themselves to identifiers of the form @[a-zA-Z\_][a-zA-Z0-9\_\'\-]*@,
14+-- though, because these don't need quoting. The @Identifier@ type is an
15+-- instance of the 'IsString' class for construction. The methods of the
16+-- 'Pretty' class can be used to pretty-print an identifier with proper
17+-- quoting.
18+--
19+-- >>> let i = fromString "test" :: Identifier in (i, pPrint i)
20+-- (Identifier "test",test)
21+-- >>> let i = fromString "foo.bar" :: Identifier in (i, pPrint i)
22+-- (Identifier "foo.bar","foo.bar")
23+--
24+-- The 'Ord' instance for identifiers is unusual in that it's aware of
25+-- character's case:
26+--
27+-- >>> (fromString "abc" :: Identifier) == fromString "abc"
28+-- True
29+-- >>> (fromString "abc" :: Identifier) == fromString "ABC"
30+-- False
31+-- >>> (fromString "abc" :: Identifier) > fromString "ABC"
32+-- True
33+-- >>> (fromString "abc" :: Identifier) > fromString "ABC"
34+-- True
35+-- >>> (fromString "X" :: Identifier) > fromString "a"
36+-- True
37+-- >>> (fromString "x" :: Identifier) > fromString "A"
38+-- True
39+--
40+-- prop> \str -> Identifier str == Identifier str
41+-- prop> \str -> any (`elem` ['a'..'z']) str ==> Identifier (map toLower str) /= Identifier (map toUpper str)
42+-- prop> \(NonEmpty str) -> head str `elem` ['a'..'z'] ==> Identifier (map toLower str) >= Identifier (map toUpper str)
43+
44+newtype Identifier = Identifier String
45+ deriving (Show, Eq, IsString)
46+
47+instance Pretty Identifier where
48+ pPrint i = text (i ^. string)
49+
50+instance Ord Identifier where
51+ compare (Identifier a) (Identifier b) =
52+ case (compare `on` map toLower) a b of
53+ EQ -> compare a b
54+ r -> r
55+
56+needsQuoting :: Identifier -> Bool
57+needsQuoting (Identifier str) = not (str =~ "^[a-zA-Z\\_][a-zA-Z0-9\\_\\'\\-]*$")
58+
59+-- | Lens that allows conversion from/to the standard 'String' type.
60+--
61+-- >>> putStrLn $ fromString "abc" ^. string
62+-- abc
63+--
64+-- >>> putStrLn $ fromString "abc.def" ^. string
65+-- "abc.def"
66+--
67+-- >>> pPrint $ fromString "" & string .~ "abcdef"
68+-- abcdef
69+
70+string :: Lens' Identifier String
71+string f (Identifier str) = (\str' -> fromString str') `fmap` f s
72+ where s = if needsQuoting (Identifier str) then show str else str
73+
74+-- | A variant of 'string' that gives read-only access to a string-representation
75+-- of the identifier that is always quoted, even if the identifier actually
76+-- doesn't need quoting.
77+--
78+-- >>> putStrLn $ fromString "abc" ^. quotedString
79+-- "abc"
80+--
81+-- >>> putStrLn $ fromString "abc.def" ^. quotedString
82+-- "abc.def"
83+
84+quotedString :: Getter Identifier String
85+quotedString f (Identifier str) = fmap fromString (f (show str))