Skip to content

Commit

Permalink
Add support for bytestring
Browse files Browse the repository at this point in the history
  • Loading branch information
jtojnar committed May 19, 2024
1 parent e7e5187 commit a304434
Show file tree
Hide file tree
Showing 9 changed files with 149 additions and 14 deletions.
14 changes: 14 additions & 0 deletions data/bytestring.settings
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
[bytestring]
basic-double=b"foo"
basic-single=b'bar'
empty-double=b""
empty-single=b''
escapes-double=b"\\\a\b\f\n\r\t\v\c\d\e\"'\'"
escapes-single=b'\\\a\b\f\n\r\t\v\c\d\e\""\''
line-continues-double=b"start \
more"
line-continues-single=b'start \
more'
nix-dollar=b"$"
no-unicode=b"\u202F"
octal=b'\7777\1\28\33\449\555\8\42\176\177'
3 changes: 3 additions & 0 deletions data/dconf.settings
Original file line number Diff line number Diff line change
Expand Up @@ -326,3 +326,6 @@ saved-game=@m(yyda(yyyyyyyy)ua(yyyyu)) nothing
[org/gnome/evince]
document-directory=@ms nothing
pictures-directory=@ms nothing

[org/gnome/easytag]
default-path=b'/home/alice/Music'
1 change: 1 addition & 0 deletions dconf2nix.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ library
, optparse-applicative
, parsec >= 3.1.16.0
, text
, utf8-string
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall
Expand Down
23 changes: 23 additions & 0 deletions output/bytestring.nix
Original file line number Diff line number Diff line change
@@ -0,0 +1,23 @@
# Generated via dconf2nix: https://github.com/nix-commmunity/dconf2nix
{ lib, ... }:

with lib.hm.gvariant;

{
dconf.settings = {
"bytestring" = {
basic-double = mkByteString ''foo'';
basic-single = mkByteString ''bar'';
empty-double = mkByteString '''';
empty-single = mkByteString '''';
escapes-double = mkByteString ''\\\a\b\f\n\r\t\vcde"${"'"}${"'"}'';
escapes-single = mkByteString ''\\\a\b\f\n\r\t\vcde""${"'"}'';
line-continues-double = mkByteString ''start more'';
line-continues-single = mkByteString ''start more'';
nix-dollar = mkByteString ''${"$"}'';
no-unicode = mkByteString ''u202F'';
octal = mkByteString ''\3777\1\28\33${"$"}9m8"~\177'';
};

};
}
4 changes: 4 additions & 0 deletions output/dconf.nix
Original file line number Diff line number Diff line change
Expand Up @@ -409,5 +409,9 @@ with lib.hm.gvariant;
pictures-directory = mkNothing "s";
};

"org/gnome/easytag" = {
default-path = mkByteString ''/home/alice/Music'';
};

};
}
72 changes: 58 additions & 14 deletions src/DConf.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,12 +7,14 @@ module DConf
)
where

import Codec.Binary.UTF8.String ( encodeChar )
import Control.Monad ( replicateM )
import Data.Ix ( inRange )
import qualified Data.Map as Map
import Data.Maybe ( catMaybes )
import Data.Text ( Text )
import qualified Data.Text as T
import Data.Word ( Word8 )
import DConf.Data
import Text.Parsec
import Data.Char
Expand All @@ -22,7 +24,8 @@ charExcept cc = satisfy $ \c -> not $ elem c cc

bracket :: String -> String -> Parsec Text () a -> Parsec Text () a
bracket s1 s2 pa = do
_ <- string s1
-- Avoid consuming prefix to prevent conflict between b' and boolean cast.
_ <- string' s1
a <- pa
_ <- string s2
return a
Expand Down Expand Up @@ -74,6 +77,22 @@ vCast = do
vTuple :: Parsec Text () Value
vTuple = T <$> (bracket "(" ")" $ sepOneEndBy value comma)

