diff --git a/data/typed.settings b/data/typed.settings index dd410d6..487700b 100644 --- a/data/typed.settings +++ b/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 "" diff --git a/dconf2nix.cabal b/dconf2nix.cabal index 0bf10e1..19fccbb 100644 --- a/dconf2nix.cabal +++ b/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 diff --git a/output/typed.nix b/output/typed.nix index 8db2761..ae3174a 100644 --- a/output/typed.nix +++ b/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" []); }; diff --git a/src/DConf.hs b/src/DConf.hs index 507ca8b..22a9896 100644 --- a/src/DConf.hs +++ b/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 diff --git a/src/DConf/Data.hs b/src/DConf/Data.hs index 18e127a..157e2d9 100644 --- a/src/DConf/Data.hs +++ b/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 diff --git a/src/Nix.hs b/src/Nix.hs index 2fd2264..4ce52f6 100644 --- a/src/Nix.hs +++ b/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 []@