Add keys command, and refactor with Relude

README.md

@@ -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
+  watch                    Watch domain(s) for changes.
-  domains                  List all domains
+  domains                  List all domains.
+  keys                     List the current keys in a domain.
 ```
 
 Watch functionality:

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)
+         (pure printDomains)
-         (progDesc "List all domains")
+         (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."
        )
   )

flake.nix

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

package.yaml

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

prefmanager.cabal

@@ -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
+      ansi-terminal
-    , base >=4.7 && <5
+    , 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-noprelude
-    , base >=4.7 && <5
-    , containers
-    , hxt
     , 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-noprelude
-    , base >=4.7 && <5
-    , containers
-    , hxt
-    , optparse-applicative
-    , patience
-    , plist
     , prefmanager
-    , prettyprinter
-    , prettyprinter-ansi-terminal
-    , process
-    , text
   default-language: Haskell2010

prefmanager.nix

@@ -1,6 +1,6 @@
-{ mkDerivation, async, base, containers, hpack, hxt
+{ mkDerivation, ansi-terminal, async, base-noprelude, containers
-, optparse-applicative, patience, plist, prettyprinter
+, hpack, hxt, optparse-applicative, patience, plist, prettyprinter
-, prettyprinter-ansi-terminal, process, stdenv, text
+, 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
+    ansi-terminal async base-noprelude containers hxt patience plist
-    prettyprinter prettyprinter-ansi-terminal process text
+    prettyprinter prettyprinter-ansi-terminal process relude text
   ];
   libraryToolDepends = [ hpack ];
-  executableHaskellDepends = [
+  executableHaskellDepends = [ base-noprelude optparse-applicative ];
-    async base containers hxt optparse-applicative patience plist
+  testHaskellDepends = [ base-noprelude ];
-    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";

src/Defaults.hs

@@ -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.Strict as M
-import qualified Data.Map as M
+import Data.Text (stripEnd, splitOn)
-import Data.Maybe (fromJust)
+import Patience.Map (diff, isSame, toDelta)
-import Data.Set (Set)
-import qualified Data.Set as S
-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.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
+  =   fromList
-  .   coerce
+  .   wrap
   .   ("NSGlobalDomain" :)
-  .   T.splitOn ", "
+  .   splitOn ", "
-  .   T.stripEnd
+  .   stripEnd
   <$> defaultsCmd "domains"
 
 -- | Runs @defaults export [domain] -@ and parses the output.
 export :: DomainName -> IO Domain
-export (coerce -> d)
+export d
-  =   coerce
+  =   wrap
-  .   M.fromList
+  .   fromList @(Map _ _)
-  .   fromJust
+  .   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
+watch ds = exports ds >>= (putStrLn "Watching..." *>) . go 0 where
-  go :: Domains -> IO ()
+  go :: Int -> Domains -> IO ()
-  go old = do
+  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)
+    let domainDiffs = uncurry diffDomain <$> toDelta (diff (un old) (un new))
-    (if null domainDiffs then pure () else putDoc $ prettyDomainDiffs domainDiffs)
+    clearLine
-      *> hFlush stdout
+    setCursorColumn 0
-      *> go new
+    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

src/Defaults/Pretty.hs

@@ -4,50 +4,47 @@ module Defaults.Pretty where
 
 import Defaults.Types (DomainDiff(..), DomainName(..), Key)
 
-import Data.Bool (bool)
+import Prelude hiding (group)
-import Data.Coerce (coerce)
+import Relude.Extra (un)
-import Data.Map (Map, foldrWithKey)
+
+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
+prettyDomainDiffs = foldMapWithKey go where
-  go :: DomainName -> DomainDiff -> Doc AnsiStyle -> Doc AnsiStyle
+  go :: DomainName -> DomainDiff -> Doc AnsiStyle
-  go (DomainName name) diff doc
+  go (DomainName name) diff
-    =  doc
+    = 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
+prettyDomainDiff = foldMapWithKey go . un where
-  go :: Key -> Delta PlObject -> Doc AnsiStyle -> Doc AnsiStyle
+  go :: Key -> Delta PlObject -> Doc AnsiStyle
-  go key delta doc
+  go key = (<> hardline <> hardline) . \case
-    =  doc
+    Delta old new
-    <> hardline
+      -> pretty key <+> "(Value changed)"
-    <> case delta of
+      <> hardline
-      Delta old new
+      <> indent 2 (red (pretty old) <> hardline <> green (pretty new))
-        -> pretty key <+> "(Value changed)"
+    New x
-        <> hardline
+      -> green
-        <> indent 2 (red (pretty old) <> hardline <> green (pretty new))
+      $  pretty key <+> "(Key added)"
-      New x
+      <> hardline
-        -> green
+      <> indent 2 (pretty x)
-        $  pretty key <+> "(Key added)"
+    Old x
-        <> hardline
+      -> red
-        <> indent 2 (pretty x)
+      $  pretty key <+> "(Key removed)"
-      Old x
+      <> hardline
-        -> red
+      <> indent 2 (pretty x)
-        $  pretty key <+> "(Key removed)"
+    Same x
-        <> hardline
+      -> pretty key <+> "(No change)"
-        <> indent 2 (pretty x)
+      <> hardline
-      Same x
+      <> indent 2 (pretty x)
-        -> pretty key <+> "(No change)"
-        <> hardline
-        <> indent 2 (pretty x)
   red = annotate $ colorDull Red
   green = annotate $ colorDull Green
 

src/Defaults/Types.hs

@@ -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)

src/Prelude.hs

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

stack.yaml

@@ -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

stack.yaml.lock

@@ -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