-- | Escape sequences common to strings and bytestrings
commonEscapes :: Parsec Text () (Maybe Char)
commonEscapes =
-- The usual control sequence escapes `\a`, `\b`, `\f`, `\n`, `\r`, `\t` and `\v` are supported.
(char 'a' *> pure (Just '\a'))
<|> (char 'b' *> pure (Just '\b'))
<|> (char 'f' *> pure (Just '\f'))
<|> (char 'n' *> pure (Just '\n'))
<|> (char 'r' *> pure (Just '\r'))
<|> (char 't' *> pure (Just '\t'))
<|> (char 'v' *> pure (Just '\v'))
-- Additionally, a `\` before a newline character causes the newline to be ignored.
<|> (char '\n' *> pure Nothing)
-- Finally, any other character following `\` is copied literally (for example, `\"` or `\\`)
<|> (Just <$> anyChar)

vString :: Parsec Text () Text
vString = T.pack <$> (single <|> double)
where
Expand Down Expand Up @@ -101,29 +120,54 @@ vString = T.pack <$> (single <|> double)
-- Unicode escapes of the form `\uxxxx` and `\Uxxxxxxxx` are supported, in hexadecimal.
(char 'u' *> (Just <$> (chr <$> hexNum 4)))
<|> (char 'U' *> (Just <$> (chr <$> hexNum 8)))
-- The usual control sequence escapes `\a`, `\b`, `\f`, `\n`, `\r`, `\t` and `\v` are supported.
<|> (char 'a' *> pure (Just '\a'))
<|> (char 'b' *> pure (Just '\b'))
<|> (char 'f' *> pure (Just '\f'))
<|> (char 'n' *> pure (Just '\n'))
<|> (char 'r' *> pure (Just '\r'))
<|> (char 't' *> pure (Just '\t'))
<|> (char 'v' *> pure (Just '\v'))
-- Additionally, a `\` before a newline character causes the newline to be ignored.
<|> (char '\n' *> pure Nothing)
-- Finally, any other character following `\` is copied literally (for example, `\"` or `\\`)
<|> (Just <$> anyChar))
<|> commonEscapes)

inputs :: [Char] -> Parsec Text () String
inputs extra = catMaybes <$> (many $ qchar <|> (Just <$> lchar extra))


fromOctDigit :: Char -> Int
fromOctDigit n | inRange ('0', '7') n = ord n - ord '0'
fromOctDigit n = error $ "Expected an octal digit, '" ++ n : "' given"

-- | Parses an octal number between 1 and @maxlen@ digits.
octNumMax :: Int -> Parsec Text () Int
octNumMax maxLen = octNum' 0 maxLen
where
octNum' :: Int -> Int -> Parsec Text () Int
octNum' acc 0 = return acc
octNum' acc l = do
d <- fromOctDigit <$> octDigit
let acc' = acc * 8 + d
octNum' acc' (l - 1) <|> octNum' acc' 0

vByteString :: Parsec Text () Value
vByteString = Bs <$> (single <|> double)
where
single = bracket "b'" "'" $ bs "'"
double = bracket "b\"" "\"" $ bs "\""

lchar :: [Char] -> Parsec Text () [Word8]
lchar extra = encodeChar <$> (charExcept $ "\r\n\\" <> extra)

qchar :: Parsec Text () [Word8]
qchar = do
_ <- char '\\'
(
-- Octal number (wrapped to 0-255)
((:[]) . fromIntegral . toInteger <$> octNumMax 3)
<|> (maybe [] encodeChar <$> commonEscapes))

bs :: [Char] -> Parsec Text () [Word8]
bs extra = concat <$> (many $ qchar <|> lchar extra)

baseValue :: Parsec Text () Value
baseValue = choice
[vBool, vInt, vDouble, fmap S vString]

value :: Parsec Text () Value
value = choice
[vTyped, vDictDictEntry, vList, vJson, baseValue, vCast, vNothing, vTuple, vVariant]
[vTyped, vDictDictEntry, vList, vJson, baseValue, vByteString, vCast, vNothing, vTuple, vVariant]

