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:
parent
56d271b02e
commit
d70f1df876
12 changed files with 141 additions and 136 deletions
|
@ -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:
|
||||
|
|
29
app/Main.hs
29
app/Main.hs
|
@ -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."
|
||||
)
|
||||
)
|
||||
|
|
|
@ -32,8 +32,10 @@
|
|||
packages = [
|
||||
compiler.haskell-language-server
|
||||
compiler.implicit-hie
|
||||
compiler.weeder
|
||||
pkgs.cabal2nix
|
||||
pkgs.stack
|
||||
pkgs.hlint
|
||||
];
|
||||
commands = [
|
||||
{
|
||||
|
|
13
package.yaml
13
package.yaml
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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";
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
3
src/Prelude.hs
Normal file
|
@ -0,0 +1,3 @@
|
|||
module Prelude (module Relude) where
|
||||
|
||||
import Relude
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue