Parse all casts

data/typed.settings

@@ -2,7 +2,18 @@
 empty-dict=@a{sv} {}
 empty-array-dict=@a{sv} []
 just-str=@ms 'hello'
-ui32=uint32 7
+boolean=boolean true
+byte=byte 23
+int16=int16 30
+uint16=uint16 25
+int32=int32 26
+uint32=uint32 24
+handle=handle 22
+int64=int64 27
+uint64=uint64 21
+double=double 28.2
+string=string "foo"
+objectpath=objectpath "/org/gnome/xyz"
 at-u=@u 5
 empty-arr=@a(dd) []
 just-empty-str=@ms ""

dconf2nix.cabal

@@ -22,7 +22,7 @@ library
   build-depends:       base
                      , containers
                      , optparse-applicative
-                     , parsec
+                     , parsec >= 3.1.16.0
                      , text
   hs-source-dirs:      src
   default-language:    Haskell2010

output/typed.nix

@@ -7,14 +7,25 @@ with lib.hm.gvariant;
   dconf.settings = {
     "typed" = {
       at-u = mkTyped "u" 5;
-      doubletime = mkUint32 7;
+      boolean = mkCast "boolean" true;
+      byte = mkUchar 23;
+      double = mkCast "double" 28.2;
+      doubletime = mkUint32 (mkUint32 7);
       empty-arr = mkArray "(dd)" [];
       empty-array-dict = mkArray "{sv}" [];
       empty-dict = mkTyped "a{sv}" [
       ];
+      handle = mkCast "handle" 22;
+      int16 = mkInt16 30;
+      int32 = mkCast "int32" 26;
+      int64 = mkInt64 27;
       just-empty-str = mkTyped "ms" "";
       just-str = mkTyped "ms" "hello";
-      ui32 = mkUint32 7;
+      objectpath = mkObjectpath "/org/gnome/xyz";
+      string = mkCast "string" "foo";
+      uint16 = mkUint16 25;
+      uint32 = mkUint32 24;
+      uint64 = mkUint64 21;
       var-empty-arr = mkVariant (mkArray "i" []);
     };
 

src/DConf.hs

@@ -61,15 +61,12 @@ vInt = try $ do
   n <- many1 digit <* notFollowedBy (char '.')
   pure . I $ read (s <> n)
 
-vUint32 :: Parsec Text () Value
-vUint32 = try $ do
-  many1 (string "uint32 ") >> spaces
-  I32 . read <$> many1 digit
-
-vInt64 :: Parsec Text () Value
-vInt64 = try $ do
-  many1 (string "int64 ") >> spaces
-  I64 . read <$> many1 digit
+vCast :: Parsec Text () Value
+vCast = do
+  ty <- choice $ map (\ty -> string' (castName ty) *> pure ty) (enumFrom (toEnum 0))
+  _ <- spaces
+  v <- value
+  return (C ty v)
 
 vTuple :: Parsec Text () Value
 vTuple = T <$> (bracket "(" ")" $ sepOneEndBy value comma)
@@ -119,11 +116,11 @@ vString = T.pack <$> (single <|> double)
 
 baseValue :: Parsec Text () Value
 baseValue = choice
-  [vBool, vInt, vDouble, vUint32, vInt64, fmap S vString]
+  [vBool, vInt, vDouble, fmap S vString]
 
 value :: Parsec Text () Value
 value = choice
-  [vTyped, vDictDictEntry, vList, vJson, baseValue, vTuple, vVariant]
+  [vTyped, vDictDictEntry, vList, vJson, baseValue, vCast, vTuple, vVariant]
 
 vVariant :: Parsec Text () Value
 vVariant = fmap V $ bracket "<" ">" value

src/DConf/Data.hs

@@ -14,11 +14,38 @@ newtype Root = Root Text deriving (Eq, Show)
 
 newtype Key = Key Text deriving (Eq, Ord, Show)
 
+data Ty = TyBoolean
+        | TyByte
+        | TyInt16
+        | TyUint16
+        | TyInt32
+        | TyUint32
+        | TyHandle
+        | TyInt64
+        | TyUint64
+        | TyDouble
+        | TyString
+        | TyObjectpath
+         deriving (Eq, Show, Enum)
+
+castName :: Ty -> String
+castName TyBoolean = "boolean"
+castName TyByte = "byte"
+castName TyInt16 = "int16"
+castName TyUint16 = "uint16"
+castName TyInt32 = "int32"
+castName TyUint32 = "uint32"
+castName TyHandle = "handle"
+castName TyInt64 = "int64"
+castName TyUint64 = "uint64"
+castName TyDouble = "double"
+castName TyString = "string"
+castName TyObjectpath = "objectpath"
+
 data Value = S Text         -- String
            | B Bool         -- Bool
            | I Int          -- Int
-           | I32 Int        -- Int32
-           | I64 Int        -- Int64
+           | C Ty Value     -- Cast
            | D Double       -- Double
            | T [Value]      -- Tuple of n-arity
            | Ty String Value -- Typed value

src/Nix.hs

@@ -49,13 +49,29 @@ renderEntry (Entry h c) root =
       close = mkSpaces 4 <> "};\n\n"
   in  Nix $ header <> T.pack body <> close
 
+-- | Converts type to home-manager constructor function name.
+-- | Most constructors will prefix the value with type annotation, we have to avoid those that don’t or we might get ambiguous expressions.
+constrName :: Ty -> Maybe String
+constrName TyObjectpath = Just "mkObjectpath"
+constrName TyByte = Just "mkUchar"
+constrName TyInt16 = Just "mkInt16"
+constrName TyUint16 = Just "mkUint16"
+-- Displays value as is.
+constrName TyInt32 = Nothing
+constrName TyUint32 = Just "mkUint32"
+constrName TyInt64 = Just "mkInt64"
+constrName TyUint64 = Just "mkUint64"
+-- Displays value as is.
+constrName TyDouble = Nothing
+constrName _ = Nothing
+
 renderValue :: Value -> Nix
 renderValue raw = Nix $ renderValue' raw <> ";"
  where
   needsParen :: Value -> Bool
   needsParen (I x) = x < 0
   needsParen (D x) = x < 0
-  needsParen (I32 _) = True
+  needsParen (C _ _) = True
   needsParen (T _) = True
   -- will be rendered as @[]@
   needsParen (Ty "as" (L [])) = False
@@ -77,8 +93,11 @@ renderValue raw = Nix $ renderValue' raw <> ";"
   renderValue' (B   v) = T.toLower . T.pack $ show v
   renderValue' (I   v) = T.pack $ show v
   renderValue' (D   v) = T.pack $ show v
-  renderValue' (I32 v) = "mkUint32 " <> T.pack (show v)
-  renderValue' (I64 v) = "mkInt64 " <> T.pack (show v)
+  renderValue' (C ty v) =
+    case constrName ty of
+      Just constr -> T.pack constr <> " " <> renderItem v
+      -- TODO: add mkCast to h-m
+      Nothing -> "mkCast " <> T.pack (show (castName ty)) <> " " <> renderItem v
   renderValue' (L  xs) = renderList xs
   renderValue' (T  xs) = "mkTuple " <> renderList xs
   -- In home-manager, @mkValue []@ emits @\@as []@