mirrors/prefmanager
1
0
Fork 0
mirror of https://github.com/malob/prefmanager.git synced 2024-12-14 11:57:49 +00:00
Code Activity

Improve watch output, and simplify nix configuration

Browse source
This commit is contained in:
Malo Bourgon 2021-01-25 10:39:15 -08:00
parent 8d9cc82acc
commit b98c0e7624
15 changed files with 307 additions and 113 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.github/workflows/nix.yml vendored
View file

@ -14,8 +14,6 @@ jobs:
with:
install_url: https://github.com/numtide/nix-flakes-installer/releases/download/nix-2.4pre20201221_9fab14a/install
extra_nix_config: |
trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo=
substituters = https://cache.nixos.org https://hydra.iohk.io https://iohk.cachix.org
experimental-features = nix-command flakes
- name: Setup Cachix

2
.gitignore vendored
View file

@ -2,3 +2,5 @@
*~
.envrc
result
result-doc
.direnv/

14
app/Main.hs
View file

@ -1,12 +1,16 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Defaults
import Defaults.Types (DomainName(..))
import Control.Monad (join)
import Data.Coerce (coerce)
import Data.Foldable (traverse_)
import qualified Data.Set as S
import qualified Data.Text as T
import Options.Applicative
import Defaults
-- | Main
main :: IO ()
main = join $ execParser opts
@ -23,9 +27,9 @@ commands = hsubparser
( command "watch"
(info
( watch . S.fromList <$> some
(Domain <$> strArgument
(DomainName <$> strArgument
( metavar "DOMAIN..."
<> completer (listIOCompleter $ fmap coerce . S.toList <$> domains)
<> completer (listIOCompleter $ fmap (T.unpack . coerce) . S.toList <$> domains)
<> help "Domain(s) that will be watched"
)
)
@ -39,7 +43,7 @@ commands = hsubparser
)
<> command "list-domains"
(info
(pure $ S.toList <$> domains >>= mapM_ (putStrLn . coerce))
(pure $ domains >>= traverse_ (putStrLn . T.unpack . coerce) . S.toList)
(progDesc "List all domains")
)
)

52
flake.lock
View file

@ -1,5 +1,20 @@
{
"nodes": {
"devshell": {
"locked": {
"lastModified": 1611223133,
"narHash": "sha256-oRipYhMDsu2bUMHXBN5Q06nZhKSYqux0SsBcq+iKyYc=",
"owner": "numtide",
"repo": "devshell",
"rev": "4d217ab9f63da23bc43351c68c2d7dc4fb5d1077",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "devshell",
"type": "github"
}
},
"flake-compat": {
"flake": false,
"locked": {
@ -31,21 +46,6 @@
"type": "github"
}
},
"haskellNix": {
"locked": {
"lastModified": 1610500541,
"narHash": "sha256-XedfI5fERgPeIbJTMkd6AH1lJGXv28CxBYMEjzAfrJc=",
"owner": "input-output-hk",
"repo": "haskell.nix",
"rev": "faaca6735566d8707ffcc812ec0da964cded27f6",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"repo": "haskell.nix",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1610575970,
@ -61,12 +61,30 @@
"type": "github"
}
},
"plist-source": {
"flake": false,
"locked": {
"lastModified": 1611283854,
"narHash": "sha256-7ubuVH6P2uYeCq82/ALd6E5szjBBqEtcO61u+5qRCt0=",
"owner": "malob",
"repo": "plist",
"rev": "5e22be0933bf9a100868b944fa7a8b1236b99255",
"type": "github"
},
"original": {
"owner": "malob",
"ref": "monadfail",
"repo": "plist",
"type": "github"
}
},
"root": {
"inputs": {
"devshell": "devshell",
"flake-compat": "flake-compat",
"flake-utils": "flake-utils",
"haskellNix": "haskellNix",
"nixpkgs": "nixpkgs"
"nixpkgs": "nixpkgs",
"plist-source": "plist-source"
}
}
},

54
flake.nix
View file

@ -3,38 +3,52 @@
inputs = {
nixpkgs.url = "github:NixOS/nixpkgs";
haskellNix.url = "github:input-output-hk/haskell.nix";
devshell.url = "github:numtide/devshell/";
flake-compat = { url = "github:edolstra/flake-compat"; flake = false; };
flake-utils.url = "github:numtide/flake-utils";
plist-source = { url = "github:malob/plist/monadfail"; flake = false; };
};
outputs = { self, nixpkgs, haskellNix, flake-utils, ... }:
outputs = { self, devshell, nixpkgs, flake-utils, plist-source, ... }:
flake-utils.lib.eachSystem [ "x86_64-darwin" ] (system: let
pkgs = import nixpkgs { inherit system; overlays = [ haskellNix.overlay ]; };
name = "prefmanager";
compiler = "ghc884";
project = pkgs.haskell-nix.project' {
inherit name;
src = self;
compiler-nix-name = compiler;
};
components = project.hsPkgs.${name}.components;
pkgs = nixpkgs.legacyPackages.${system};
compiler = pkgs.haskell.packages.ghc8103;
hlib = pkgs.haskell.lib;
plist = hlib.markUnbroken (hlib.overrideSrc compiler.plist { src = plist-source; });
prefmanager = compiler.callPackage ./prefmanager.nix { inherit plist; };
mkShell = devshell.legacyPackages.${system}.mkShell;
in rec {
# Built by `nix build .`
defaultPackage = components.exes.${name};
packages.${name} = defaultPackage;
defaultPackage = prefmanager;
packages.prefmanager = defaultPackage;
# Run `prefmanager` with `nix run .`
defaultApp = { type = "app"; program = components.exes.${name}.exePath; };
apps.${name} = defaultApp;
defaultApp = { type = "app"; program = "${prefmanager}/bin/prefmanager"; };
apps.prefmanager = defaultApp;
# This is used by `nix develop .`
devShell = project.shellFor {
buildInputs = [
pkgs.haskell.packages.${compiler}.haskell-language-server
pkgs.haskell.packages.${compiler}.implicit-hie
# # This is used by `nix develop .`
devShell = mkShell {
name = "prefmanager";
packages = [
compiler.haskell-language-server
compiler.implicit-hie
pkgs.cabal2nix
pkgs.stack
];
commands = [
{
help = "Regenerate hie.yaml (run from project root)";
name = "hie";
category = "project";
command = "gen-hie > hie.yaml";
}
{
help = "Update prefmanager.nix (run from project root)";
name = "2nix";
category = "project";
command = "cabal2nix --hpack . > prefmanager.nix";
}
];
};
}
);

13
hie.yaml Normal file
View file

@ -0,0 +1,13 @@
cradle:
stack:
- path: "./src"
component: "prefmanager:lib"
- path: "./app/Main.hs"
component: "prefmanager:exe:prefmanager"
- path: "./app/Paths_prefmanager.hs"
component: "prefmanager:exe:prefmanager"
- path: "./test"
component: "prefmanager:test:prefmanager-test"

6
package.yaml
View file

@ -17,12 +17,14 @@ dependencies:
- base >= 4.7 && < 5
- async
- containers
- diffmap
- hxt
- optparse-applicative
- patience
- plist
- pretty-show
- prettyprinter
- prettyprinter-ansi-terminal
- process
- text
library:
source-dirs: src

24
prefmanager.cabal
View file

@ -1,10 +1,10 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.33.0.
-- This file has been generated from package.yaml by hpack version 0.34.3.
--
-- see: https://github.com/sol/hpack
--
-- hash: 1af3ad98cee7d7fc142970a5965d8baebd3604edff043fae4c2b5d15e4cde1dc
-- hash: e47b42f89876fbc6a9f6ac24c1b66d161577d67abc0267f021a78a23c1ca8389
name: prefmanager
version: 0.1.0.0
@ -29,6 +29,8 @@ source-repository head
library
exposed-modules:
Defaults
Defaults.Pretty
Defaults.Types
other-modules:
Paths_prefmanager
hs-source-dirs:
@ -37,12 +39,14 @@ library
async
, base >=4.7 && <5
, containers
, diffmap
, hxt
, optparse-applicative
, patience
, plist
, pretty-show
, prettyprinter
, prettyprinter-ansi-terminal
, process
, text
default-language: Haskell2010
executable prefmanager
@ -56,13 +60,15 @@ executable prefmanager
async
, base >=4.7 && <5
, containers
, diffmap
, hxt
, optparse-applicative
, patience
, plist
, prefmanager
, pretty-show
, prettyprinter
, prettyprinter-ansi-terminal
, process
, text
default-language: Haskell2010
test-suite prefmanager-test
@ -77,11 +83,13 @@ test-suite prefmanager-test
async
, base >=4.7 && <5
, containers
, diffmap
, hxt
, optparse-applicative
, patience
, plist
, prefmanager
, pretty-show
, prettyprinter
, prettyprinter-ansi-terminal
, process
, text
default-language: Haskell2010

28
prefmanager.nix Normal file
View file

@ -0,0 +1,28 @@
{ mkDerivation, async, base, containers, hpack, hxt
, optparse-applicative, patience, plist, prettyprinter
, prettyprinter-ansi-terminal, process, stdenv, text
}:
mkDerivation {
pname = "prefmanager";
version = "0.1.0.0";
src = ./.;
isLibrary = true;
isExecutable = true;
libraryHaskellDepends = [
async base containers hxt optparse-applicative patience plist
prettyprinter prettyprinter-ansi-terminal process text
];
libraryToolDepends = [ hpack ];
executableHaskellDepends = [
async base containers hxt optparse-applicative patience plist
prettyprinter prettyprinter-ansi-terminal process text
];
testHaskellDepends = [
async base containers hxt optparse-applicative patience plist
prettyprinter prettyprinter-ansi-terminal process text
];
prePatch = "hpack";
homepage = "https://github.com/malob/prefmanager#readme";
description = "A CLI utility for managing macOS preferences";
license = stdenv.lib.licenses.bsd3;
}

72
src/Defaults.hs
View file

@ -1,62 +1,70 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Defaults where
import Defaults.Pretty (prettyDomainDiffs)
import Defaults.Types (DomainDiff(..), Domains, Domain, DomainName(..))
import Control.Concurrent.Async (mapConcurrently)
import Data.Coerce (coerce)
import Data.List (delete)
import Data.Map ( Map(..) )
import Data.Map (Map)
import qualified Data.Map as M
import Data.Map.Delta
import Data.Maybe
import Data.Set ( Set(..) )
import Data.Maybe (fromJust)
import Data.Set (Set)
import qualified Data.Set as S
import Text.Show.Pretty
import Text.XML.Plist
import Text.XML.HXT.Core
import System.Process ( shell
, readCreateProcess
)
newtype Domain = Domain String deriving (Eq, Ord, Show)
import Data.Text (Text)
import qualified Data.Text as T
import Patience.Map
import Prettyprinter.Render.Terminal (putDoc)
import System.IO (hFlush, stdout)
import System.Process (shell, readCreateProcess)
import Text.XML.HXT.Core (no, withSubstDTDEntities, withValidate)
import Text.XML.Plist (PlObject, fromPlDict, readPlistFromString)
-- | Convenience function for running macOS @defaults@ command.
defaultsCmd :: String -> IO String
defaultsCmd s = readCreateProcess (shell $ "defaults " <> s) ""
defaultsCmd :: Text -> IO Text
defaultsCmd (T.unpack -> s) = T.pack <$> readCreateProcess (shell $ "defaults " <> s) ""
-- | Convenience function for parsing Plist strings
parsePlist :: String -> IO PlObject
parsePlist = readPlistFromString [withValidate no, withSubstDTDEntities no]
parsePlist :: Text -> IO PlObject
parsePlist = readPlistFromString [withValidate no, withSubstDTDEntities no] . T.unpack
-- | Gets list of domains by running @defaults domains@ and adds @NSGlobalDomain@ to the 'Set'.
domains :: IO (Set Domain)
domains :: IO (Set DomainName)
domains
= S.fromList
. (Domain "NSGlobalDomain" :)
. fmap (Domain . delete ',')
. words
. coerce
. ("NSGlobalDomain" :)
. T.splitOn ", "
. T.stripEnd
<$> defaultsCmd "domains"
-- | Runs @defaults export [domain] -@ and parses the output.
export :: Domain -> IO (Map String PlObject)
export :: DomainName -> IO Domain
export (coerce -> d)
= M.fromList
= coerce
. M.fromList
. fromJust
. fromPlDict
<$> (defaultsCmd ("export " <> d <> " -") >>= parsePlist)
<$> (defaultsCmd ("export '" <> d <> "' -") >>= parsePlist)
-- | Runs 'export' on the 'Set' of provided domains
exports :: Set Domain -> IO (Map Domain (Map String PlObject))
exports :: Set DomainName -> IO Domains
exports = (M.fromList <$>) . mapConcurrently (\d -> (d,) <$> export d) . S.toList
-- | Watches a 'Set' of domains for changes.
watch :: Set Domain -> IO ()
diffDomain :: Domain -> Domain -> DomainDiff
diffDomain old new = coerce $ M.filter (not . isSame) $ diff old new
-- | Watches a 'Set' of domains and prints any changes.
watch :: Set DomainName -> IO ()
watch ds = exports ds >>= (putStrLn "Watching..." >>) . go where
go :: Domains -> IO ()
go old = do
new <- exports ds
let plDiffs
= M.filter (not . null)
. toDelta
. (\(DeltaUnit o n) -> diff o n)
<$> toDelta (diff old new)
(if null plDiffs then pure () else pPrint plDiffs) *> go new
let domainDiffs = uncurry diffDomain <$> toDelta (diff old new)
(if null domainDiffs then pure () else putDoc $ prettyDomainDiffs domainDiffs)
*> hFlush stdout
*> go new

73
src/Defaults/Pretty.hs Normal file
View file

@ -0,0 +1,73 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Defaults.Pretty where
import Defaults.Types (DomainDiff(..), DomainName(..), Key)
import Data.Bool (bool)
import Data.Coerce (coerce)
import Data.Map (Map, foldrWithKey)
import Patience.Map (Delta(..))
import Prettyprinter
import Prettyprinter.Render.Terminal
import Text.XML.Plist (PlObject(..))
prettyDomainDiffs :: Map DomainName DomainDiff -> Doc AnsiStyle
prettyDomainDiffs = foldrWithKey go emptyDoc where
go :: DomainName -> DomainDiff -> Doc AnsiStyle -> Doc AnsiStyle
go (DomainName name) diff doc
= doc
<> hardline
<> hardline
<> annotate (bold <> italicized) (pretty name)
<> hardline
<> indent 2 (prettyDomainDiff diff)
prettyDomainDiff :: DomainDiff -> Doc AnsiStyle
prettyDomainDiff = foldrWithKey go emptyDoc . coerce where
go :: Key -> Delta PlObject -> Doc AnsiStyle -> Doc AnsiStyle
go key delta doc
= doc
<> hardline
<> case delta of
Delta old new
-> pretty key <+> "(Value changed)"
<> hardline
<> indent 2 (red (pretty old) <> hardline <> green (pretty new))
New x
-> green
$ pretty key <+> "(Key added)"
<> hardline
<> indent 2 (pretty x)
Old x
-> red
$ pretty key <+> "(Key removed)"
<> hardline
<> indent 2 (pretty x)
Same x
-> pretty key <+> "(No change)"
<> hardline
<> indent 2 (pretty x)
red = annotate $ colorDull Red
green = annotate $ colorDull Green
instance Pretty PlObject where
pretty = \case
PlString x -> tag "string" $ pretty x
PlBool x -> bool "<false/>" "<true/>" x
PlInteger x -> tag "integer" $ pretty x
PlReal x -> tag "real" $ pretty x
PlArray x -> tag "array" $ concatWith ((<>) . (<> hardline)) (fmap pretty x)
PlDict x -> tag "dict" $ concatWith ((<>) . (<> hardline)) (fmap prettyDict x)
PlData x -> tag "data" "[binary data]"
PlDate x -> tag "date" $ pretty x
where
prettyDict (k, o) = tag "key" (pretty k) <> hardline <> pretty o
tag t s = group $ flatAlt
(open <> hardline <> indent 4 s <> hardline <> close)
(open <> s <> close)
where
open = angles t
close = angles ("/" <> t)

20
src/Defaults/Types.hs Normal file
View file

@ -0,0 +1,20 @@
module Defaults.Types where
import Data.Map (Map)
import Data.Text (Text)
import Patience.Map (Delta)
import Text.XML.Plist (PlObject)
-- | Name of a domain, e.g., @NSGlobalDomain@, @com.apple.finder@, etc.
newtype DomainName = DomainName Text deriving (Eq, Ord, Show)
type Key = String
-- | Representation of the settings of a domain.
type Domain = Map Key PlObject
-- | Map of domains.
type Domains = Map DomainName Domain
-- | Map representing the change of the values of keys of a domain.
newtype DomainDiff = DomainDiff (Map Key (Delta PlObject)) deriving (Eq, Ord, Show)

6
stack.nix Normal file
View file

@ -0,0 +1,6 @@
{ ghc }:
with import (import ./default.nix).inputs.nixpkgs {};
haskell.lib.buildStackProject {
inherit ghc;
name = "prefmanager";
}

12
stack.yaml
View file

@ -1,14 +1,14 @@
# GHC 8.8.4
resolver: lts-16.17
# GHC 8.10.3
resolver: nightly-2021-01-20
packages:
- .
extra-deps:
- diffmap-0.1.0.0
- patience-0.3
# Use fork of plist package that supports MonadFail
- github: malob/plist
commit: 4103af23b364c101e44da115367800a2f90cc7c3
# nix-sha256: 126c52498c89gd015p40hg671dg58j8xq8ggdqfywnkw2c8cjxxr
commit: 5e22be0933bf9a100868b944fa7a8b1236b99255
allow-newer: true
nix:
shell-file: ./stack.nix

26
stack.yaml.lock
View file

@ -5,26 +5,26 @@
packages:
- completed:
hackage: diffmap-0.1.0.0@sha256:27ea8c315b5dbfb243b2c3b61eab2164534e1d02887a05392dda65995cd36c3e,727
hackage: patience-0.3@sha256:fe3a2c5b1ac4d3425bad3d1ee0b6bb529b6e74ab41151f8526f26fc8dfa1206b,1252
pantry-tree:
size: 264
sha256: 76ea9b9ad91d113addadf58cb19e289e84347ab667aa5c7feed0a1ccfa4ed613
size: 368
sha256: d2ca47451a599605c641b7c353588d7e1ba3d6036c8a52040b7d1b5b1af8959b
original:
hackage: diffmap-0.1.0.0
hackage: patience-0.3
- completed:
size: 4384
url: https://github.com/malob/plist/archive/4103af23b364c101e44da115367800a2f90cc7c3.tar.gz
size: 4351
url: https://github.com/malob/plist/archive/5e22be0933bf9a100868b944fa7a8b1236b99255.tar.gz
name: plist
version: 0.0.6
sha256: fcc0a7f0dcdb81d379329f5be2af2a566431ed66cbe37e9a1f4101e49b80d4c6
sha256: 7943778b77d008b8e529035d8a4d42c537ede9efe3d24900eb0d855b4567a892
pantry-tree:
size: 512
sha256: 0ede20c4e670e906987a171721f05c3a3337ed936d5ff84e6fe77c13e2c7fbdf
sha256: 4872e51ef6ab654c99e06f286635fe1c977e165bc38f77c6bfb402e9fbff0559
original:
url: https://github.com/malob/plist/archive/4103af23b364c101e44da115367800a2f90cc7c3.tar.gz
url: https://github.com/malob/plist/archive/5e22be0933bf9a100868b944fa7a8b1236b99255.tar.gz
snapshots:
- completed:
size: 532386
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/17.yaml
sha256: d3ee1ae797cf63189c95cf27f00700304946c5cb3c1e6a82001cd6584a221e1b
original: lts-16.17
size: 563098
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2021/1/20.yaml
sha256: 97841a28b47a29e798aefda350785c31823f64f31c43ba057fc6c707dfb7ead3
original: nightly-2021-01-20