vVariant :: Parsec Text () Value
vVariant = fmap V $ bracket "<" ">" value
Expand Down
2 changes: 2 additions & 0 deletions src/DConf/Data.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ module DConf.Data where

import Data.Map ( Map )
import Data.Text ( Text )
import Data.Word ( Word8 )

newtype InputFilePath = InputFilePath FilePath deriving Show
newtype OutputFilePath = OutputFilePath FilePath deriving Show
Expand Down Expand Up @@ -51,6 +52,7 @@ data Value = S Text -- String
| T [Value] -- Tuple of n-arity
| Ty String Value -- Typed value
| L [Value] -- List of values
| Bs [Word8] -- Byte string (special syntax for array of bytes)
| V Value -- Variant
| R [(Value,Value)] -- Dictionary
| DE Value Value -- Dictionary entry
Expand Down
34 changes: 34 additions & 0 deletions src/Nix.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,11 @@ module Nix
)
where

import Data.Char ( chr, ord )
import Data.Function ( (&) )
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Word ( Word8 )
import DConf.Data

renderHeader :: Header
Expand Down Expand Up @@ -108,6 +110,7 @@ renderValue raw = Nix $ renderValue' raw <> ";"
renderValue' (Ty ('a':t) (L v)) = "mkArray " <> T.pack (show t) <> " " <> renderList v
-- TODO: add mkTyped to h-m
renderValue' (Ty t v) = "mkTyped " <> T.pack (show t) <> " " <> renderItem v
renderValue' (Bs v) = "mkByteString " <> renderByteString v
renderValue' (V v) = "mkVariant " <> renderItem v
renderValue' (Json v) =
"''\n" <> mkSpaces 8 <> T.strip v <> "\n" <> mkSpaces 6 <> "''"
Expand All @@ -124,3 +127,34 @@ renderString text = "\"" <> escaped <> "\""
& T.replace "\n" "\\n"
& T.replace "$" "\\$"
& T.replace "\"" "\\\""

-- We are going to use doubled apostrophes to avoid the need to escape backslashes.
renderByteString :: [Word8] -> T.Text
renderByteString bs = "''" <> T.pack (concatMap encode bs) <> "''"
where
encode :: Word8 -> String
encode b =
case chr (fromIntegral b) of
'\a' -> "\\a"
'\b' -> "\\b"
'\f' -> "\\f"
'\n' -> "\\n"
'\r' -> "\\r"
'\t' -> "\\t"
'\v' -> "\\v"
'\\' -> "\\\\"
-- We do not need to escape double quotes. Instead we care about dollars and apostrophes.
-- This is overly aggressive but keeping the implementation simple for now.
'$' -> "${\"$\"}"
'\'' -> "${\"'\"}"
c ->
if c < ' ' || c >= '\127' then
"\\" <> oct "" b
else
[c]

oct :: String -> Word8 -> String
oct acc 0 = acc
oct acc n = oct (chr (fromIntegral (fromIntegral (ord '0') + remainder)) : acc) quotient
where
(quotient, remainder) = n `divMod` 8
10 changes: 10 additions & 0 deletions test/DConf2NixTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,16 @@ dconf2nix =
root = Root T.empty
in baseProperty input output root

dconf2nixBytestring :: Property
dconf2nixBytestring =
let input = "data/bytestring.settings"
output = "output/bytestring.nix"
root = Root T.empty
in baseProperty input output root

prop_dconf2nix_bytestring :: Property
prop_dconf2nix_bytestring = withTests (10 :: TestLimit) dconf2nixBytestring

prop_dconf2nix_custom_root :: Property
prop_dconf2nix_custom_root = withTests (10 :: TestLimit) dconf2nixCustomRoot

Expand Down

0 comments on commit a304434

Please sign in to comment.