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

Add keys command, and refactor with Relude

This commit is contained in:
Malo Bourgon 2021-01-27 18:22:20 -08:00
parent 56d271b02e
commit d70f1df876
12 changed files with 141 additions and 136 deletions

View file

@ -1,6 +1,6 @@
# macOS Preferences Manager
This project is a WIP, currently only watching functionality has been implemented.
This project is a WIP.
## Usage
@ -9,7 +9,7 @@ Currently available commands:
```
> prefmanager --help
macOS Preferences Manager - a utility for working with macOS preferences
macOS Preferences Manager - a utility for working with macOS preferences.
Usage: prefmanager COMMAND
@ -17,8 +17,9 @@ Available options:
-h,--help Show this help text
Available commands:
watch Watch domain(s) for changes
domains List all domains
watch Watch domain(s) for changes.
domains List all domains.
keys List the current keys in a domain.
```
Watch functionality:

View file

@ -4,11 +4,6 @@ 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
-- | Main
@ -19,31 +14,39 @@ main = join $ execParser opts
opts :: ParserInfo (IO ())
opts = info
(commands <**> helper)
(fullDesc <> header "macOS Preferences Manager - a utility for working with macOS preferences")
(fullDesc <> header "macOS Preferences Manager - a utility for working with macOS preferences.")
-- | App CLI commands
commands :: Parser (IO ())
commands = hsubparser
( command "watch"
(info
( watch . S.fromList <$> some
( watch . fromList <$> some
(DomainName <$> strArgument
( metavar "DOMAIN..."
<> completer (listIOCompleter $ fmap (T.unpack . coerce) . S.toList <$> domains)
<> help "Domain(s) that will be watched"
<> help "Domain(s) that will be watched."
)
)
<|> flag' (watch =<< domains)
( long "all"
<> short 'a'
<> help "Watch all domains including NSGlobalDomain"
<> help "Watch all domains including NSGlobalDomain."
)
)
$ progDesc "Watch domain(s) for changes"
$ progDesc "Watch domain(s) for changes."
)
<> command "domains"
(info
(pure $ domains >>= traverse_ (putStrLn . T.unpack . coerce) . S.toList)
(progDesc "List all domains")
(pure printDomains)
(progDesc "List all domains.")
)
<> command "keys"
(info
(printKeys . DomainName <$> strArgument
( metavar "DOMAIN"
<> help "A domain for which to list keys."
)
)
$ progDesc "List the current keys in a domain."
)
)

View file

@ -32,8 +32,10 @@
packages = [
compiler.haskell-language-server
compiler.implicit-hie
compiler.weeder
pkgs.cabal2nix
pkgs.stack
pkgs.hlint
];
commands = [
{

View file

@ -14,11 +14,16 @@ extra-source-files:
description: Please see the README on GitHub at <https://github.com/malob/prefmanager#readme>
dependencies:
- base >= 4.7 && < 5
- base-noprelude
library:
source-dirs: src
dependencies:
- relude
- ansi-terminal
- async
- containers
- hxt
- optparse-applicative
- patience
- plist
- prettyprinter
@ -26,9 +31,6 @@ dependencies:
- process
- text
library:
source-dirs: src
executables:
prefmanager:
main: Main.hs
@ -39,6 +41,7 @@ executables:
- -with-rtsopts=-N
dependencies:
- prefmanager
- optparse-applicative
tests:
prefmanager-test:

View file

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: e47b42f89876fbc6a9f6ac24c1b66d161577d67abc0267f021a78a23c1ca8389
-- hash: 1a8cff5464ff5ded24a399492c6be76412d42e1e21780bb40565735f140afab2
name: prefmanager
version: 0.1.0.0
@ -31,21 +31,23 @@ library
Defaults
Defaults.Pretty
Defaults.Types
Prelude
other-modules:
Paths_prefmanager
hs-source-dirs:
src
build-depends:
async
, base >=4.7 && <5
ansi-terminal
, async
, base-noprelude
, containers
, hxt
, optparse-applicative
, patience
, plist
, prettyprinter
, prettyprinter-ansi-terminal
, process
, relude
, text
default-language: Haskell2010
@ -57,18 +59,9 @@ executable prefmanager
app
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
async
, base >=4.7 && <5
, containers
, hxt
base-noprelude
, optparse-applicative
, patience
, plist
, prefmanager
, prettyprinter
, prettyprinter-ansi-terminal
, process
, text
default-language: Haskell2010
test-suite prefmanager-test
@ -80,16 +73,6 @@ test-suite prefmanager-test
test
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
async
, base >=4.7 && <5
, containers
, hxt
, optparse-applicative
, patience
, plist
base-noprelude
, prefmanager
, prettyprinter
, prettyprinter-ansi-terminal
, process
, text
default-language: Haskell2010

View file

@ -1,6 +1,6 @@
{ mkDerivation, async, base, containers, hpack, hxt
, optparse-applicative, patience, plist, prettyprinter
, prettyprinter-ansi-terminal, process, stdenv, text
{ mkDerivation, ansi-terminal, async, base-noprelude, containers
, hpack, hxt, optparse-applicative, patience, plist, prettyprinter
, prettyprinter-ansi-terminal, process, relude, stdenv, text
}:
mkDerivation {
pname = "prefmanager";
@ -9,18 +9,12 @@ mkDerivation {
isLibrary = true;
isExecutable = true;
libraryHaskellDepends = [
async base containers hxt optparse-applicative patience plist
prettyprinter prettyprinter-ansi-terminal process text
ansi-terminal async base-noprelude containers hxt patience plist
prettyprinter prettyprinter-ansi-terminal process relude 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
];
executableHaskellDepends = [ base-noprelude optparse-applicative ];
testHaskellDepends = [ base-noprelude ];
prePatch = "hpack";
homepage = "https://github.com/malob/prefmanager#readme";
description = "A CLI utility for managing macOS preferences";

View file

@ -1,70 +1,81 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Defaults where
import Defaults.Pretty (prettyDomainDiffs)
import Defaults.Types (DomainDiff(..), Domains, Domain, DomainName(..))
import Defaults.Types (DomainDiff(..), Domains(..), Domain(..), DomainName(..), Key)
import Relude.Extra (un, wrap, traverseToSnd, keys)
import Control.Concurrent.Async (mapConcurrently)
import Data.Coerce (coerce)
import Data.List (delete)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Patience.Map
import qualified Data.Map.Strict as M
import Data.Text (stripEnd, splitOn)
import Patience.Map (diff, isSame, toDelta)
import Prettyprinter.Render.Terminal (putDoc)
import System.IO (hFlush, stdout)
import System.Console.ANSI (clearLine, setCursorColumn)
import System.IO (hFlush)
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 :: Text -> IO Text
defaultsCmd (T.unpack -> s) = T.pack <$> readCreateProcess (shell $ "defaults " <> s) ""
defaultsCmd (toString -> t) = toText <$> readCreateProcess (shell $ "/usr/bin/defaults " <> t) ""
-- | Convenience function for parsing Plist strings
parsePlist :: Text -> IO PlObject
parsePlist = readPlistFromString [withValidate no, withSubstDTDEntities no] . T.unpack
parsePlist = readPlistFromString [withValidate no, withSubstDTDEntities no] . toString
-- | Gets list of domains by running @defaults domains@ and adds @NSGlobalDomain@ to the 'Set'.
domains :: IO (Set DomainName)
domains
= S.fromList
. coerce
= fromList
. wrap
. ("NSGlobalDomain" :)
. T.splitOn ", "
. T.stripEnd
. splitOn ", "
. stripEnd
<$> defaultsCmd "domains"
-- | Runs @defaults export [domain] -@ and parses the output.
export :: DomainName -> IO Domain
export (coerce -> d)
= coerce
. M.fromList
. fromJust
export d
= wrap
. fromList @(Map _ _)
. maybeToMonoid
. fromPlDict
<$> (defaultsCmd ("export '" <> d <> "' -") >>= parsePlist)
<$> (defaultsCmd ("export '" <> un d <> "' -") >>= parsePlist)
-- | Runs 'export' on the 'Set' of provided domains
exports :: Set DomainName -> IO Domains
exports = (M.fromList <$>) . mapConcurrently (\d -> (d,) <$> export d) . S.toList
exports = wrap . fmap (fromList @(Map _ _)) . mapConcurrently (traverseToSnd export) . toList
diffDomain :: Domain -> Domain -> DomainDiff
diffDomain old new = coerce $ M.filter (not . isSame) $ diff old new
diffDomain (Domain old) (Domain new) = wrap $ 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
watch ds = exports ds >>= (putStrLn "Watching..." *>) . go 0 where
go :: Int -> Domains -> IO ()
go count old = do
putText "Processing domains"
if count > 0 then putText $ " (" <> show count <> " loops with no changes)" else pass
hFlush stdout
new <- exports ds
let domainDiffs = uncurry diffDomain <$> toDelta (diff old new)
(if null domainDiffs then pure () else putDoc $ prettyDomainDiffs domainDiffs)
*> hFlush stdout
*> go new
let domainDiffs = uncurry diffDomain <$> toDelta (diff (un old) (un new))
clearLine
setCursorColumn 0
if null domainDiffs
then go (count + 1) new
else do
putDoc $ prettyDomainDiffs domainDiffs
go 0 new
-- | Print the keys of a given domain
printKeys :: DomainName -> IO ()
printKeys = traverse_ putStrLn . keys @(Map _ PlObject) . un <=< export
-- | Print the list of available domains
printDomains :: IO ()
printDomains = traverse_ (putTextLn . un) =<< domains

View file

@ -4,32 +4,29 @@ module Defaults.Pretty where
import Defaults.Types (DomainDiff(..), DomainName(..), Key)
import Data.Bool (bool)
import Data.Coerce (coerce)
import Data.Map (Map, foldrWithKey)
import Prelude hiding (group)
import Relude.Extra (un)
import Data.Map.Strict (foldMapWithKey)
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
prettyDomainDiffs = foldMapWithKey go where
go :: DomainName -> DomainDiff -> Doc AnsiStyle
go (DomainName name) diff
= annotate (bold <> italicized) (pretty name)
<> hardline
<> hardline
<> annotate (bold <> italicized) (pretty name)
<> hardline
<> indent 2 (prettyDomainDiff diff)
<> hardline
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
prettyDomainDiff = foldMapWithKey go . un where
go :: Key -> Delta PlObject -> Doc AnsiStyle
go key = (<> hardline <> hardline) . \case
Delta old new
-> pretty key <+> "(Value changed)"
<> hardline

View file

@ -1,7 +1,5 @@
module Defaults.Types where
import Data.Map (Map)
import Data.Text (Text)
import Patience.Map (Delta)
import Text.XML.Plist (PlObject)
@ -11,10 +9,10 @@ newtype DomainName = DomainName Text deriving (Eq, Ord, Show)
type Key = String
-- | Representation of the settings of a domain.
type Domain = Map Key PlObject
newtype Domain = Domain (Map Key PlObject) deriving (Eq, Ord, Show)
-- | Map of domains.
type Domains = Map DomainName Domain
newtype Domains = Domains (Map DomainName Domain) deriving (Eq, Ord, Show)
-- | Map representing the change of the values of keys of a domain.
newtype DomainDiff = DomainDiff (Map Key (Delta PlObject)) deriving (Eq, Ord, Show)

3
src/Prelude.hs Normal file
View file

@ -0,0 +1,3 @@
module Prelude (module Relude) where
import Relude

View file

@ -6,9 +6,12 @@ packages:
extra-deps:
- patience-0.3
- base-noprelude-4.13.0.0
# Use fork of plist package that supports MonadFail
- github: malob/plist
commit: 5e22be0933bf9a100868b944fa7a8b1236b99255
allow-newer: true
nix:
shell-file: ./stack.nix

View file

@ -11,6 +11,13 @@ packages:
sha256: d2ca47451a599605c641b7c353588d7e1ba3d6036c8a52040b7d1b5b1af8959b
original:
hackage: patience-0.3
- completed:
hackage: base-noprelude-4.13.0.0@sha256:3cccbfda38e1422ca5cc436d58858ba51ff9114d2ed87915a6569be11e4e5a90,6842
pantry-tree:
size: 112
sha256: 90db92c8401880187ce642c5345407bcbd9546ea235524dd445cab2566ee3db1
original:
hackage: base-noprelude-4.13.0.0
- completed:
size: 4351
url: https://github.com/malob/plist/archive/5e22be0933bf9a100868b944fa7a8b1236b99255.tar.gz