├── .ghci ├── .gitignore ├── .travis.yml ├── LICENSE ├── Readme.org ├── build.nix ├── default.nix ├── hie.yaml ├── nix ├── sources.json └── sources.nix ├── nixos-manager.cabal ├── packages.nix ├── screenshots ├── admin.png ├── home-manager.png ├── packages.png └── services.png ├── shell.nix └── src ├── Main.hs └── NixManager ├── Admin ├── BuildState.hs ├── Event.hs ├── GarbageData.hs ├── RebuildData.hs ├── State.hs ├── Update.hs ├── ValidRebuildModes.hs └── View.hs ├── AskPass.hs ├── Bash.hs ├── ChangeType.hs ├── Constants.hs ├── Docbook.hs ├── HMAdmin ├── BuildState.hs ├── Event.hs ├── GarbageData.hs ├── GenerationsData.hs ├── GenerationsState.hs ├── GenerationsView.hs ├── RebuildData.hs ├── State.hs ├── Update.hs └── View.hs ├── HMGarbage.hs ├── HMGenerations.hs ├── HMPackages ├── Event.hs ├── State.hs ├── Update.hs └── View.hs ├── HMPackagesUtil.hs ├── HMRebuild.hs ├── HMRebuildMode.hs ├── HMServices ├── Event.hs ├── State.hs ├── Update.hs └── View.hs ├── HMServicesUtil.hs ├── ManagerEvent.hs ├── ManagerMain.hs ├── ManagerState.hs ├── Message.hs ├── NixExpr.hs ├── NixGarbage.hs ├── NixLocation.hs ├── NixPackage.hs ├── NixPackageMeta.hs ├── NixPackageSearch.hs ├── NixPackageStatus.hs ├── NixPackagesUtil.hs ├── NixRebuild.hs ├── NixRebuildMode.hs ├── NixRebuildUpdateMode.hs ├── NixService.hs ├── NixServiceOption.hs ├── NixServiceOptionType.hs ├── NixServicesUtil.hs ├── PackageCategory.hs ├── Packages ├── Event.hs ├── State.hs ├── Update.hs └── View.hs ├── Password.hs ├── PosixTools.hs ├── Process.hs ├── ProgramArguments.hs ├── Services ├── Download.hs ├── Event.hs ├── ServiceCategory.hs ├── State.hs ├── StateData.hs ├── Update.hs └── View.hs ├── Update.hs ├── Util.hs └── View ├── ComboBox.hs ├── Css.hs ├── DetailsState.hs ├── ErrorDialog.hs ├── GtkUtil.hs ├── Icon.hs ├── IconName.hs ├── ImageButton.hs ├── InformationBox.hs ├── PackageEditView.hs ├── ProgressBar.hs ├── Root.hs └── ServiceEditView.hs /.ghci: -------------------------------------------------------------------------------- 1 | :def hoogle \x -> return $ ":! hoogle --count=15 \"" ++ x ++ "\"" 2 | :def doc \x -> return $ ":!hoogle --info \"" ++ x ++ "\"" 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.lock 2 | 3 | # nix 4 | result 5 | result-* 6 | 7 | # haskell 8 | dist 9 | dist-newstyle 10 | cabal-dev 11 | *.o 12 | *.hi 13 | *.chi 14 | *.chs.h 15 | *.dyn_o 16 | *.dyn_hi 17 | .hpc 18 | .hsenv 19 | .cabal-sandbox/ 20 | cabal.sandbox.config 21 | *.prof 22 | *.aux 23 | *.hp 24 | *.eventlog 25 | .stack-work/ 26 | cabal.project.local 27 | .HTF/ 28 | .ghc.environment.* 29 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: nix 2 | -------------------------------------------------------------------------------- /build.nix: -------------------------------------------------------------------------------- 1 | { pkgs, compiler ? "ghc883" }: 2 | 3 | let 4 | gitignore = pkgs.nix-gitignore.gitignoreSourcePure [ ./.gitignore ]; 5 | 6 | haskellLib = pkgs.haskell.lib; 7 | 8 | myHaskellPackages = pkgs.haskell.packages.${compiler}.override { 9 | overrides = se: su: { 10 | 11 | gi-gtk-declarative = haskellLib.markUnbroken (su.gi-gtk-declarative.overrideAttrs (oldAttrs: { 12 | doCheck = false; 13 | })); 14 | 15 | gi-gtk-declarative-app-simple = haskellLib.markUnbroken su.gi-gtk-declarative-app-simple; 16 | 17 | "nixos-manager" = haskellLib.overrideCabal 18 | (se.callCabal2nix "nixos-manager" (gitignore ./.) {}) 19 | (drv: { 20 | buildTools = drv.buildTools or [] ++ [ pkgs.makeWrapper ]; 21 | postFixup = '' 22 | wrapProgram $out/bin/nixos-manager \ 23 | --prefix PATH : "${pkgs.lib.makeBinPath [pkgs.gksu]}" 24 | ''; 25 | }); 26 | }; 27 | }; 28 | 29 | in 30 | rec 31 | { 32 | "nixos-manager" = myHaskellPackages."nixos-manager"; 33 | shell = myHaskellPackages.shellFor { 34 | packages = p: [ 35 | p."nixos-manager" 36 | ]; 37 | buildInputs = with pkgs.haskellPackages; [ 38 | cabal-install 39 | hlint 40 | pkgs.niv 41 | pkgs.nixpkgs-fmt 42 | ]; 43 | withHoogle = true; 44 | }; 45 | } 46 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let 2 | pkgs = import {}; 3 | in 4 | (import ./build.nix { inherit pkgs; }) 5 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /nix/sources.json: -------------------------------------------------------------------------------- 1 | { 2 | "nixpkgs": { 3 | "branch": "nixos-20.03", 4 | "description": "Nix Packages collection", 5 | "homepage": null, 6 | "owner": "nixos", 7 | "repo": "nixpkgs", 8 | "rev": "f77e057cda60a3f96a4010a698ff3be311bf18c6", 9 | "sha256": "05n27wz5ln9ni5cy5rhjcy612i44gmblkq5m0g827v8pd0nk00da", 10 | "type": "tarball", 11 | "url": "https://github.com/nixos/nixpkgs/archive/d96bd3394b734487d1c3bfbac0e8f17465e03afe.tar.gz", 12 | "url_template": "https://github.com///archive/.tar.gz" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /nix/sources.nix: -------------------------------------------------------------------------------- 1 | # This file has been generated by Niv. 2 | let 3 | # 4 | # The fetchers. fetch_ fetches specs of type . 5 | # 6 | 7 | fetch_file = pkgs: spec: 8 | if spec.builtin or true then 9 | builtins_fetchurl { inherit (spec) url sha256; } 10 | else 11 | pkgs.fetchurl { inherit (spec) url sha256; }; 12 | 13 | fetch_tarball = pkgs: spec: 14 | if spec.builtin or true then 15 | builtins_fetchTarball { inherit (spec) url sha256; } 16 | else 17 | pkgs.fetchzip { inherit (spec) url sha256; }; 18 | 19 | fetch_git = spec: 20 | builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; }; 21 | 22 | fetch_builtin-tarball = spec: 23 | builtins.trace 24 | '' 25 | WARNING: 26 | The niv type "builtin-tarball" will soon be deprecated. You should 27 | instead use `builtin = true`. 28 | 29 | $ niv modify -a type=tarball -a builtin=true 30 | '' 31 | builtins_fetchTarball { inherit (spec) url sha256; }; 32 | 33 | fetch_builtin-url = spec: 34 | builtins.trace 35 | '' 36 | WARNING: 37 | The niv type "builtin-url" will soon be deprecated. You should 38 | instead use `builtin = true`. 39 | 40 | $ niv modify -a type=file -a builtin=true 41 | '' 42 | (builtins_fetchurl { inherit (spec) url sha256; }); 43 | 44 | # 45 | # Various helpers 46 | # 47 | 48 | # The set of packages used when specs are fetched using non-builtins. 49 | mkPkgs = sources: 50 | let 51 | sourcesNixpkgs = 52 | import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) {}; 53 | hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; 54 | hasThisAsNixpkgsPath = == ./.; 55 | in 56 | if builtins.hasAttr "nixpkgs" sources 57 | then sourcesNixpkgs 58 | else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then 59 | import {} 60 | else 61 | abort 62 | '' 63 | Please specify either (through -I or NIX_PATH=nixpkgs=...) or 64 | add a package called "nixpkgs" to your sources.json. 65 | ''; 66 | 67 | # The actual fetching function. 68 | fetch = pkgs: name: spec: 69 | 70 | if ! builtins.hasAttr "type" spec then 71 | abort "ERROR: niv spec ${name} does not have a 'type' attribute" 72 | else if spec.type == "file" then fetch_file pkgs spec 73 | else if spec.type == "tarball" then fetch_tarball pkgs spec 74 | else if spec.type == "git" then fetch_git spec 75 | else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec 76 | else if spec.type == "builtin-url" then fetch_builtin-url spec 77 | else 78 | abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}"; 79 | 80 | # Ports of functions for older nix versions 81 | 82 | # a Nix version of mapAttrs if the built-in doesn't exist 83 | mapAttrs = builtins.mapAttrs or ( 84 | f: set: with builtins; 85 | listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set)) 86 | ); 87 | 88 | # fetchTarball version that is compatible between all the versions of Nix 89 | builtins_fetchTarball = { url, sha256 }@attrs: 90 | let 91 | inherit (builtins) lessThan nixVersion fetchTarball; 92 | in 93 | if lessThan nixVersion "1.12" then 94 | fetchTarball { inherit url; } 95 | else 96 | fetchTarball attrs; 97 | 98 | # fetchurl version that is compatible between all the versions of Nix 99 | builtins_fetchurl = { url, sha256 }@attrs: 100 | let 101 | inherit (builtins) lessThan nixVersion fetchurl; 102 | in 103 | if lessThan nixVersion "1.12" then 104 | fetchurl { inherit url; } 105 | else 106 | fetchurl attrs; 107 | 108 | # Create the final "sources" from the config 109 | mkSources = config: 110 | mapAttrs ( 111 | name: spec: 112 | if builtins.hasAttr "outPath" spec 113 | then abort 114 | "The values in sources.json should not have an 'outPath' attribute" 115 | else 116 | spec // { outPath = fetch config.pkgs name spec; } 117 | ) config.sources; 118 | 119 | # The "config" used by the fetchers 120 | mkConfig = 121 | { sourcesFile ? ./sources.json 122 | , sources ? builtins.fromJSON (builtins.readFile sourcesFile) 123 | , pkgs ? mkPkgs sources 124 | }: rec { 125 | # The sources, i.e. the attribute set of spec name to spec 126 | inherit sources; 127 | 128 | # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers 129 | inherit pkgs; 130 | }; 131 | in 132 | mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); } 133 | -------------------------------------------------------------------------------- /nixos-manager.cabal: -------------------------------------------------------------------------------- 1 | name: nixos-manager 2 | homepage: https://github.com/pmiddend/nixos-manager 3 | author: Philipp Middendorf 4 | maintainer: Philipp Middendorf 5 | copyright: Philipp Middendorf 6 | category: GUI 7 | cabal-version: >=1.10 8 | version: 1.0 9 | license-file: LICENSE 10 | build-type: Simple 11 | 12 | executable nixos-manager 13 | main-is: Main.hs 14 | other-modules: NixManager.Admin.BuildState 15 | , NixManager.Admin.Event 16 | , NixManager.Admin.GarbageData 17 | , NixManager.Admin.RebuildData 18 | , NixManager.Admin.State 19 | , NixManager.Admin.Update 20 | , NixManager.Admin.ValidRebuildModes 21 | , NixManager.Admin.View 22 | , NixManager.AskPass 23 | , NixManager.Bash 24 | , NixManager.ChangeType 25 | , NixManager.Constants 26 | , NixManager.Docbook 27 | , NixManager.HMAdmin.BuildState 28 | , NixManager.HMAdmin.Event 29 | , NixManager.HMAdmin.GarbageData 30 | , NixManager.HMAdmin.GenerationsData 31 | , NixManager.HMAdmin.GenerationsState 32 | , NixManager.HMAdmin.GenerationsView 33 | , NixManager.HMAdmin.RebuildData 34 | , NixManager.HMAdmin.State 35 | , NixManager.HMAdmin.Update 36 | , NixManager.HMAdmin.View 37 | , NixManager.HMGarbage 38 | , NixManager.HMGenerations 39 | , NixManager.HMPackages.Event 40 | , NixManager.HMPackages.State 41 | , NixManager.HMPackages.Update 42 | , NixManager.HMPackages.View 43 | , NixManager.HMPackagesUtil 44 | , NixManager.HMRebuild 45 | , NixManager.HMRebuildMode 46 | , NixManager.HMServices.Event 47 | , NixManager.HMServices.State 48 | , NixManager.HMServices.Update 49 | , NixManager.HMServices.View 50 | , NixManager.HMServicesUtil 51 | , NixManager.ManagerEvent 52 | , NixManager.ManagerMain 53 | , NixManager.ManagerState 54 | , NixManager.Message 55 | , NixManager.NixExpr 56 | , NixManager.NixGarbage 57 | , NixManager.NixLocation 58 | , NixManager.NixPackage 59 | , NixManager.NixPackageMeta 60 | , NixManager.NixPackageSearch 61 | , NixManager.NixPackageStatus 62 | , NixManager.NixPackagesUtil 63 | , NixManager.NixRebuild 64 | , NixManager.NixRebuildMode 65 | , NixManager.NixRebuildUpdateMode 66 | , NixManager.NixService 67 | , NixManager.NixServiceOption 68 | , NixManager.NixServiceOptionType 69 | , NixManager.NixServicesUtil 70 | , NixManager.PackageCategory 71 | , NixManager.Packages.Event 72 | , NixManager.Packages.State 73 | , NixManager.Packages.Update 74 | , NixManager.Packages.View 75 | , NixManager.Password 76 | , NixManager.PosixTools 77 | , NixManager.Process 78 | , NixManager.ProgramArguments 79 | , NixManager.Services.Download 80 | , NixManager.Services.Event 81 | , NixManager.Services.ServiceCategory 82 | , NixManager.Services.State 83 | , NixManager.Services.StateData 84 | , NixManager.Services.Update 85 | , NixManager.Services.View 86 | , NixManager.Update 87 | , NixManager.Util 88 | , NixManager.View.ComboBox 89 | , NixManager.View.Css 90 | , NixManager.View.DetailsState 91 | , NixManager.View.ErrorDialog 92 | , NixManager.View.GtkUtil 93 | , NixManager.View.Icon 94 | , NixManager.View.IconName 95 | , NixManager.View.ImageButton 96 | , NixManager.View.InformationBox 97 | , NixManager.View.PackageEditView 98 | , NixManager.View.ProgressBar 99 | , NixManager.View.Root 100 | , NixManager.View.ServiceEditView 101 | build-depends: aeson 102 | , base 103 | , bifunctors 104 | , bytestring 105 | , composition 106 | , containers 107 | , data-default 108 | , directory 109 | , filepath 110 | , generic-lens 111 | , gi-gdk 112 | , gi-gobject 113 | , gi-gtk 114 | , gi-gtk-declarative 115 | , gi-gtk-declarative-app-simple 116 | , haskell-gi-base 117 | , lens 118 | , lens-aeson 119 | , megaparsec 120 | , pipes 121 | , pretty-relative-time 122 | , process 123 | , scientific 124 | , text 125 | , time 126 | , validation 127 | , vector 128 | , word-wrap 129 | , xml-conduit 130 | , xml-lens 131 | hs-source-dirs: src 132 | default-language: Haskell2010 133 | build-tools: hlint, cabal-install 134 | ghc-options: -Wall -threaded -Wno-unused-imports -Wno-missing-signatures 135 | -------------------------------------------------------------------------------- /packages.nix: -------------------------------------------------------------------------------- 1 | { config, pkgs, ... }: { 2 | environment.systemPackages = [ pkgs.cheese ]; 3 | fonts.fonts = [ pkgs.source-code-pro ]; 4 | programs.light.enable = true; 5 | } 6 | -------------------------------------------------------------------------------- /screenshots/admin.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmiddend/nixos-manager/abc46e3a42e12accf6c48ffaf4508c95ba8907d3/screenshots/admin.png -------------------------------------------------------------------------------- /screenshots/home-manager.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmiddend/nixos-manager/abc46e3a42e12accf6c48ffaf4508c95ba8907d3/screenshots/home-manager.png -------------------------------------------------------------------------------- /screenshots/packages.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmiddend/nixos-manager/abc46e3a42e12accf6c48ffaf4508c95ba8907d3/screenshots/packages.png -------------------------------------------------------------------------------- /screenshots/services.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmiddend/nixos-manager/abc46e3a42e12accf6c48ffaf4508c95ba8907d3/screenshots/services.png -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | let 2 | sources = import ./nix/sources.nix; 3 | pkgs = import sources.nixpkgs {}; 4 | in 5 | (import ./build.nix { inherit pkgs; compiler = "ghc882"; }).shell 6 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: NixOS manager's entry point 3 | -} 4 | module Main where 5 | 6 | import NixManager.ManagerMain as NixMain 7 | 8 | -- | Please move along to "NixManager.ManagerMain" 9 | main :: IO () 10 | main = NixMain.nixMain 11 | -------------------------------------------------------------------------------- /src/NixManager/Admin/BuildState.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-| 3 | Description: Contains just the "BuildState" data type 4 | Contains just the "BuildState" data type 5 | -} 6 | module NixManager.Admin.BuildState 7 | ( BuildState(BuildState) 8 | ) 9 | where 10 | 11 | import NixManager.Process ( ProcessData ) 12 | import NixManager.Password ( Password ) 13 | import GHC.Generics ( Generic ) 14 | import Data.Generics.Labels ( ) 15 | 16 | -- | Contains all the data corresponding to “some sudo program that’s currently running” 17 | data BuildState = BuildState { 18 | counter :: Int -- ^ This field is necessary to “pulse” the GTK progress bar while building, see "NixManager.View.ProgressBar" for details 19 | , processData :: ProcessData -- ^ The process data 20 | , password :: Password -- ^ The password used to call the process. This is needed to cancel it again. 21 | } deriving(Generic) 22 | 23 | -------------------------------------------------------------------------------- /src/NixManager/Admin/Event.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the event type for all events corresponding to the Administration tab 3 | 4 | Contains the event type for all events corresponding to the Administration tab 5 | -} 6 | module NixManager.Admin.Event 7 | ( Event(..) 8 | ) 9 | where 10 | 11 | import NixManager.Process ( ProcessData 12 | , ProcessOutput 13 | ) 14 | import NixManager.View.DetailsState ( DetailsState ) 15 | import System.Exit ( ExitCode ) 16 | import NixManager.ChangeType ( ChangeType ) 17 | import NixManager.Password ( Password ) 18 | 19 | data Event = EventRebuild -- ^ Triggered by the Rebuild button. Starts the password query. 20 | | EventRebuildWithPassword Password -- ^ Triggered by the “ask for password” process after it completes. It launches the actual rebuild process. 21 | | EventAskPassWatch (Password -> Event) ProcessOutput ProcessData -- ^ This event is emitted at regular intervals after the password query is launched. When the process finishes (successfully), there’s a CPS-style argument to see what to emit next. 22 | | EventRebuildStarted ProcessData Password -- ^ Is emitted after the rebuild has started and initiates the “watchdog” event above. 23 | | EventRebuildWatch Password ProcessOutput ProcessData -- ^ This event is emitted at regular intervals after the rebuild process is launched. 24 | | EventRebuildFinished ProcessOutput ExitCode -- ^ Emitted when the rebuild process finishes. 25 | | EventRebuildModeIdxChanged Int -- ^ Emitted when the rebuild mode changes 26 | | EventRebuildDoUpdateChanged Bool -- ^ Emitted when the “Update” checkbox changes 27 | | EventRebuildDoRollbackChanged Bool -- ^ Emitted when the “Rollback” checkbox changes 28 | | EventRebuildCancel -- ^ Emitted when the user clicks Cancel on a running rebuild 29 | | EventRebuildChangeDetails DetailsState -- ^ Emitted when the rebuild details are expanded/contracted 30 | | EventGarbageChangeDetails DetailsState -- ^ Emitted when the garbage details are expanded/contracted 31 | | EventGarbage -- ^ Triggered by the Collect Garbage button. Starts the password query. 32 | | EventGarbageWithPassword Password -- ^ Triggered by the “ask for password” process after it completes. It launches the actual garbage collection process. 33 | | EventGarbageStarted ProcessData Password -- ^ Is emitted after the garbage collection has started and initiates the “watchdog” event. 34 | | EventGarbageWatch ProcessOutput ProcessData -- ^ This event is emitted at regular intervals after the garbage collect process is launched. 35 | | EventGarbageFinished ProcessOutput ExitCode -- ^ Emitted when the garbage collection process finishes. 36 | | EventGarbageOlderGenerationsChanged Bool -- ^ Emitted when the “Older Generations” checkbox changes 37 | | EventGarbageCancel -- ^ Emitted when the user clicks Cancel on a running garbage collection 38 | | EventReload -- ^ Triggers a reload of the “Do we have changes” state 39 | | EventReloadFinished ChangeType -- ^ Emitted when we’ve determined the changes 40 | -------------------------------------------------------------------------------- /src/NixManager/Admin/GarbageData.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains all data for the garbage collection GUI 3 | Contains all data for the garbage collection GUI 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | module NixManager.Admin.GarbageData 7 | ( GarbageData(..) 8 | , initialGarbageData 9 | ) 10 | where 11 | 12 | import NixManager.View.DetailsState ( DetailsState 13 | ( DetailsContracted 14 | ) 15 | ) 16 | import NixManager.Process ( ProcessOutput ) 17 | import NixManager.Admin.BuildState ( BuildState ) 18 | import Data.Generics.Labels ( ) 19 | import GHC.Generics ( Generic ) 20 | 21 | -- | Contains all data for the garbage collection GUI 22 | data GarbageData = GarbageData { 23 | processOutput :: ProcessOutput -- ^ Output of the current or last garbage collection process (possibly empty) 24 | , buildState :: Maybe BuildState -- ^ Contains the current build state of the garbage collection 25 | , detailsState :: DetailsState -- ^ Are the Details expanded? 26 | , olderGenerations :: Bool -- ^ Shall we delete older generations? 27 | } deriving(Generic) 28 | 29 | -- | The initial garbage collection state 30 | initialGarbageData :: GarbageData 31 | initialGarbageData = GarbageData mempty Nothing DetailsContracted False 32 | -------------------------------------------------------------------------------- /src/NixManager/Admin/RebuildData.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains all data for the rebuild GUI 3 | Contains all data for the rebuild GUI 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | module NixManager.Admin.RebuildData 7 | ( RebuildData(..) 8 | , initialRebuildData 9 | ) 10 | where 11 | 12 | import NixManager.Process ( ProcessOutput ) 13 | import NixManager.Admin.BuildState ( BuildState ) 14 | import NixManager.View.DetailsState ( DetailsState 15 | ( DetailsContracted 16 | ) 17 | ) 18 | import Data.Generics.Labels ( ) 19 | import GHC.Generics ( Generic ) 20 | 21 | -- | Contains all data for the rebuild GUI 22 | data RebuildData = RebuildData { 23 | processOutput :: ProcessOutput -- ^ Output of the current or last rebuild process (possibly empty) 24 | , buildState :: Maybe BuildState -- ^ Contains the current build state of the rebuild 25 | , activeRebuildModeIdx :: Int -- ^ Index of the active rebuild mode, see "NixManager.NixRebuildMode" 26 | , detailsState :: DetailsState -- ^ Are the Details expanded? 27 | , doUpdate :: Bool -- ^ Shall we do an update? 28 | , doRollback :: Bool -- ^ Shall we do a rollback 29 | } deriving(Generic) 30 | 31 | -- | The initial rebuild state 32 | initialRebuildData :: RebuildData 33 | initialRebuildData = RebuildData mempty Nothing 0 DetailsContracted False False 34 | -------------------------------------------------------------------------------- /src/NixManager/Admin/State.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-| 4 | Description: Contains all the state for the Administration tab 5 | Contains all the state for the Administration tab 6 | -} 7 | module NixManager.Admin.State 8 | ( State(..) 9 | , initState 10 | , determineChanges 11 | ) 12 | where 13 | 14 | import NixManager.ChangeType ( ChangeType(Changes, NoChanges) 15 | ) 16 | import NixManager.Admin.RebuildData ( RebuildData 17 | , initialRebuildData 18 | ) 19 | import NixManager.Admin.GarbageData ( GarbageData 20 | , initialGarbageData 21 | ) 22 | import NixManager.NixServicesUtil ( locateLocalServicesFile 23 | , locateRootServicesFile 24 | ) 25 | import NixManager.NixPackagesUtil ( locateLocalPackagesFile 26 | , locateRootPackagesFile 27 | ) 28 | import NixManager.Util ( determineFilesEqual ) 29 | import Data.Generics.Labels ( ) 30 | import GHC.Generics ( Generic ) 31 | 32 | -- | Contains all the state for the administration tab 33 | data State = State { 34 | rebuildData :: RebuildData -- ^ The “Rebuild” GUI state 35 | , garbageData :: GarbageData -- ^ The “Collect garbage” GUI state 36 | , changes :: ChangeType -- ^ Information about whether we have unapplied changes 37 | } deriving(Generic) 38 | 39 | -- | Determine if there are changes that have to be applied. 40 | determineChanges :: IO ChangeType 41 | determineChanges = do 42 | packagesEqual <- determineFilesEqual locateLocalPackagesFile 43 | locateRootPackagesFile 44 | servicesEqual <- determineFilesEqual locateLocalServicesFile 45 | locateRootServicesFile 46 | pure (if packagesEqual && servicesEqual then NoChanges else Changes) 47 | 48 | 49 | -- | The initial Administation tab state (needs to determine changes, hence the side-effect) 50 | initState :: IO State 51 | initState = State initialRebuildData initialGarbageData <$> determineChanges 52 | -------------------------------------------------------------------------------- /src/NixManager/Admin/ValidRebuildModes.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains a subset of 'NixRebuildMode' deemed “sensible” for the Manager 3 | Contains a subset of 'NixRebuildMode' deemed “sensible” for the Manager 4 | -} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | module NixManager.Admin.ValidRebuildModes 7 | ( validRebuildModesWithDescription 8 | , validRebuildModes 9 | , descriptionForValidRebuildMode 10 | , validRebuildModeIdx 11 | ) 12 | where 13 | 14 | import Data.Maybe ( fromJust ) 15 | import Control.Lens ( Iso' 16 | , iso 17 | ) 18 | import Data.List ( elemIndex ) 19 | import NixManager.NixRebuildMode ( NixRebuildMode 20 | ( NixRebuildSwitch 21 | , NixRebuildDryBuild 22 | , NixRebuildDryActivate 23 | ) 24 | ) 25 | import Data.Text ( Text ) 26 | 27 | -- | Get a nice description for a given rebuild mode (if it’s a “valid” one) 28 | descriptionForValidRebuildMode :: NixRebuildMode -> Maybe Text 29 | descriptionForValidRebuildMode m = lookup m validRebuildModesWithDescription 30 | 31 | -- | List of all valid rebuild modes with a description 32 | validRebuildModesWithDescription :: [(NixRebuildMode, Text)] 33 | validRebuildModesWithDescription = 34 | [ ( NixRebuildSwitch 35 | , "Build and activate the changes immediately. You can go back to previous configurations by rebooting and selecting an older generation." 36 | ) 37 | -- , ( NixRebuildBoot 38 | -- , "Build the new configuration and make it the boot default, but do not activate it. That is, the system continues to run the previous configuration until the next reboot." 39 | -- ) 40 | -- , ( NixRebuildTest 41 | -- , "Build and activate the new configuration, but do not add it to the GRUB boot menu. Thus, if you reboot the system (or if it crashes), you will automatically revert to the default configuration (i.e. the configuration resulting from the last rebuild)." 42 | -- ) 43 | , ( NixRebuildDryBuild 44 | , "Show what store paths would be built or downloaded by any of the operations above, but otherwise do nothing." 45 | ) 46 | , ( NixRebuildDryActivate 47 | , "Build the new configuration, but instead of activating it, show what changes would be performed by the activation. For instance, this command will print which systemd units would be restarted. The list of changes is not guaranteed to be complete." 48 | ) 49 | ] 50 | 51 | -- | List of “valid” rebuild modes 52 | validRebuildModes :: [NixRebuildMode] 53 | validRebuildModes = fst <$> validRebuildModesWithDescription 54 | 55 | -- | Convert between a rebuild mode and its index in the list of valid modes (needed for the "NixManager.View.ComboBox") 56 | validRebuildModeIdx :: Iso' NixRebuildMode Int 57 | validRebuildModeIdx = 58 | iso (fromJust . (`elemIndex` validRebuildModes)) (validRebuildModes !!) 59 | -------------------------------------------------------------------------------- /src/NixManager/AskPass.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Tools to wrap “sudo” and “gksudo” using the "NixManager.Bash" module. 3 | -} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE OverloadedLists #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | module NixManager.AskPass 8 | ( sudoExpr 9 | , askPass 10 | ) 11 | where 12 | 13 | import Data.Text ( Text ) 14 | import NixManager.Bash ( Expr(Command) 15 | , Arg(LiteralArg) 16 | , evalExpr 17 | ) 18 | import Prelude hiding ( readFile ) 19 | import NixManager.Process ( runProcess 20 | , noStdin 21 | , ProcessData 22 | ) 23 | 24 | 25 | -- |Transform the expression, evaluating it inside a sudo expression 26 | sudoExpr :: Expr -> Expr 27 | sudoExpr e = Command 28 | "sudo" 29 | ["-H", "-S", "-u", "root", "--", "sh", "-c", LiteralArg (evalExpr e)] 30 | 31 | -- |Expression to run “gksudo” with the specified description, printing the password on stdout 32 | askPassExpr :: Text -> Expr 33 | askPassExpr description = 34 | Command "gksudo" ["--description", LiteralArg description, "--print-pass"] 35 | 36 | -- |Run “gksudo” with a fitting description, printing the password on stdout 37 | askPass :: IO ProcessData 38 | askPass = runProcess noStdin (askPassExpr "NixOS Manager") 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /src/NixManager/Bash.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: A little DSL to construct valid Bash expressions that can then be passed to "NixManager.Process" 3 | -} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module NixManager.Bash 6 | ( Expr(..) 7 | , Arg(..) 8 | , evalExpr 9 | , appendArgs 10 | , devNullify 11 | , (&&.) 12 | , argText 13 | , (||.) 14 | , (>>.) 15 | ) 16 | where 17 | 18 | import NixManager.Util ( surround ) 19 | import Data.Text ( Text 20 | , unwords 21 | , replace 22 | , isInfixOf 23 | , pack 24 | ) 25 | import Data.String ( IsString 26 | , fromString 27 | ) 28 | import Prelude hiding ( unwords 29 | , elem 30 | ) 31 | 32 | 33 | -- | The type of bash argument 34 | data Arg = LiteralArg Text -- ^ A literal argument that will be surrounded by quotes and/or escaped if it contains special characters 35 | | RawArg Text -- ^ A "raw" argument that is not subject to escaping/quoting. 36 | 37 | instance IsString Arg where 38 | fromString = LiteralArg . pack 39 | 40 | -- | A very small subset of a bash grammar. 41 | data Expr = Command Text [Arg] -- ^ A command with some arguments 42 | | And Expr Expr -- ^ Serializes to @a && b@ 43 | | Or Expr Expr -- ^ Serializes to @a || b@ 44 | | Then Expr Expr -- ^ Serializes to @a; b@ 45 | | Subshell Expr -- ^ Serializes to (expr) 46 | 47 | -- | Alias for @&&@ (resembling the Bash expression) 48 | (&&.) :: Expr -> Expr -> Expr 49 | (&&.) = And 50 | 51 | -- | Alias for @||@ (resembling the Bash expression) 52 | (||.) :: Expr -> Expr -> Expr 53 | (||.) = Or 54 | 55 | -- | Alias for @Then@ (resembling the @>>@ monad operator) 56 | (>>.) :: Expr -> Expr -> Expr 57 | (>>.) = Then 58 | 59 | -- | Escape a piece of text. Currently only supports escaping double quotes. More to come? 60 | escape :: Text -> Text 61 | escape = replace "\"" "\\\"" 62 | 63 | -- | Determine if the text contains characters that are special for bash. 64 | specialChar :: Text -> Bool 65 | specialChar t = " " `isInfixOf` t || "<" `isInfixOf` t || ">" `isInfixOf` t 66 | 67 | -- | Convert an argument to a text, optionally escaping it. 68 | maybeSurround :: Arg -> Text 69 | maybeSurround (RawArg t) = t 70 | maybeSurround (LiteralArg t) | specialChar t = surround "\"" (escape t) 71 | | otherwise = escape t 72 | 73 | -- | Return the argument’s content, disregarding quoting 74 | argText :: Arg -> Text 75 | argText (RawArg t) = t 76 | argText (LiteralArg t) = t 77 | 78 | -- | Evaluate an expression to a bash string. 79 | evalExpr :: Expr -> Text 80 | evalExpr (And l r ) = evalExpr l <> " && " <> evalExpr r 81 | evalExpr (Then l r ) = evalExpr l <> " ; " <> evalExpr r 82 | evalExpr (Or l r ) = evalExpr l <> " || " <> evalExpr r 83 | evalExpr (Command c args ) = c <> " " <> unwords (maybeSurround <$> args) 84 | evalExpr (Subshell subExpr) = "(" <> evalExpr subExpr <> ")" 85 | 86 | -- | Recurse through the expression, adding arguments to all @Command@ constructors found. 87 | appendArgs :: [Arg] -> Expr -> Expr 88 | appendArgs newArgs (Command t args) = Command t (args <> newArgs) 89 | appendArgs newArgs (And l r) = 90 | And (appendArgs newArgs l) (appendArgs newArgs r) 91 | appendArgs newArgs (Or l r) = Or (appendArgs newArgs l) (appendArgs newArgs r) 92 | appendArgs newArgs (Then l r) = 93 | Then (appendArgs newArgs l) (appendArgs newArgs r) 94 | appendArgs newArgs (Subshell e) = Subshell (appendArgs newArgs e) 95 | 96 | -- | Recurse through the expression, adding @>/dev/null@ and @2>&1@ to surpress any output of the command. 97 | devNullify :: Expr -> Expr 98 | devNullify = appendArgs [RawArg ">/dev/null", RawArg "2>&1"] 99 | -------------------------------------------------------------------------------- /src/NixManager/ChangeType.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Determine if the user made any changes which will have to be applied. 3 | -} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | module NixManager.ChangeType 6 | ( ChangeType(..) 7 | ) 8 | where 9 | 10 | import GHC.Generics ( Generic ) 11 | 12 | -- | Avoid boolean blindness by using this enum instead. 13 | data ChangeType = NoChanges -- ^ No changes to apply 14 | | Changes -- ^ There are changes to apply 15 | deriving (Eq, Bounded, Enum, Generic) 16 | -------------------------------------------------------------------------------- /src/NixManager/Constants.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Various constants that are used throughout the application 3 | -} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module NixManager.Constants 6 | ( appName 7 | , rootManagerPath 8 | , globalOptionsMagicString 9 | ) 10 | where 11 | 12 | import Data.Text ( Text ) 13 | 14 | -- | The application name, in case that needs to be displayed (it’s used when determining the application’s save paths) 15 | appName :: String 16 | appName = "nixos-manager" 17 | 18 | -- | Where to put the configuration files for root. We could create a config file for this sooner or later. 19 | rootManagerPath :: FilePath 20 | rootManagerPath = "/etc/nixos/nixos-manager" 21 | 22 | -- | String for those options below a service that don’t have a suffix (like @nix.path@) 23 | globalOptionsMagicString :: Text 24 | globalOptionsMagicString = "Global options" 25 | 26 | 27 | -------------------------------------------------------------------------------- /src/NixManager/Docbook.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Tools to parse and transform the Docbook descriptions for, e.g. services, into GTK pango markup (see https://developer.gnome.org/pango/stable/pango-Markup.html) 3 | 4 | Tools to parse and transform the Docbook descriptions for, e.g. services, into GTK pango markup (see https://developer.gnome.org/pango/stable/pango-Markup.html) 5 | -} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | module NixManager.Docbook 8 | ( parseDocbook 9 | , docbookToPango 10 | ) 11 | where 12 | 13 | import Data.Text ( Text 14 | , replace 15 | ) 16 | import Text.XML ( parseText 17 | , Element 18 | , Document 19 | , Node 20 | ( NodeContent 21 | , NodeComment 22 | , NodeElement 23 | , NodeInstruction 24 | ) 25 | ) 26 | import Data.Default ( def ) 27 | import NixManager.Util ( TextualError 28 | , Endo 29 | , surroundSimple 30 | , fromExceptionEither 31 | , addToError 32 | ) 33 | import Control.Lens ( view 34 | , to 35 | , (^.) 36 | , plate 37 | , folded 38 | ) 39 | import Text.XML.Lens ( nodes 40 | , localName 41 | , root 42 | , text 43 | , attr 44 | , named 45 | ) 46 | import Data.Text.Lazy ( fromStrict ) 47 | 48 | -- | Parse a docbook string into a valid 'Document' (or return an error) 49 | parseDocbook :: Text -> TextualError Document 50 | parseDocbook = 51 | addToError "error parsing documentation: " 52 | . fromExceptionEither 53 | . parseText def 54 | . fromStrict 55 | . surroundSimple "root" -- the XML parser needs a root element 56 | 57 | -- | Stupidly replace HTML entities by their ampersandish equivalents (GTK will complain otherwise). This function possibly misses entities, I haven't look them all up. 58 | replaceEntities :: Endo Text 59 | replaceEntities = 60 | replace "<" "<" . replace ">" ">" . replace "\"" """ 61 | 62 | -- | Convert Docbook XML to Pango XML 63 | docbookToPango :: Document -> Text 64 | docbookToPango rootNode = rootNode ^. root . nodes . folded . to nodeToPango 65 | where 66 | nodeToPango :: Node -> Text 67 | nodeToPango (NodeElement e) = nodeElementToPango (e ^. localName) e 68 | nodeToPango (NodeContent t) = replaceEntities t 69 | nodeToPango (NodeInstruction _) = "" 70 | nodeToPango (NodeComment _) = "" 71 | makeTt = surroundSimple "tt" . replaceEntities . view text 72 | nodeElementToPango :: Text -> Element -> Text 73 | nodeElementToPango "link" e = e ^. attr "href" 74 | nodeElementToPango "filename" e = makeTt e 75 | nodeElementToPango "literal" e = makeTt e 76 | nodeElementToPango "command" e = makeTt e 77 | nodeElementToPango "option" e = makeTt e 78 | nodeElementToPango "code" e = makeTt e 79 | nodeElementToPango "programlisting" e = makeTt e 80 | nodeElementToPango "varname" e = makeTt e 81 | nodeElementToPango "citerefentry" e = 82 | "man " 83 | <> (e ^. plate . named "manvolnum" . text) 84 | <> " " 85 | <> (e ^. plate . named "refentrytitle" . text) 86 | nodeElementToPango _ e = e ^. nodes . folded . to nodeToPango 87 | -------------------------------------------------------------------------------- /src/NixManager/HMAdmin/BuildState.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-| 3 | Description: Contains just the "BuildState" data type 4 | Contains just the "BuildState" data type 5 | -} 6 | module NixManager.HMAdmin.BuildState 7 | ( BuildState(BuildState) 8 | ) 9 | where 10 | 11 | import NixManager.Process ( ProcessData ) 12 | import GHC.Generics ( Generic ) 13 | 14 | -- | Contains all the data corresponding to “some program that’s currently running” 15 | data BuildState = BuildState { 16 | counter :: Int -- ^ This field is necessary to “pulse” the GTK progress bar while building, see "NixManager.View.ProgressBar" for details 17 | , processData :: ProcessData -- ^ The process data 18 | } deriving(Generic) 19 | -------------------------------------------------------------------------------- /src/NixManager/HMAdmin/Event.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the event type for all events corresponding to the home-manager Administration tab 3 | 4 | Contains the event type for all events corresponding to the home-manager Administration tab 5 | -} 6 | module NixManager.HMAdmin.Event 7 | ( Event(..) 8 | ) 9 | where 10 | 11 | import NixManager.ChangeType ( ChangeType ) 12 | import NixManager.Process ( ProcessData 13 | , ProcessOutput 14 | ) 15 | import NixManager.View.DetailsState ( DetailsState ) 16 | import System.Exit ( ExitCode ) 17 | import qualified NixManager.HMAdmin.GenerationsView 18 | as GenerationsView 19 | 20 | data Event = EventRebuild -- ^ Triggered by the Rebuild button. Starts the home-manager rebuild process. 21 | | EventRebuildStarted ProcessData -- ^ Is emitted after the rebuild has started and initiates the “watchdog” event. 22 | | EventRebuildWatch ProcessOutput ProcessData -- ^ This event is emitted at regular intervals after the rebuild process is launched. 23 | | EventRebuildFinished ProcessOutput ExitCode -- ^ Emitted when the rebuild process finishes. 24 | | EventRebuildModeIdxChanged Int -- ^ Emitted when the rebuild mode changes 25 | | EventRebuildCancel -- ^ Emitted when the user clicks Cancel on a running rebuild 26 | | EventRebuildChangeDetails DetailsState -- ^ Emitted when the rebuild details are expanded/contracted 27 | | EventGarbageChangeDetails DetailsState -- ^ Emitted when the garbage details are expanded/contracted 28 | | EventGarbage -- ^ Triggered by the Collect Garbage button. Starts the garbage collection. 29 | | EventGarbageStarted ProcessData -- ^ Is emitted after the garbage collection has started and initiates the “watchdog” event. 30 | | EventGarbageWatch ProcessOutput ProcessData -- ^ This event is emitted at regular intervals after the garbage collect process is launched. 31 | | EventGarbageFinished ProcessOutput ExitCode -- ^ Emitted when the garbage collection process finishes. 32 | | EventGarbageCancel -- ^ Emitted when the user clicks Cancel on a running garbage collection 33 | | EventReload -- ^ Even that’s fired when we need to re-check if there are changes to be applied 34 | | EventReloadFinished ChangeType -- ^ Is fired when the results of aforementioned changes check are in 35 | | EventGenerations GenerationsView.Event -- ^ Wrapper event for the home-manager generations view “widget” 36 | -------------------------------------------------------------------------------- /src/NixManager/HMAdmin/GarbageData.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains all data for the garbage collection GUI 3 | Contains all data for the garbage collection GUI 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | module NixManager.HMAdmin.GarbageData 7 | ( GarbageData(..) 8 | , initialGarbageData 9 | ) 10 | where 11 | 12 | import NixManager.View.DetailsState ( DetailsState 13 | ( DetailsContracted 14 | ) 15 | ) 16 | import NixManager.Process ( ProcessOutput ) 17 | import NixManager.HMAdmin.BuildState ( BuildState ) 18 | import GHC.Generics ( Generic ) 19 | 20 | -- | Contains all data for the garbage collection GUI 21 | data GarbageData = GarbageData { 22 | processOutput :: ProcessOutput -- ^ Output of the current or last garbage collection process (possibly empty) 23 | , buildState :: Maybe BuildState -- ^ Contains the current build state of the garbage collection 24 | , detailsState :: DetailsState -- ^ Are the Details expanded? 25 | , olderGenerations :: Bool -- ^ Shall we delete older generations? 26 | } deriving(Generic) 27 | 28 | -- | The initial garbage collection state 29 | initialGarbageData :: GarbageData 30 | initialGarbageData = GarbageData mempty Nothing DetailsContracted False 31 | -------------------------------------------------------------------------------- /src/NixManager/HMAdmin/GenerationsData.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedLabels #-} 3 | {-| 4 | Description: State data for the home-manager generations view in case the generations command succeeded 5 | State data for the home-manager generations view in case the generations command succeeded 6 | -} 7 | module NixManager.HMAdmin.GenerationsData 8 | ( GenerationsData(GenerationsData) 9 | , selectedGeneration 10 | ) 11 | where 12 | 13 | import NixManager.HMGenerations ( GenerationLine ) 14 | import NixManager.Message ( Message ) 15 | import Control.Lens ( Traversal' 16 | , traversed 17 | ) 18 | import NixManager.Util ( indirectIndexTraversal ) 19 | import GHC.Generics ( Generic ) 20 | 21 | -- | State data for the home-manager generations view in case the generations command succeeded 22 | data GenerationsData = GenerationsData { 23 | selectedGenerationIdx :: Maybe Int -- ^ Currently selected generation, if any 24 | , message :: Maybe Message -- ^ A message to display (for example, about a success while switching generations) 25 | , generations :: [GenerationLine] -- ^ The actual generations 26 | } deriving(Generic) 27 | 28 | -- | Traversal over the currently selected generation(s) 29 | selectedGeneration :: Traversal' GenerationsData GenerationLine 30 | selectedGeneration = 31 | indirectIndexTraversal #selectedGenerationIdx (#generations . traversed) 32 | -------------------------------------------------------------------------------- /src/NixManager/HMAdmin/GenerationsState.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-| 5 | Description: Contains all state data for the home-manager generations view 6 | Contains all state data for the home-manager generations view 7 | -} 8 | module NixManager.HMAdmin.GenerationsState 9 | ( GenerationsState(..) 10 | , initGenerationsState 11 | ) 12 | where 13 | 14 | import NixManager.HMGenerations ( readGenerations ) 15 | import NixManager.HMAdmin.GenerationsData 16 | ( GenerationsData 17 | ( GenerationsData 18 | ) 19 | ) 20 | import Data.Text ( Text ) 21 | import Data.Validation ( Validation(Failure, Success) ) 22 | import GHC.Generics ( Generic ) 23 | 24 | -- | Current state of the generations view (depends on the success of the @home-manager generations@ call) 25 | data GenerationsState = ValidGenerationsState GenerationsData 26 | | InvalidGenerationsState Text 27 | deriving(Generic) 28 | 29 | -- | Initial state for the generations view (tries to read the generations, hence the side-effect) 30 | initGenerationsState :: IO GenerationsState 31 | initGenerationsState = readGenerations >>= \case 32 | Failure e -> 33 | pure $ InvalidGenerationsState ("Couldn't read generations: " <> e) 34 | Success g -> pure $ ValidGenerationsState (GenerationsData Nothing Nothing g) 35 | -------------------------------------------------------------------------------- /src/NixManager/HMAdmin/RebuildData.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains all data for the rebuild GUI 3 | Contains all data for the rebuild GUI 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | module NixManager.HMAdmin.RebuildData 7 | ( RebuildData(..) 8 | , initialRebuildData 9 | ) 10 | where 11 | 12 | import NixManager.Process ( ProcessOutput ) 13 | import NixManager.HMAdmin.BuildState ( BuildState ) 14 | import NixManager.View.DetailsState ( DetailsState 15 | ( DetailsContracted 16 | ) 17 | ) 18 | import GHC.Generics ( Generic ) 19 | 20 | -- | Contains all data for the rebuild GUI 21 | data RebuildData = RebuildData { 22 | processOutput :: ProcessOutput -- ^ Output of the current or last rebuild process (possibly empty) 23 | , buildState :: Maybe BuildState -- ^ Contains the current build state of the rebuild 24 | , activeRebuildModeIdx :: Int -- ^ Index of the active rebuild mode, see "NixManager.HMAdmin.RebuildMode" 25 | , detailsState :: DetailsState -- ^ Are the Details expanded? 26 | } deriving(Generic) 27 | 28 | -- | The initial rebuild state 29 | initialRebuildData :: RebuildData 30 | initialRebuildData = RebuildData mempty Nothing 0 DetailsContracted 31 | -------------------------------------------------------------------------------- /src/NixManager/HMAdmin/State.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-| 4 | Description: Contains all the state for the home-manager Administration tab 5 | -} 6 | module NixManager.HMAdmin.State 7 | ( State 8 | , rebuildData 9 | , garbageData 10 | , changes 11 | , generationsState 12 | , determineChanges 13 | , initState 14 | ) 15 | where 16 | 17 | import GHC.Generics ( Generic ) 18 | import NixManager.ChangeType ( ChangeType(Changes, NoChanges) 19 | ) 20 | import NixManager.HMAdmin.RebuildData ( RebuildData 21 | , initialRebuildData 22 | ) 23 | import NixManager.HMAdmin.GarbageData ( GarbageData 24 | , initialGarbageData 25 | ) 26 | import NixManager.HMServicesUtil ( locatePendingServicesFile 27 | , locateInstalledServicesFile 28 | ) 29 | import NixManager.HMPackagesUtil ( locatePendingPackagesFile 30 | , locateInstalledPackagesFile 31 | ) 32 | import NixManager.Util ( determineFilesEqual ) 33 | import NixManager.HMAdmin.GenerationsState 34 | ( GenerationsState 35 | , initGenerationsState 36 | ) 37 | 38 | -- | Contains all the state for the administration tab 39 | data State = State { 40 | rebuildData :: RebuildData -- ^ The “Rebuild” GUI state 41 | , garbageData :: GarbageData -- ^ The “Collect garbage” GUI state 42 | , changes :: ChangeType -- ^ Information about whether we have unapplied changes 43 | , generationsState :: GenerationsState -- ^ Information about home-manager generations 44 | } deriving(Generic) 45 | 46 | -- | Determine if there are changes that have to be applied. 47 | determineChanges :: IO ChangeType 48 | determineChanges = do 49 | packagesEqual <- determineFilesEqual locatePendingPackagesFile 50 | locateInstalledPackagesFile 51 | servicesEqual <- determineFilesEqual locatePendingServicesFile 52 | locateInstalledServicesFile 53 | 54 | pure (if packagesEqual && servicesEqual then NoChanges else Changes) 55 | 56 | -- | The initial Administation tab state (needs to determine changes, hence the side-effect) 57 | initState :: IO State 58 | initState = 59 | State initialRebuildData initialGarbageData 60 | <$> determineChanges 61 | <*> initGenerationsState 62 | -------------------------------------------------------------------------------- /src/NixManager/HMGarbage.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-| 3 | Description: Contains functions related to collecting garbage as a user (e.g. “with home-manager”) 4 | Contains functions related to collecting garbage as a user (e.g. “with home-manager”) 5 | -} 6 | module NixManager.HMGarbage 7 | ( collectGarbage 8 | ) 9 | where 10 | 11 | import NixManager.Bash ( Expr(Command) ) 12 | import NixManager.Process ( runProcess 13 | , noStdin 14 | , ProcessData 15 | ) 16 | 17 | -- | The bash expression for @nix-collect-garbage@ 18 | collectGarbageExpr :: Expr 19 | collectGarbageExpr = Command "nix-collect-garbage" mempty 20 | 21 | -- | Start the garbage collection 22 | collectGarbage :: IO ProcessData 23 | collectGarbage = runProcess noStdin collectGarbageExpr 24 | -------------------------------------------------------------------------------- /src/NixManager/HMGenerations.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains code to read and manipulate home-manager’s generations 3 | Contains code to read and manipulate home-manager’s generations 4 | -} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | {-# LANGUAGE DeriveGeneric #-} 8 | module NixManager.HMGenerations 9 | ( readGenerations 10 | , removeGeneration 11 | , GenerationLine 12 | , activateGeneration 13 | ) 14 | where 15 | 16 | import Data.Validation ( Validation(Failure) ) 17 | import System.Exit ( ExitCode(ExitFailure) ) 18 | import NixManager.Process ( runProcessToFinish 19 | , noStdin 20 | ) 21 | import Control.Lens ( (^?!) 22 | , to 23 | , folded 24 | , (^.) 25 | ) 26 | import Data.Monoid ( getFirst ) 27 | import NixManager.Bash ( Expr(Command) 28 | , Arg(LiteralArg) 29 | ) 30 | import NixManager.Util ( TextualError 31 | , parseSafe 32 | , showText 33 | , decodeUtf8 34 | , addToError 35 | ) 36 | import Control.Monad ( void ) 37 | import Data.Void ( Void ) 38 | import Text.Megaparsec ( Parsec 39 | , takeWhile1P 40 | , parse 41 | , errorBundlePretty 42 | , sepEndBy 43 | ) 44 | import Text.Megaparsec.Byte ( char 45 | , newline 46 | , string 47 | ) 48 | import Data.ByteString ( ByteString ) 49 | import Data.ByteString.Char8 ( unpack ) 50 | import Data.Char ( ord ) 51 | import Data.Bifunctor ( first ) 52 | import Data.Time.Clock ( UTCTime ) 53 | import Data.Time.LocalTime ( TimeZone 54 | , localTimeToUTC 55 | , LocalTime 56 | , getZonedTime 57 | , ZonedTime 58 | , zonedTimeZone 59 | , zonedTimeToUTC 60 | ) 61 | import Data.Time.Format ( parseTimeM 62 | , defaultTimeLocale 63 | ) 64 | import Data.Text ( Text 65 | , pack 66 | ) 67 | import Text.Time.Pretty ( prettyTimeAuto ) 68 | import GHC.Generics ( Generic ) 69 | 70 | -- | One home-manager generation line 71 | data GenerationLine = GenerationLine { 72 | date :: UTCTime -- ^ The parsed activation date for the generation 73 | , datePretty :: Text -- ^ The prettified, human-readable date for the generation 74 | , genId :: ByteString -- ^ The generation’s id, here as a text, since I wasn’t sure if it’s always numeric 75 | , path :: ByteString -- ^ The generation’s path, which is vital for activating it 76 | } deriving(Show, Generic) 77 | 78 | -- | Parsec type for the parser. 79 | type Parser = Parsec Void ByteString 80 | 81 | -- | Roughly parse a word 82 | wordParser :: Parser ByteString 83 | wordParser = takeWhile1P Nothing (/= fromIntegral (ord ' ')) 84 | 85 | -- | Parse anything that's not EOL 86 | nonEolParser :: Parser ByteString 87 | nonEolParser = takeWhile1P Nothing (/= fromIntegral (ord '\n')) 88 | 89 | -- | Parse home-manager’s time format 90 | parseTime :: String -> Maybe LocalTime 91 | parseTime = parseTimeM False defaultTimeLocale "%0Y-%m-%d %H:%M" 92 | 93 | -- | Parse home-manager’s time format as UTC 94 | generationTimeParser :: TimeZone -> Parser UTCTime 95 | generationTimeParser tz = do 96 | yymmdd <- wordParser 97 | void (char (fromIntegral (ord ' '))) 98 | hhmm <- wordParser 99 | localTime <- maybe (fail "wrong date/time format for generation") 100 | pure 101 | (parseTime (unpack yymmdd <> " " <> unpack hhmm)) 102 | pure (localTimeToUTC tz localTime) 103 | 104 | -- | Parse a whole generation line, given the current date, time and time zone 105 | generationLineParser :: ZonedTime -> Parser GenerationLine 106 | generationLineParser now = do 107 | time <- generationTimeParser (zonedTimeZone now) 108 | let timePretty = pack (prettyTimeAuto (zonedTimeToUTC now) time) 109 | GenerationLine time timePretty 110 | <$> (string " : id " *> wordParser) 111 | <*> (string " -> " *> nonEolParser) 112 | 113 | -- | Parse @home-manager generations@, given the current date, time and time zone 114 | parseGenerations :: ZonedTime -> ByteString -> TextualError [GenerationLine] 115 | parseGenerations now = parseSafe 116 | (generationLineParser now `sepEndBy` newline) 117 | "home-manager generations" 118 | 119 | 120 | -- | Remove a specific generation 121 | removeGeneration :: GenerationLine -> IO () 122 | removeGeneration genLine = void $ runProcessToFinish noStdin $ Command 123 | "home-manager" 124 | ["remove-generations", LiteralArg (genLine ^. #genId . decodeUtf8)] 125 | 126 | -- | Activate a specific generation 127 | activateGeneration :: GenerationLine -> IO () 128 | activateGeneration genLine = void $ runProcessToFinish noStdin $ Command 129 | ((genLine ^. #path . decodeUtf8) <> "/activate") 130 | [] 131 | 132 | -- | Read all generations 133 | readGenerations :: IO (TextualError [GenerationLine]) 134 | readGenerations = do 135 | nowZoned <- getZonedTime 136 | po <- runProcessToFinish noStdin (Command "home-manager" ["generations"]) 137 | case po ^?! #result . to getFirst . folded of 138 | ExitFailure code -> pure 139 | (Failure 140 | ( "Error executing generations query for home-manager. Exit code was: " 141 | <> showText code 142 | <> ". The stderr output was:\n\n" 143 | <> (po ^. #stderr . decodeUtf8) 144 | ) 145 | ) 146 | _ -> pure 147 | (addToError "Couldn't parse generations output: " 148 | (parseGenerations nowZoned (po ^. #stdout)) 149 | ) 150 | -------------------------------------------------------------------------------- /src/NixManager/HMPackages/Event.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the event type for all events corresponding to the Packages tab 3 | Contains the event type for all events corresponding to the Packages tab 4 | -} 5 | module NixManager.HMPackages.Event 6 | ( Event(..) 7 | ) 8 | where 9 | 10 | import NixManager.NixPackage ( NixPackage ) 11 | import NixManager.Message ( Message ) 12 | import qualified NixManager.View.PackageEditView 13 | as PackageEditView 14 | 15 | data Event = EventPackageEditView PackageEditView.Event -- ^ Triggered whenever the search entry changes 16 | | EventInstallCompleted [NixPackage] PackageEditView.InstallationType -- ^ Triggered when the installation of a package is successful. We pass the new package cache here so we can immediately update the state with it. 17 | | EventUninstallCompleted [NixPackage] PackageEditView.InstallationType -- ^ Triggered when the uninstallation of a package is successful. We pass the new package cache here so we can immediately update the state with it. 18 | | EventOperationCompleted Message PackageEditView.CompletionType -- ^ Whenever an operation (install/uninstall) completes, we emit this event and display a message 19 | | EventReload -- ^ This is triggered externally whenever we need to reload the cache. For example, when we rebuild successfully, we need to update the package’s status. 20 | | EventReloadFinished [NixPackage] -- ^ Contains the new cache when the reloading finished. 21 | -------------------------------------------------------------------------------- /src/NixManager/HMPackages/State.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains all the state for the Packages tab 3 | -} 4 | module NixManager.HMPackages.State 5 | ( State 6 | , initState 7 | , emptyState 8 | ) 9 | where 10 | 11 | import NixManager.HMPackagesUtil ( readPackageCache ) 12 | import NixManager.Util ( TextualError 13 | , ifSuccessIO 14 | ) 15 | import qualified NixManager.View.PackageEditView 16 | as PackageEditView 17 | 18 | type State = PackageEditView.State 19 | 20 | -- | The initial Packages tab state (needs to read the package cache, hence the side-effect) 21 | initState :: IO (TextualError State) 22 | initState = 23 | ifSuccessIO readPackageCache (pure . pure . PackageEditView.initState) 24 | 25 | -- | An empty package state (we need this so we can "no-init" the home-manager package view if HM is disabled) 26 | emptyState :: State 27 | emptyState = PackageEditView.emptyState 28 | -------------------------------------------------------------------------------- /src/NixManager/HMPackages/Update.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the update logic for the Packages tab 3 | Contains the update logic for the Packages tab 4 | -} 5 | {-# LANGUAGE OverloadedLabels #-} 6 | {-# LANGUAGE LambdaCase #-} 7 | {-# LANGUAGE FlexibleContexts #-} 8 | {-# LANGUAGE OverloadedLists #-} 9 | {-# LANGUAGE BlockArguments #-} 10 | {-# LANGUAGE OverloadedStrings #-} 11 | module NixManager.HMPackages.Update 12 | ( updateEvent 13 | ) 14 | where 15 | 16 | import Data.Validation ( Validation(Failure, Success) ) 17 | import Control.Lens ( (&) 18 | , (^?) 19 | , (?~) 20 | , (.~) 21 | ) 22 | import NixManager.ManagerState ( ManagerState(..) ) 23 | import NixManager.HMPackages.Event ( Event 24 | ( EventOperationCompleted 25 | , EventInstallCompleted 26 | , EventUninstallCompleted 27 | , EventReload 28 | , EventReloadFinished 29 | , EventPackageEditView 30 | ) 31 | ) 32 | import qualified NixManager.HMAdmin.Event as HMAdminEvent 33 | import NixManager.Message ( errorMessage 34 | , infoMessage 35 | , Message 36 | ) 37 | import NixManager.ManagerEvent ( ManagerEvent 38 | ( ManagerEventHMPackages 39 | ) 40 | , pureTransition 41 | , liftUpdate 42 | , hmPackagesEvent 43 | , hmAdminEvent 44 | ) 45 | import NixManager.HMPackagesUtil ( installPackage 46 | , readPackageCache 47 | , uninstallPackage 48 | ) 49 | import GI.Gtk.Declarative.App.Simple ( Transition(Transition) ) 50 | import Prelude hiding ( length 51 | , putStrLn 52 | ) 53 | import qualified NixManager.View.PackageEditView 54 | as PEV 55 | 56 | -- | What message to display when the install operation completes 57 | installCompletedMessage :: PEV.InstallationType -> Message 58 | installCompletedMessage PEV.Uncancelled = infoMessage 59 | "Marked for installation! Head to the Admin tab to apply the changes." 60 | installCompletedMessage PEV.Cancelled = infoMessage "Uninstall cancelled!" 61 | 62 | -- | What message to display when the uninstall operation completes 63 | uninstallCompletedMessage :: PEV.InstallationType -> Message 64 | uninstallCompletedMessage PEV.Uncancelled = infoMessage 65 | "Marked for uninstall! Head to the Admin tab to apply the changes." 66 | uninstallCompletedMessage PEV.Cancelled = infoMessage "Installation cancelled!" 67 | 68 | -- | The actual update function 69 | updateEvent :: ManagerState -> Event -> Transition ManagerState ManagerEvent 70 | updateEvent s (EventOperationCompleted e completionType) = 71 | Transition (s & #hmPackagesState . #latestMessage ?~ e) 72 | $ case completionType of 73 | PEV.CompletionReload -> pure (hmAdminEvent HMAdminEvent.EventReload) 74 | PEV.CompletionPass -> pure Nothing 75 | updateEvent s (EventInstallCompleted cache installationType) = Transition 76 | ( s 77 | & #hmPackagesState 78 | . #packageCache 79 | .~ cache 80 | & #hmPackagesState 81 | . #selectedIdx 82 | .~ Nothing 83 | ) 84 | (pure 85 | (hmPackagesEvent 86 | (EventOperationCompleted (installCompletedMessage installationType) 87 | PEV.CompletionReload 88 | ) 89 | ) 90 | ) 91 | updateEvent s (EventUninstallCompleted cache installationType) = Transition 92 | ( s 93 | & #hmPackagesState 94 | . #packageCache 95 | .~ cache 96 | & #hmPackagesState 97 | . #selectedIdx 98 | .~ Nothing 99 | ) 100 | (pure 101 | (hmPackagesEvent 102 | (EventOperationCompleted (uninstallCompletedMessage installationType) 103 | PEV.CompletionReload 104 | ) 105 | ) 106 | ) 107 | updateEvent s (EventPackageEditView (PEV.EventInstall installationType)) = 108 | case s ^? #hmPackagesState . PEV.selectedPackage of 109 | Nothing -> pureTransition s 110 | Just selected -> Transition 111 | s 112 | do 113 | installResult <- installPackage selected 114 | cacheResult <- readPackageCache 115 | case installResult *> cacheResult of 116 | Success newCache -> 117 | pure 118 | (hmPackagesEvent (EventInstallCompleted newCache installationType) 119 | ) 120 | Failure e -> pure 121 | (hmPackagesEvent 122 | (EventOperationCompleted 123 | (errorMessage ("Install failed: " <> e)) 124 | PEV.CompletionReload 125 | ) 126 | ) 127 | updateEvent s (EventPackageEditView (PEV.EventUninstall installationType)) = 128 | case s ^? #hmPackagesState . PEV.selectedPackage of 129 | Nothing -> pureTransition s 130 | Just selected -> Transition 131 | s 132 | do 133 | uninstallResult <- uninstallPackage selected 134 | cacheResult <- readPackageCache 135 | case uninstallResult *> cacheResult of 136 | Success newCache -> 137 | pure 138 | (hmPackagesEvent 139 | (EventUninstallCompleted newCache installationType) 140 | ) 141 | Failure e -> pure 142 | (hmPackagesEvent 143 | (EventOperationCompleted 144 | (errorMessage ("Uninstall failed: " <> e)) 145 | PEV.CompletionReload 146 | ) 147 | ) 148 | updateEvent s EventReload = Transition 149 | s 150 | do 151 | cacheResult <- readPackageCache 152 | case cacheResult of 153 | Success newCache -> pure (hmPackagesEvent (EventReloadFinished newCache)) 154 | Failure e -> pure 155 | (hmPackagesEvent 156 | (EventOperationCompleted 157 | (errorMessage ("Couldn't reload packages cache: " <> e)) 158 | PEV.CompletionPass 159 | ) 160 | ) 161 | updateEvent s (EventReloadFinished newCache) = 162 | pureTransition (s & #hmPackagesState . #packageCache .~ newCache) 163 | updateEvent s (EventPackageEditView e) = liftUpdate 164 | PEV.updateEvent 165 | #hmPackagesState 166 | (ManagerEventHMPackages . EventPackageEditView) 167 | s 168 | e 169 | -------------------------------------------------------------------------------- /src/NixManager/HMPackages/View.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the actual GUI (widgets) for the Packages tab 3 | Contains the actual GUI (widgets) for the Packages tab 4 | -} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | module NixManager.HMPackages.View 8 | ( packagesBox 9 | ) 10 | where 11 | 12 | import qualified NixManager.View.PackageEditView 13 | as PackageEditView 14 | import NixManager.HMPackages.Event ( Event(EventPackageEditView) ) 15 | import Control.Lens ( (^.) ) 16 | import NixManager.ManagerState ( ManagerState ) 17 | import NixManager.ManagerEvent ( ManagerEvent 18 | ( ManagerEventHMPackages 19 | ) 20 | ) 21 | import GI.Gtk.Declarative ( Widget ) 22 | 23 | -- | The package list 24 | packagesBox :: ManagerState -> Widget ManagerEvent 25 | packagesBox s = 26 | ManagerEventHMPackages . EventPackageEditView <$> PackageEditView.packagesBox 27 | (s ^. #hmPackagesState) 28 | -------------------------------------------------------------------------------- /src/NixManager/HMRebuild.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE OverloadedLists #-} 3 | {-| 4 | Description: Contains functions relating to home-manager’s rebuild functionality 5 | Contains functions relating to home-manager’s rebuild functionality 6 | -} 7 | module NixManager.HMRebuild 8 | ( rebuild 9 | ) 10 | where 11 | 12 | import NixManager.PosixTools ( mkdir 13 | , cp 14 | ) 15 | import NixManager.Bash ( Expr(Command) 16 | , (&&.) 17 | ) 18 | import NixManager.HMRebuildMode ( HMRebuildMode 19 | ( RebuildSwitch 20 | , RebuildDrySwitch 21 | ) 22 | ) 23 | import NixManager.Process ( runProcess 24 | , noStdin 25 | , ProcessData 26 | ) 27 | import NixManager.HMPackagesUtil ( locatePendingPackagesFileMaybeCreate 28 | ) 29 | import NixManager.HMServicesUtil ( locatePendingServicesFileMaybeCreate 30 | ) 31 | import System.Directory ( getXdgDirectory 32 | , XdgDirectory(XdgCache) 33 | ) 34 | import NixManager.Constants ( appName ) 35 | 36 | -- | The bash expression corresponding to a rebuild 37 | rebuildExpr :: HMRebuildMode -> Expr 38 | rebuildExpr RebuildSwitch = Command "home-manager" ["switch"] 39 | rebuildExpr RebuildDrySwitch = Command "home-manager" ["-n", "switch"] 40 | 41 | -- | Given a rebuild mode, return the expression to rebuild (and save the result so we can compare changes) 42 | rebuildAndSaveExpr :: HMRebuildMode -> IO Expr 43 | rebuildAndSaveExpr RebuildSwitch = do 44 | cacheDir <- getXdgDirectory XdgCache appName 45 | pendingPackages <- locatePendingPackagesFileMaybeCreate 46 | pendingServices <- locatePendingServicesFileMaybeCreate 47 | pure 48 | ( mkdir True [cacheDir] 49 | &&. rebuildExpr RebuildSwitch 50 | &&. cp pendingPackages cacheDir 51 | &&. cp pendingServices cacheDir 52 | ) 53 | rebuildAndSaveExpr RebuildDrySwitch = pure (rebuildExpr RebuildDrySwitch) 54 | 55 | -- | Given a rebuild mode, rebuild (and save the result so we can compare changes) 56 | rebuild :: HMRebuildMode -> IO ProcessData 57 | rebuild mode = rebuildAndSaveExpr mode >>= runProcess noStdin 58 | -------------------------------------------------------------------------------- /src/NixManager/HMRebuildMode.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-| 3 | Description: Contains the "HMRebuildMode" data type and corresponding lenses/functions 4 | Contains the "HMRebuildMode" data type and corresponding lenses/functions 5 | -} 6 | module NixManager.HMRebuildMode 7 | ( HMRebuildMode(..) 8 | , rebuildModeToText 9 | , rebuildModeToDescription 10 | , rebuildModes 11 | , rebuildModeIdx 12 | ) 13 | where 14 | 15 | import Data.Text ( Text ) 16 | import Control.Lens ( iso 17 | , Iso' 18 | ) 19 | import Data.List ( elemIndex ) 20 | import Data.Maybe ( fromJust ) 21 | 22 | -- | Specifies home-manager’s rebuild modes 23 | data HMRebuildMode = RebuildSwitch -- ^ Corresponds to @home-manager switch@ 24 | | RebuildDrySwitch -- ^ Corresponds to @home-manager switch -n@ 25 | deriving(Eq, Ord, Enum, Bounded, Show) 26 | 27 | -- | Convert a rebuild mode to a text for the UI 28 | rebuildModeToText :: HMRebuildMode -> Text 29 | rebuildModeToText RebuildSwitch = "switch" 30 | rebuildModeToText RebuildDrySwitch = "dry-switch" 31 | 32 | -- | Convert a rebuild mode to a description text for the UI 33 | rebuildModeToDescription :: HMRebuildMode -> Text 34 | rebuildModeToDescription RebuildSwitch = "Build and activate configuration" 35 | rebuildModeToDescription RebuildDrySwitch = 36 | "Do a dry run, only print what actions would be taken" 37 | 38 | -- | List of all rebuild modes 39 | rebuildModes :: [HMRebuildMode] 40 | rebuildModes = [minBound .. maxBound] 41 | 42 | -- | The index of a rebuild mode inside the list of all rebuild modes and vice-versa. 43 | rebuildModeIdx :: Iso' HMRebuildMode Int 44 | rebuildModeIdx = iso (fromJust . (`elemIndex` rebuildModes)) (rebuildModes !!) 45 | -------------------------------------------------------------------------------- /src/NixManager/HMServices/Event.hs: -------------------------------------------------------------------------------- 1 | module NixManager.HMServices.Event 2 | ( Event(..) 3 | ) 4 | where 5 | 6 | import NixManager.HMServices.State ( State ) 7 | import NixManager.View.ServiceEditView 8 | ( EditViewEvent ) 9 | 10 | data Event = EventReload 11 | | EventReloaded State 12 | | EventEditView EditViewEvent 13 | -------------------------------------------------------------------------------- /src/NixManager/HMServices/State.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | module NixManager.HMServices.State 5 | ( State(..) 6 | , initState 7 | ) 8 | where 9 | 10 | import NixManager.Services.StateData ( StateData(StateData) ) 11 | import NixManager.NixServiceOption ( readOptionsFile ) 12 | import NixManager.NixService ( makeServices ) 13 | import NixManager.HMServicesUtil ( readPendingServicesFile 14 | , locateOptionsFile 15 | ) 16 | import Data.Text ( Text ) 17 | import NixManager.Util ( showText ) 18 | import Control.Lens ( makePrisms ) 19 | import Data.Validation ( Validation(Success, Failure) ) 20 | import GHC.Generics ( Generic ) 21 | 22 | data State = NoHomeManager 23 | | InvalidHomeManager Text 24 | | HomeManagerPresent StateData 25 | deriving(Generic) 26 | 27 | initState :: IO State 28 | initState = locateOptionsFile >>= \case 29 | Nothing -> pure NoHomeManager 30 | Just optionsFileName -> readOptionsFile optionsFileName >>= \case 31 | Failure e -> pure 32 | (InvalidHomeManager 33 | ("Your local options JSON file is corrupted. Please fix it, or delete it and run “home-manager switch” again. It’s stored in\n\n" 34 | <> showText optionsFileName 35 | <> ". The error is:\n\n" 36 | <> e 37 | <> "" 38 | ) 39 | ) 40 | Success options -> readPendingServicesFile >>= \case 41 | Failure e -> pure 42 | (InvalidHomeManager 43 | ("Your local service Nix configuration is corrupted. Please fix it. The error is: " 44 | <> e 45 | <> "" 46 | ) 47 | ) 48 | Success services -> pure 49 | (HomeManagerPresent 50 | (StateData (makeServices options) Nothing services mempty 0) 51 | ) 52 | -------------------------------------------------------------------------------- /src/NixManager/HMServices/Update.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLabels #-} 2 | module NixManager.HMServices.Update 3 | ( updateEvent 4 | ) 5 | where 6 | 7 | import NixManager.HMServices.Event ( Event 8 | ( EventEditView 9 | , EventReload 10 | , EventReloaded 11 | ) 12 | ) 13 | import qualified NixManager.View.ServiceEditView 14 | as EditView 15 | import Control.Lens ( over 16 | , (^?!) 17 | , (%~) 18 | , (&) 19 | ) 20 | import GI.Gtk.Declarative.App.Simple ( Transition(Transition) ) 21 | import NixManager.HMServicesUtil ( writePendingServicesFile ) 22 | import NixManager.ManagerState ( ManagerState ) 23 | import NixManager.ManagerEvent ( ManagerEvent 24 | , pureTransition 25 | ) 26 | 27 | updateEvent :: ManagerState -> Event -> Transition ManagerState ManagerEvent 28 | updateEvent s (EventEditView (EditView.EditViewSettingChanged setter)) = 29 | let newState = 30 | over (#hmServiceState . #_HomeManagerPresent . #expression) setter s 31 | in Transition newState $ do 32 | writePendingServicesFile 33 | (newState ^?! #hmServiceState . #_HomeManagerPresent . #expression) 34 | pure Nothing 35 | updateEvent s (EventEditView e) = pureTransition 36 | (s & #hmServiceState . #_HomeManagerPresent %~ EditView.updateEvent e) 37 | updateEvent s EventReload = pureTransition s 38 | updateEvent s (EventReloaded _) = pureTransition s 39 | -------------------------------------------------------------------------------- /src/NixManager/HMServices/View.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE OverloadedLabels #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE OverloadedLists #-} 5 | module NixManager.HMServices.View 6 | ( servicesBox 7 | ) 8 | where 9 | 10 | import qualified NixManager.View.IconName as IconName 11 | import NixManager.View.GtkUtil ( expandAndFill ) 12 | import GI.Gtk.Declarative ( bin 13 | , BoxChild(BoxChild) 14 | , container 15 | ) 16 | import qualified GI.Gtk as Gtk 17 | import Control.Lens ( (^.) ) 18 | import NixManager.HMServices.Event ( Event 19 | ( EventReload 20 | , EventEditView 21 | ) 22 | ) 23 | import NixManager.ManagerEvent ( ManagerEvent 24 | ( ManagerEventHMServices 25 | ) 26 | ) 27 | import NixManager.Services.View ( noticeBox ) 28 | import NixManager.HMServices.State ( State 29 | ( NoHomeManager 30 | , InvalidHomeManager 31 | , HomeManagerPresent 32 | ) 33 | ) 34 | import NixManager.View.ServiceEditView 35 | ( editView ) 36 | 37 | servicesBox' NoHomeManager _ = bin Gtk.ScrolledWindow [] $ noticeBox 38 | IconName.DialogError 39 | (ManagerEventHMServices EventReload) 40 | IconName.ViewRefresh 41 | "Reload" 42 | "You don't have home-manager installed, or it isn’t configured properly. INSERT MORE DOCS HERE." 43 | servicesBox' (InvalidHomeManager errorMessage) _ = 44 | bin Gtk.ScrolledWindow [] $ noticeBox IconName.DialogError 45 | (ManagerEventHMServices EventReload) 46 | IconName.ViewRefresh 47 | "Reload" 48 | errorMessage 49 | servicesBox' (HomeManagerPresent sd) s = 50 | ManagerEventHMServices . EventEditView <$> editView sd s 51 | 52 | --servicesBox :: ManagerState -> Widget ManagerEvent 53 | -- This extra container is there to circumvent a bug that switches to the next page when one page is replaced. 54 | servicesBox s = container 55 | Gtk.Box 56 | [] 57 | [BoxChild expandAndFill (servicesBox' (s ^. #hmServiceState) s)] 58 | -------------------------------------------------------------------------------- /src/NixManager/HMServicesUtil.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-| 4 | Description: Provides functions and types regarding “services” in home-manager 5 | 6 | Provides functions and types regarding “services” in home-manager 7 | -} 8 | module NixManager.HMServicesUtil 9 | ( readPendingServicesFile 10 | , locateOptionsFile 11 | , writePendingServicesFile 12 | , locatePendingServicesFile 13 | , locateInstalledServicesFile 14 | , locatePendingServicesFileMaybeCreate 15 | ) 16 | where 17 | 18 | import Data.Text.Lens ( unpacked ) 19 | import System.Environment ( getEnv ) 20 | import Control.Monad ( unless ) 21 | import System.FilePath ( () ) 22 | import NixManager.Constants ( appName ) 23 | import Data.String ( IsString ) 24 | import System.Directory ( getXdgDirectory 25 | , doesFileExist 26 | , XdgDirectory 27 | ( XdgConfig 28 | , XdgCache 29 | ) 30 | ) 31 | import Prelude hiding ( readFile ) 32 | import Control.Lens ( filteredBy 33 | , only 34 | , at 35 | , folded 36 | , (^?) 37 | ) 38 | import NixManager.NixExpr ( NixExpr 39 | ( NixFunctionDecl 40 | , NixSet 41 | , NixNull 42 | ) 43 | , NixFunction(NixFunction) 44 | , parseNixFile 45 | , writeNixFile 46 | ) 47 | import NixManager.Util ( TextualError 48 | , addToError 49 | , toMaybe 50 | ) 51 | 52 | -- | File name for the services Nix file 53 | servicesFileName :: IsString s => s 54 | servicesFileName = "hm-extra-services.nix" 55 | 56 | -- | Locate the services file containing the most recently (successfully) installed service configuration. 57 | locateInstalledServicesFile :: IO FilePath 58 | locateInstalledServicesFile = 59 | getXdgDirectory XdgCache (appName servicesFileName) 60 | 61 | -- | Locate the currently pending services file 62 | locatePendingServicesFile :: IO FilePath 63 | locatePendingServicesFile = 64 | getXdgDirectory XdgConfig ("nixpkgs" servicesFileName) 65 | 66 | -- | Locate the home-manager’s @options.json@ file 67 | locateOptionsFile :: IO (Maybe FilePath) 68 | locateOptionsFile = do 69 | home <- getEnv "HOME" 70 | pure 71 | (Just 72 | ( home 73 | ".nix-profile" 74 | "share" 75 | "doc" 76 | "home-manager" 77 | "options.json" 78 | ) 79 | ) 80 | 81 | -- | Locate the currently pending services file, optionally creating it 82 | locatePendingServicesFileMaybeCreate :: IO FilePath 83 | locatePendingServicesFileMaybeCreate = do 84 | pkgsFile <- locatePendingServicesFile 85 | exists <- doesFileExist pkgsFile 86 | unless exists (writePendingServicesFile emptyServiceFileContents) 87 | pure pkgsFile 88 | 89 | -- | Parse the currently pending services file into a Nix expression, possibly returning an empty packages expression. 90 | readPendingServicesFile :: IO (TextualError NixExpr) 91 | readPendingServicesFile = do 92 | svcsFile <- locatePendingServicesFile 93 | addToError 94 | ("Error parsing the \"" 95 | <> servicesFileName 96 | <> "\" file. This is most likely a syntax error, please investigate the file itself and fix the error. Then restart nixos-manager. The error was: " 97 | ) 98 | <$> parseNixFile svcsFile emptyServiceFileContents 99 | 100 | -- | Parse the most-recently installed services file into a Nix expression, possibly returning an empty packages expression. 101 | readInstalledServiceFile :: IO (TextualError NixExpr) 102 | readInstalledServiceFile = do 103 | svcsFile <- locateInstalledServicesFile 104 | addToError 105 | ("Error parsing the \"" 106 | <> servicesFileName 107 | <> "\" file. This is most likely a syntax error, please investigate the file itself and fix the error. Then restart nixos-manager. The error was: " 108 | ) 109 | <$> parseNixFile svcsFile emptyServiceFileContents 110 | 111 | -- | The initial, empty services file (containing, of course, no services) 112 | emptyServiceFileContents :: NixExpr 113 | emptyServiceFileContents = 114 | NixFunctionDecl (NixFunction ["pkgs", "..."] (NixSet mempty)) 115 | 116 | -- | Write a Nix service expression into the corresponding /local/ file. 117 | writePendingServicesFile :: NixExpr -> IO () 118 | writePendingServicesFile e = do 119 | svcsFile <- locatePendingServicesFile 120 | writeNixFile svcsFile e 121 | -------------------------------------------------------------------------------- /src/NixManager/ManagerEvent.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-| 4 | Description: The "root" event type, to be used with the gi-gtk-declarative-app-simple model. The different tabs (notebook pages) use their own events, which are also manager events. 5 | #-} 6 | module NixManager.ManagerEvent 7 | ( ManagerEvent(..) 8 | , adminEvent 9 | , servicesEvent 10 | , packagesEvent 11 | , hmServicesEvent 12 | , hmPackagesEvent 13 | , hmAdminEvent 14 | , pureTransition 15 | , liftUpdate 16 | ) 17 | where 18 | 19 | import Control.Lens ( (^.) 20 | , Lens' 21 | , set 22 | ) 23 | import NixManager.Services.Event as Services 24 | import qualified NixManager.Packages.Event as Packages 25 | import qualified NixManager.Admin.Event as Admin 26 | import qualified NixManager.HMAdmin.Event as HMAdmin 27 | import qualified NixManager.HMPackages.Event as HMPackages 28 | import qualified NixManager.HMServices.Event as HMServices 29 | import GI.Gtk.Declarative.App.Simple ( Transition(Transition, Exit) ) 30 | import GHC.Generics ( Generic ) 31 | 32 | -- | The root event type 33 | data ManagerEvent = ManagerEventClosed -- ^ Used only for closing the application 34 | | ManagerEventDiscard -- ^ Used in situations where we /must/ return an event but don't want to actually do something in response (to other peoeple: can this be removed somehow?) 35 | | ManagerEventAdmin Admin.Event -- ^ Specific event for the "Admin" tab (the first one) 36 | | ManagerEventServices Services.Event -- ^ Specific event for the "Services" tab (the third one) 37 | | ManagerEventPackages Packages.Event -- ^ Specific event for the "Packages" tab (the second one) 38 | | ManagerEventHMServices HMServices.Event -- ^ Specific event for the "Home Manager Services" tab 39 | | ManagerEventHMAdmin HMAdmin.Event -- ^ Specific event for the "Home Manager Services" tab 40 | | ManagerEventHMPackages HMPackages.Event -- ^ Specific event for the "Home Manager Packages" tab 41 | deriving(Generic) 42 | 43 | -- | Shortcut to construct an 'NixManager.Admin.Event' (in a 'Just', simply because of the way 'Transition' is defined) 44 | adminEvent :: Admin.Event -> Maybe ManagerEvent 45 | adminEvent = Just . ManagerEventAdmin 46 | 47 | -- | Shortcut to construct an 'NixManager.HMAdmin.Event' (in a 'Just', simply because of the way 'Transition' is defined) 48 | hmAdminEvent :: HMAdmin.Event -> Maybe ManagerEvent 49 | hmAdminEvent = Just . ManagerEventHMAdmin 50 | 51 | -- | Shortcut to construct an 'NixManager.HMPackages.Event' (in a 'Just', simply because of the way 'Transition' is defined) 52 | hmPackagesEvent :: HMPackages.Event -> Maybe ManagerEvent 53 | hmPackagesEvent = Just . ManagerEventHMPackages 54 | 55 | -- | Shortcut to construct an 'NixManager.Services.Event' (in a 'Just', simply because of the way 'Transition' is defined) 56 | servicesEvent :: Services.Event -> Maybe ManagerEvent 57 | servicesEvent = Just . ManagerEventServices 58 | 59 | -- | Shortcut to construct an 'NixManager.Packages.Event' (in a 'Just', simply because of the way 'Transition' is defined) 60 | packagesEvent :: Packages.Event -> Maybe ManagerEvent 61 | packagesEvent = Just . ManagerEventPackages 62 | 63 | -- | Shortcut to construct an 'NixManager.HMServices.Event' (in a 'Just', simply because of the way 'Transition' is defined) 64 | hmServicesEvent :: HMServices.Event -> Maybe ManagerEvent 65 | hmServicesEvent = Just . ManagerEventHMServices 66 | 67 | -- | A special transition that doesn't have side-effects or emit an event. 68 | pureTransition :: state -> Transition state ManagerEvent 69 | pureTransition x = Transition x (pure Nothing) 70 | 71 | -- | Given an update function for something “deep” in a state, construct and update function more “shallow” in the state 72 | liftUpdate 73 | :: (innerState -> innerEvent -> Transition innerState innerEvent) 74 | -> Lens' outerState innerState 75 | -> (innerEvent -> outerEvent) 76 | -> outerState 77 | -> innerEvent 78 | -> Transition outerState outerEvent 79 | liftUpdate makeTransition getInnerState embedOuterEvent outerState innerEvent = 80 | case makeTransition (outerState ^. getInnerState) innerEvent of 81 | Exit -> Exit 82 | Transition newInnerState eventHandler -> Transition 83 | (set getInnerState newInnerState outerState) 84 | ((embedOuterEvent <$>) <$> eventHandler) 85 | -------------------------------------------------------------------------------- /src/NixManager/ManagerMain.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: NixOS manager's /real/ entry point 3 | 4 | This file should initialize the application state, as well as GTK, and then run gi-gtk-declarative-app-simple's main method. 5 | -} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | {-# LANGUAGE FlexibleContexts #-} 8 | {-# LANGUAGE OverloadedLists #-} 9 | {-# LANGUAGE OverloadedStrings #-} 10 | module NixManager.ManagerMain 11 | ( nixMain 12 | ) 13 | where 14 | 15 | import Data.Validation ( Validation(Failure, Success) ) 16 | import NixManager.ProgramArguments ( parseArguments 17 | , ProgramArguments 18 | ) 19 | import qualified NixManager.Update as GlobalUpdate 20 | import qualified NixManager.Admin.State as AdminState 21 | import qualified NixManager.Services.State as ServicesState 22 | import qualified NixManager.Packages.State as PackagesState 23 | import qualified NixManager.HMPackages.State as HMPackagesState 24 | import qualified NixManager.HMServices.State as HMServicesState 25 | import qualified NixManager.HMAdmin.State as HMAdminState 26 | import NixManager.View.ErrorDialog ( runErrorDialog ) 27 | import NixManager.View.Css ( initCss ) 28 | import NixManager.ManagerState ( ManagerState(..) ) 29 | import NixManager.Util ( TextualError 30 | , ifSuccessIO 31 | ) 32 | import NixManager.View.Root ( view' ) 33 | import GI.Gtk.Declarative.App.Simple ( App(App) 34 | , view 35 | , update 36 | , inputs 37 | , initialState 38 | , run 39 | ) 40 | import Control.Monad ( void ) 41 | import qualified GI.Gtk as Gtk 42 | import Prelude hiding ( length 43 | , putStrLn 44 | ) 45 | import Control.Lens ( (^.) ) 46 | 47 | -- |Initialize the application state, optionally returning an error. 48 | initState :: ProgramArguments -> IO (TextualError ManagerState) 49 | initState args 50 | | args ^. #useHomeManager 51 | = ifSuccessIO HMPackagesState.initState $ \hmPackagesState' -> do 52 | serviceState' <- ServicesState.initState 53 | adminState' <- AdminState.initState 54 | hmServiceState' <- HMServicesState.initState 55 | hmAdminState' <- HMAdminState.initState 56 | pure $ pure $ ManagerState { packagesState = PackagesState.emptyState 57 | , serviceState = serviceState' 58 | , adminState = adminState' 59 | , hmServiceState = hmServiceState' 60 | , hmAdminState = hmAdminState' 61 | , hmPackagesState = hmPackagesState' 62 | } 63 | | otherwise 64 | = ifSuccessIO PackagesState.initState $ \packagesState' -> do 65 | serviceState' <- ServicesState.initState 66 | adminState' <- AdminState.initState 67 | hmServiceState' <- HMServicesState.initState 68 | hmAdminState' <- HMAdminState.initState 69 | pure $ pure $ ManagerState { packagesState = packagesState' 70 | , serviceState = serviceState' 71 | , adminState = adminState' 72 | , hmServiceState = hmServiceState' 73 | , hmAdminState = hmAdminState' 74 | , hmPackagesState = HMPackagesState.emptyState 75 | } 76 | 77 | -- |Initialize GTK, the application state (see "NixManager.ManagerState") and run the GTK main loop. See also: "NixManager.Update" and "NixManager.View.Root" 78 | nixMain :: IO () 79 | nixMain = do 80 | void (Gtk.init Nothing) 81 | initCss 82 | args <- parseArguments 83 | initialState' <- initState args 84 | case initialState' of 85 | Failure e -> runErrorDialog e 86 | Success s -> void $ run App { view = view' args 87 | , update = GlobalUpdate.update 88 | , inputs = [] 89 | , initialState = s 90 | } 91 | -------------------------------------------------------------------------------- /src/NixManager/ManagerState.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-| 4 | Description: The "root" manager state, containing the substates for the tabs (notebook pages). To be used with gi-gtk-declarative-app-simple model. 5 | 6 | The "root" manager state, containing the substates for the tabs (notebook pages). To be used with gi-gtk-declarative-app-simple model. 7 | -} 8 | module NixManager.ManagerState 9 | ( ManagerState(..) 10 | ) 11 | where 12 | 13 | import qualified NixManager.Services.State as Services 14 | import qualified NixManager.Admin.State as Admin 15 | import qualified NixManager.Packages.State as Packages 16 | import qualified NixManager.HMServices.State as HMServices 17 | import qualified NixManager.HMAdmin.State as HMAdmin 18 | import qualified NixManager.HMPackages.State as HMPackages 19 | import GHC.Generics ( Generic ) 20 | 21 | -- | The root manager state 22 | data ManagerState = ManagerState { 23 | packagesState :: Packages.State -- ^ State for the packages tab 24 | , serviceState :: Services.State -- ^ State for the services tab 25 | , adminState :: Admin.State -- ^ State for the administration tab 26 | , hmServiceState :: HMServices.State -- ^ State for the home-manager services tab 27 | , hmAdminState :: HMAdmin.State -- ^ State for the home-manager administration tab 28 | , hmPackagesState :: HMPackages.State -- ^ State for the home-manager packages tab 29 | } deriving(Generic) 30 | 31 | -------------------------------------------------------------------------------- /src/NixManager/Message.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Type for messages to be displayed in the GUI (errors, infos) 3 | Type for messages to be displayed in the GUI (errors, infos) 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE OverloadedLabels #-} 9 | {-# LANGUAGE OverloadedLists #-} 10 | module NixManager.Message 11 | ( MessageType 12 | , Message 13 | , messageWidget 14 | , errorMessage 15 | , infoMessage 16 | ) 17 | where 18 | 19 | import GHC.Generics ( Generic ) 20 | import Data.Text ( Text ) 21 | import Control.Lens ( has 22 | , (^.) 23 | ) 24 | import qualified GI.Gtk as Gtk 25 | import GI.Gtk.Declarative ( widget 26 | , classes 27 | , Widget 28 | , Attribute((:=)) 29 | ) 30 | import Data.Generics.Labels ( ) 31 | 32 | -- | Type of the message (determines the icon and/or background color) 33 | data MessageType = ErrorMessage 34 | | InfoMessage 35 | deriving(Eq,Show, Generic) 36 | 37 | -- | A message to be displayed in the GUI 38 | data Message = Message { 39 | messageType :: MessageType 40 | , messageText :: Text 41 | } 42 | deriving(Eq,Show, Generic) 43 | 44 | -- | Construct an error message 45 | errorMessage :: Text -> Message 46 | errorMessage = Message ErrorMessage 47 | 48 | -- | Construct an info message 49 | infoMessage :: Text -> Message 50 | infoMessage = Message InfoMessage 51 | 52 | -- | Create a nice-looking widget corresponding to the message given 53 | messageWidget :: Message -> Widget e 54 | messageWidget e = widget 55 | Gtk.Label 56 | [ #label := (e ^. #messageText) 57 | , #useMarkup := True 58 | , classes 59 | [ if has (#messageType . #_ErrorMessage) e 60 | then "error-message" 61 | else "info-message" 62 | ] 63 | ] 64 | 65 | -------------------------------------------------------------------------------- /src/NixManager/NixGarbage.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Expressions and commands relating to @nix-collect-garbage@. Uses the "NixManager.Bash" module 3 | -} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module NixManager.NixGarbage 6 | ( collectGarbage 7 | ) 8 | where 9 | 10 | import NixManager.AskPass ( sudoExpr ) 11 | import Data.Text.Encoding ( encodeUtf8 ) 12 | import NixManager.Util ( mwhen ) 13 | import NixManager.Bash ( Expr(Command) ) 14 | import Prelude hiding ( readFile ) 15 | import NixManager.Process ( runProcess 16 | , ProcessData 17 | ) 18 | import NixManager.Password ( Password 19 | , getPassword 20 | ) 21 | 22 | -- | Bash expression for @nix-collect-garbage@ 23 | collectGarbageExpr :: Bool -> Expr 24 | collectGarbageExpr olderGenerations = 25 | Command "nix-collect-garbage" (mwhen olderGenerations ["-d"]) 26 | 27 | -- | Run the collect garbage tool using the password and possibly deleting older generations 28 | collectGarbage :: Bool -> Password -> IO ProcessData 29 | collectGarbage olderGenerations password = runProcess 30 | (Just (encodeUtf8 (getPassword password))) 31 | (sudoExpr (collectGarbageExpr olderGenerations)) 32 | 33 | -------------------------------------------------------------------------------- /src/NixManager/NixLocation.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Defines 'NixLocation', a type representing a dot-separated “location” inside nixpkgs. 3 | -} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module NixManager.NixLocation 6 | ( NixLocation(NixLocation) 7 | , flattenLocation 8 | , flattenedTail 9 | , removeLastComponent 10 | , firstComponent 11 | , isSingleton 12 | , isPrefixOf 13 | , replaceFirstComponent 14 | , locationDropComponents 15 | , locationComponents 16 | , locationFromText 17 | , flattened 18 | ) 19 | where 20 | 21 | import qualified Data.List.NonEmpty as NE 22 | import Data.Text ( Text 23 | , intercalate 24 | , splitOn 25 | ) 26 | import Data.Foldable ( toList ) 27 | import NixManager.Util ( Endo ) 28 | import Control.Lens ( to 29 | , Getter 30 | ) 31 | 32 | -- | A dot-separated, non-empty “location” inside nixpkgs. 33 | newtype NixLocation = NixLocation { 34 | getLocation :: NE.NonEmpty Text 35 | } 36 | deriving(Eq, Show, Ord) 37 | 38 | -- | Create a location from a text, splitting on the dot character. Unsafe. 39 | locationFromText :: Text -> NixLocation 40 | locationFromText = NixLocation . NE.fromList . splitOn "." 41 | 42 | -- | Lift an endomorphism of nonempties to locations 43 | liftLocation :: Endo (NE.NonEmpty Text) -> Endo NixLocation 44 | liftLocation f (NixLocation xs) = NixLocation (f xs) 45 | 46 | -- | Drop some components from a location. Unsafe. 47 | locationDropComponents :: Int -> Endo NixLocation 48 | locationDropComponents i = liftLocation (NE.fromList . NE.drop i) 49 | 50 | -- | Number of components in a location 51 | locationComponents :: NixLocation -> Int 52 | locationComponents = NE.length . getLocation 53 | 54 | -- | Flatten a location, adding dots inbetween 55 | flattenLocation :: NixLocation -> Text 56 | flattenLocation = intercalate "." . toList . getLocation 57 | 58 | -- | Flatten a location, adding dots inbetween (@Getter@ version) 59 | flattened :: Getter NixLocation Text 60 | flattened = to flattenLocation 61 | 62 | -- | Does the location only have one component? 63 | isSingleton :: NixLocation -> Bool 64 | isSingleton = (== 1) . locationComponents 65 | 66 | -- | Flatten the location’s tail (all but the first component) 67 | flattenTail :: NixLocation -> Text 68 | flattenTail (NixLocation xs) = intercalate "." (NE.tail xs) 69 | 70 | -- | Flatten the location’s tail (all but the first component; @Getter@ version) 71 | flattenedTail :: Getter NixLocation Text 72 | flattenedTail = to flattenTail 73 | 74 | -- | Remove the location’s last component, possibly returning @Nothing@ on a singleton 75 | removeLastComponent :: NixLocation -> Maybe NixLocation 76 | removeLastComponent (NixLocation option) = case NE.init option of 77 | [] -> Nothing 78 | xs -> Just (NixLocation (NE.fromList xs)) 79 | 80 | -- | Determine if one location is the prefix of another (same as for lists) 81 | isPrefixOf :: NixLocation -> NixLocation -> Bool 82 | isPrefixOf (NixLocation prefix) (NixLocation tester) = 83 | toList prefix `NE.isPrefixOf` tester 84 | 85 | -- | Extract the first component 86 | firstComponent :: NixLocation -> Text 87 | firstComponent (NixLocation (x NE.:| _)) = x 88 | 89 | -- | Replace the first location’s first component, keeping the tail as-is. 90 | replaceFirstComponent :: Text -> Endo NixLocation 91 | replaceFirstComponent x (NixLocation (_ NE.:| xs)) = NixLocation (x NE.:| xs) 92 | -------------------------------------------------------------------------------- /src/NixManager/NixPackage.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Types representing a Nix package (as read from @nix search@) 3 | Types representing a Nix package (as read from @nix search@) 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | {-# LANGUAGE DuplicateRecordFields #-} 8 | module NixManager.NixPackage 9 | ( NixPackage(..) 10 | , readPackagesJson 11 | ) 12 | where 13 | 14 | import GHC.Generics ( Generic ) 15 | import NixManager.Util ( TextualError 16 | , fromStringEither 17 | ) 18 | import Data.ByteString.Lazy ( ByteString ) 19 | import Data.Map.Strict ( Map 20 | , toList 21 | ) 22 | import Data.Text ( Text ) 23 | import Control.Lens ( makeLenses 24 | , (^.) 25 | ) 26 | import Data.Aeson ( eitherDecode ) 27 | import NixManager.NixPackageMeta ( NixPackageMeta ) 28 | import NixManager.NixPackageStatus ( NixPackageStatus 29 | ( NixPackageNothing 30 | ) 31 | ) 32 | import NixManager.NixLocation ( NixLocation 33 | , locationFromText 34 | ) 35 | import Data.List ( sortOn ) 36 | import Data.Generics.Labels ( ) 37 | 38 | -- | Type representing a Nix package, along with information about its current status 39 | data NixPackage = NixPackage { 40 | name :: Text -- ^ Name of the package (as per the JSON) 41 | , path :: NixLocation -- ^ Package path (as per the JSON) 42 | , version :: Text -- ^ Package version (as per the JSON) 43 | , description :: Text -- ^ Package description (as per the JSON) 44 | , status :: NixPackageStatus -- ^ Current status of the package (will be added after parsing the JSON) 45 | } deriving(Eq,Show, Generic) 46 | 47 | -- | Read a package list from a 'ByteString' 48 | readPackagesJson :: ByteString -> TextualError [NixPackage] 49 | readPackagesJson = 50 | (sortOn name <$>) . (packagesFromMap <$>) . fromStringEither . eitherDecode 51 | 52 | -- | Convert a map (like the one @nix search@ returns) into a package list 53 | packagesFromMap :: Map Text NixPackageMeta -> [NixPackage] 54 | packagesFromMap m = 55 | (\(path', meta) -> NixPackage (meta ^. #name) 56 | (locationFromText path') 57 | (meta ^. #version) 58 | (meta ^. #description) 59 | NixPackageNothing 60 | ) 61 | <$> toList m 62 | -------------------------------------------------------------------------------- /src/NixManager/NixPackageMeta.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Metadata for a Nix package. This is a companion module to "NixManager.NixPackage" 3 | Metadata for a Nix package. This is a companion module to "NixManager.NixPackage" 4 | -} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE DeriveGeneric #-} 7 | module NixManager.NixPackageMeta 8 | ( NixPackageMeta(NixPackageMeta) 9 | ) 10 | where 11 | 12 | import Control.Monad ( mzero ) 13 | import Data.Text ( Text ) 14 | import Data.Aeson ( FromJSON 15 | , Value(Object) 16 | , parseJSON 17 | , (.:) 18 | ) 19 | import GHC.Generics ( Generic ) 20 | 21 | -- | Metadata for a Nix package. This is a companion module to "NixManager.NixPackage" 22 | data NixPackageMeta = NixPackageMeta { 23 | name :: Text -- ^ Package name 24 | , version :: Text -- ^ Package version 25 | , description :: Text -- ^ Package description 26 | } deriving(Eq,Show, Generic) 27 | 28 | instance FromJSON NixPackageMeta where 29 | parseJSON (Object v) = 30 | NixPackageMeta <$> v .: "pkgName" <*> v .: "version" <*> v .: "description" 31 | parseJSON _ = mzero 32 | 33 | -------------------------------------------------------------------------------- /src/NixManager/NixPackageSearch.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Functions that wrap @nix search@ 3 | Functions that wrap @nix search@ 4 | -} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | module NixManager.NixPackageSearch 8 | ( searchPackages 9 | ) 10 | where 11 | 12 | import Data.Validation ( Validation(Failure) ) 13 | import Data.Text ( Text ) 14 | import NixManager.Bash ( Expr(Command) 15 | , Arg(LiteralArg) 16 | ) 17 | import System.Exit ( ExitCode 18 | ( ExitSuccess 19 | , ExitFailure 20 | ) 21 | ) 22 | import NixManager.Process ( runProcessToFinish ) 23 | import NixManager.Util ( decodeUtf8 24 | , TextualError 25 | , fromStrictBS 26 | , addToError 27 | , showText 28 | ) 29 | import Control.Lens ( (^?!) 30 | , (^.) 31 | , to 32 | , folded 33 | ) 34 | import NixManager.NixPackage ( NixPackage 35 | , readPackagesJson 36 | ) 37 | import Data.Monoid ( First(getFirst) ) 38 | 39 | -- | Expression to call @nix search --json @ 40 | nixSearchExpr :: Text -> Expr 41 | nixSearchExpr term = Command "nix" ["search", LiteralArg term, "--json"] 42 | 43 | -- | Call @nix search@ with a search parameter, return the parsed result 44 | searchPackages :: Text -> IO (TextualError [NixPackage]) 45 | searchPackages t = do 46 | po <- runProcessToFinish Nothing (nixSearchExpr t) 47 | let 48 | processedResult = addToError 49 | "Error parsing output of \"nix search\" command. This could be due to changes in this command in a later version (and doesn't fix itself). Please open an issue in the nixos-manager repository. The error was: " 50 | (readPackagesJson (po ^. #stdout . fromStrictBS)) 51 | case po ^?! #result . to getFirst . folded of 52 | ExitSuccess -> pure processedResult 53 | ExitFailure 1 -> pure processedResult 54 | ExitFailure code -> pure 55 | (Failure 56 | ( "Error executing \"nix search\" command (exit code " 57 | <> showText code 58 | <> "): standard error output: " 59 | <> (po ^. #stderr . decodeUtf8) 60 | ) 61 | ) 62 | 63 | 64 | -------------------------------------------------------------------------------- /src/NixManager/NixPackageStatus.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Provides an enum value for a package’s status (installed, pending, …) 3 | Provides an enum value for a package’s status (installed, pending, …) 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | module NixManager.NixPackageStatus 7 | ( NixPackageStatus(..) 8 | ) 9 | where 10 | 11 | import GHC.Generics ( Generic ) 12 | 13 | -- | Enum containing a package’s status 14 | data NixPackageStatus = NixPackageNothing -- ^ Package is not installed and not pending for installation/deinstallation 15 | | NixPackageInstalled -- ^ Package is installed 16 | | NixPackagePendingInstall -- ^ Package is pending installation 17 | | NixPackagePendingUninstall -- ^ Package is installed and pending uninstallation 18 | deriving (Eq, Show, Bounded, Enum, Generic) 19 | 20 | -------------------------------------------------------------------------------- /src/NixManager/NixRebuild.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Functions and structures relating to the @nixos-rebuild@ command 3 | Functions and structures relating to the @nixos-rebuild@ command 4 | -} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE OverloadedLists #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | module NixManager.NixRebuild 9 | ( rebuild 10 | , rootManagerPath 11 | , rollbackRebuild 12 | , NixRebuildUpdateMode(..) 13 | ) 14 | where 15 | 16 | import Control.Monad ( void ) 17 | import NixManager.Password ( Password 18 | , getPassword 19 | ) 20 | import NixManager.AskPass ( sudoExpr ) 21 | import NixManager.Constants ( rootManagerPath ) 22 | import Data.Text.Encoding ( encodeUtf8 ) 23 | import NixManager.PosixTools ( mkdir 24 | , cp 25 | , mv 26 | ) 27 | import NixManager.Bash ( Expr(Command, Subshell) 28 | , Arg(LiteralArg) 29 | , (||.) 30 | , (&&.) 31 | , (>>.) 32 | , devNullify 33 | ) 34 | import Prelude hiding ( readFile ) 35 | import NixManager.Util ( mwhen ) 36 | import NixManager.NixPackagesUtil ( locateLocalPackagesFileMaybeCreate 37 | , locateRootPackagesFile 38 | ) 39 | import NixManager.NixServicesUtil ( locateLocalServicesFileMaybeCreate 40 | , locateRootServicesFile 41 | ) 42 | import NixManager.Process ( runProcess 43 | , ProcessData 44 | , waitUntilFinished 45 | ) 46 | import System.FilePath ( (-<.>) ) 47 | import NixManager.NixRebuildMode ( NixRebuildMode 48 | , rebuildModeToText 49 | , isDry 50 | ) 51 | import NixManager.NixRebuildUpdateMode 52 | ( NixRebuildUpdateMode 53 | ( NixRebuildUpdateUpdate 54 | , NixRebuildUpdateRollback 55 | ) 56 | ) 57 | 58 | 59 | 60 | -- | Bash expression for @nixos-rebuild@ (see the "NixManager.Bash" module) 61 | nixosRebuildExpr :: NixRebuildMode -> NixRebuildUpdateMode -> Expr 62 | -- Turn this on for debugging purposes 63 | -- nixosRebuildExpr _mode _updateMode = Command "sleep" ["3s"] 64 | nixosRebuildExpr mode updateMode = Command 65 | "nixos-rebuild" 66 | ( [LiteralArg (rebuildModeToText mode)] 67 | <> mwhen (updateMode == NixRebuildUpdateUpdate) ["--upgrade"] 68 | <> mwhen (updateMode == NixRebuildUpdateRollback) ["--rollback"] 69 | ) 70 | 71 | -- | Copy @.@ to @.old@ 72 | copyToOld :: FilePath -> Expr 73 | copyToOld fn = cp fn (fn -<.> "old") 74 | 75 | -- | Move @.@ to @@ 76 | moveFromOld :: FilePath -> Expr 77 | moveFromOld fn = mv (fn -<.> "old") fn 78 | 79 | -- | Expression to rollback a rebuild (by moving the nixos-manager files, not via @nixos-rebuild --rollback@, mind you) 80 | rollbackExpr :: IO Expr 81 | rollbackExpr = do 82 | rootPackagesFile <- locateRootPackagesFile 83 | rootServicesFile <- locateRootServicesFile 84 | pure (moveFromOld rootServicesFile >>. moveFromOld rootPackagesFile) 85 | 86 | -- | Expression to call @nixos-rebuild@, after coping the local files to the root location, and possibly rolling that back. 87 | installExpr :: NixRebuildMode -> NixRebuildUpdateMode -> IO Expr 88 | installExpr rebuildMode updateMode = do 89 | localPackagesFile <- locateLocalPackagesFileMaybeCreate 90 | rootPackagesFile <- locateRootPackagesFile 91 | localServicesFile <- locateLocalServicesFileMaybeCreate 92 | rootServicesFile <- locateRootServicesFile 93 | rollback <- rollbackExpr 94 | let copyOldFiles = 95 | devNullify (copyToOld rootServicesFile >>. copyToOld rootPackagesFile) 96 | copyToRoot = 97 | cp localPackagesFile rootPackagesFile 98 | &&. cp localServicesFile rootServicesFile 99 | finalOperator = if isDry rebuildMode then (>>.) else (||.) 100 | pure 101 | $ ((mkdir True [rootManagerPath] &&. copyOldFiles) >>. copyToRoot) 102 | &&. nixosRebuildExpr rebuildMode updateMode 103 | `finalOperator` Subshell (devNullify rollback) 104 | 105 | -- | Rollback a rebuild 106 | rollbackRebuild :: Password -> IO () 107 | rollbackRebuild password = do 108 | rollback <- rollbackExpr 109 | result <- runProcess (Just (encodeUtf8 (getPassword password))) 110 | (sudoExpr rollback) 111 | void (waitUntilFinished result) 112 | 113 | -- | Call @nixos-rebuild@, after asking for a password 114 | rebuild :: NixRebuildMode -> NixRebuildUpdateMode -> Password -> IO ProcessData 115 | rebuild rebuildMode updateMode password = 116 | installExpr rebuildMode updateMode 117 | >>= runProcess (Just (encodeUtf8 (getPassword password))) 118 | . sudoExpr 119 | 120 | -------------------------------------------------------------------------------- /src/NixManager/NixRebuildMode.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Provides an enum for all @nixos-rebuild@ rebuild modes 3 | Provides an enum for all @nixos-rebuild@ rebuild modes 4 | -} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | module NixManager.NixRebuildMode 7 | ( NixRebuildMode(..) 8 | , isDry 9 | , rebuildModes 10 | , rebuildModeIdx 11 | , rebuildModeToText 12 | ) 13 | where 14 | 15 | import NixManager.Util ( showText 16 | , kebapize 17 | ) 18 | import Data.List ( elemIndex ) 19 | import Data.Maybe ( fromJust ) 20 | import Data.Text ( Text ) 21 | import Control.Lens ( iso 22 | , Iso' 23 | ) 24 | 25 | -- | All possible arguments to @nixos-rebuild@ 26 | data NixRebuildMode = NixRebuildSwitch 27 | | NixRebuildBoot 28 | | NixRebuildTest 29 | | NixRebuildBuild 30 | | NixRebuildDryBuild 31 | | NixRebuildDryActivate 32 | | NixRebuildEdit 33 | | NixRebuildBuildVm 34 | | NixRebuildBuildVmWithBootloader 35 | deriving(Eq, Ord, Bounded, Enum, Show) 36 | 37 | -- | Convert a rebuild mode to the corresponding @nixos-rebuild@ command 38 | rebuildModeToText :: NixRebuildMode -> Text 39 | rebuildModeToText = kebapize "NixRebuild" . showText 40 | 41 | -- | Determine if a rebuild mode is a “dry” mode. 42 | isDry :: NixRebuildMode -> Bool 43 | isDry NixRebuildDryBuild = True 44 | isDry NixRebuildDryActivate = True 45 | isDry NixRebuildBuildVm = True 46 | isDry NixRebuildBuildVmWithBootloader = True 47 | isDry _ = False 48 | 49 | -- | List of all rebuild modes 50 | rebuildModes :: [NixRebuildMode] 51 | rebuildModes = [minBound .. maxBound] 52 | 53 | -- | The index of a rebuild mode inside the list of all rebuild modes and vice-versa. 54 | rebuildModeIdx :: Iso' NixRebuildMode Int 55 | rebuildModeIdx = iso (fromJust . (`elemIndex` rebuildModes)) (rebuildModes !!) 56 | -------------------------------------------------------------------------------- /src/NixManager/NixRebuildUpdateMode.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Provides an enum for the mode of operation for rebuild in the GUI 3 | Provides an enum for the mode of operation for rebuild in the GUI 4 | -} 5 | module NixManager.NixRebuildUpdateMode 6 | ( NixRebuildUpdateMode(..) 7 | ) 8 | where 9 | 10 | -- | How the GUI shall call @nixos-rebuild@ 11 | data NixRebuildUpdateMode = NixRebuildUpdateNone -- ^ Call it with neither @--rollback@ nor @--upgrade@ 12 | | NixRebuildUpdateUpdate -- ^ Call it with @--upgrade@ 13 | | NixRebuildUpdateRollback-- ^ Call it with @--rollback@ 14 | deriving(Eq, Enum, Bounded) 15 | -------------------------------------------------------------------------------- /src/NixManager/NixService.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the "NixService" type (representing a service plus its options), and companion functions 3 | Contains the "NixService" type (representing a service plus its options), and companion functions 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | module NixManager.NixService 8 | ( NixService(NixService) 9 | , serviceLoc 10 | , serviceOptions 11 | , makeServices 12 | ) 13 | where 14 | 15 | import NixManager.NixLocation ( NixLocation 16 | , removeLastComponent 17 | , isPrefixOf 18 | ) 19 | import NixManager.NixServiceOption ( NixServiceOption ) 20 | import Data.Text ( Text ) 21 | import Data.Map.Strict ( Map 22 | , elems 23 | , insertWith 24 | , toList 25 | ) 26 | import qualified Data.Set as Set 27 | import NixManager.Util ( Endo ) 28 | import Control.Lens ( (^.) 29 | , view 30 | ) 31 | import Data.Maybe ( mapMaybe ) 32 | import GHC.Generics ( Generic ) 33 | import Data.Generics.Labels ( ) 34 | 35 | -- | Represents a service with a location and some options. 36 | data NixService = NixService { 37 | serviceLoc :: NixLocation -- ^ Service location 38 | , serviceOptions :: [NixServiceOption] -- ^ Service options 39 | } deriving(Show, Generic) 40 | 41 | -- | Create a list of services from a map (such as the map contained in the @options.json@ file) 42 | makeServices :: Map Text NixServiceOption -> [NixService] 43 | makeServices options' = 44 | let 45 | options = elems options' 46 | servicePaths :: Set.Set NixLocation 47 | servicePaths = Set.fromList 48 | (removeLastComponent `mapMaybe` (view #optionLoc <$> options)) 49 | serviceForOption :: NixServiceOption -> Maybe NixLocation 50 | serviceForOption opt = 51 | case Set.lookupLT (opt ^. #optionLoc) servicePaths of 52 | Nothing -> Nothing 53 | Just result -> if result `isPrefixOf` (opt ^. #optionLoc) 54 | then Just result 55 | else Nothing 56 | transducer :: NixServiceOption -> Endo (Map NixLocation [NixServiceOption]) 57 | transducer opt m = case serviceForOption opt of 58 | Nothing -> m 59 | Just serviceLoc' -> insertWith (<>) serviceLoc' [opt] m 60 | serviceMap = foldr transducer mempty options 61 | in 62 | uncurry NixService <$> toList serviceMap 63 | 64 | -------------------------------------------------------------------------------- /src/NixManager/NixServiceOption.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Provides the type for a service option, as read from the @options.json@ file as well as functions to read and write it. 3 | Provides the type for a service option, as read from the @options.json@ file as well as functions to read and write it. 4 | -} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE DeriveGeneric #-} 8 | 9 | module NixManager.NixServiceOption 10 | ( NixServiceOption 11 | , optionDescription 12 | , optionLoc 13 | , optionType 14 | , optionValue 15 | , readOptionsFile 16 | , locateOptionsFile 17 | , desiredOptionsFileLocation 18 | ) 19 | where 20 | 21 | import System.FilePath ( () ) 22 | import NixManager.Constants ( appName ) 23 | import Data.String ( IsString ) 24 | import System.Directory ( getXdgDirectory 25 | , XdgDirectory(XdgCache) 26 | , doesFileExist 27 | ) 28 | import Control.Monad ( mzero ) 29 | import Prelude hiding ( readFile ) 30 | import Data.Map.Strict ( Map ) 31 | import NixManager.Util ( TextualError 32 | , addToError 33 | , fromStringEither 34 | ) 35 | import Data.ByteString.Lazy ( ByteString 36 | , readFile 37 | ) 38 | import Data.Text ( Text ) 39 | import NixManager.NixLocation ( NixLocation(NixLocation) ) 40 | import NixManager.NixServiceOptionType 41 | ( NixServiceOptionType 42 | , parseNixServiceOptionType 43 | ) 44 | import NixManager.NixExpr ( NixExpr ) 45 | import Data.Aeson ( FromJSON 46 | , parseJSON 47 | , Value(Object) 48 | , (.:) 49 | , eitherDecode 50 | ) 51 | import GHC.Generics ( Generic ) 52 | 53 | -- | Service option, as read from the @options.json@ file 54 | data NixServiceOption = NixServiceOption { 55 | optionDescription :: Text -- ^ The option description 56 | , optionLoc :: NixLocation -- ^ The option location 57 | , optionType :: TextualError NixServiceOptionType -- ^ The type, possibly parsed 58 | , optionValue :: Maybe NixExpr -- ^ The option value, if present 59 | } deriving(Show, Generic) 60 | 61 | instance FromJSON NixServiceOption where 62 | parseJSON (Object v) = do 63 | objectType <- v .: "type" 64 | let realOptionType = parseNixServiceOptionType objectType 65 | description <- v .: "description" 66 | loc <- v .: "loc" 67 | -- pure $ NixServiceOption (convertJson objectType <$> defaultValue) 68 | pure $ NixServiceOption description (NixLocation loc) realOptionType Nothing 69 | parseJSON _ = mzero 70 | 71 | -- | Decode a bytestring into a map of options 72 | decodeOptions :: ByteString -> TextualError (Map Text NixServiceOption) 73 | decodeOptions = 74 | ( addToError "Couldn't read the options JSON file. The error was: " 75 | . fromStringEither 76 | ) 77 | . eitherDecode 78 | 79 | -- | The options JSON file name 80 | optionsFileName :: IsString s => s 81 | optionsFileName = "options.json" 82 | 83 | -- | Where to put the @options.json@ after downloading it 84 | desiredOptionsFileLocation :: IO FilePath 85 | desiredOptionsFileLocation = 86 | getXdgDirectory XdgCache (appName optionsFileName) 87 | 88 | -- | Locate the @options.json@ file 89 | locateOptionsFile :: IO (Maybe FilePath) 90 | locateOptionsFile = do 91 | optionsPath <- getXdgDirectory XdgCache (appName optionsFileName) 92 | defExists <- doesFileExist optionsPath 93 | if defExists then pure (Just optionsPath) else pure Nothing 94 | 95 | -- | Read the options file into a map 96 | readOptionsFile :: FilePath -> IO (TextualError (Map Text NixServiceOption)) 97 | readOptionsFile fp = decodeOptions <$> readFile fp 98 | 99 | -------------------------------------------------------------------------------- /src/NixManager/NixServicesUtil.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE OverloadedLabels #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-| 6 | Description: Provides functions and types regarding “services” (so anything that’s not a package basically) 7 | -} 8 | module NixManager.NixServicesUtil 9 | ( readLocalServiceFile 10 | , writeLocalServiceFile 11 | , locateLocalServicesFile 12 | , readHMServiceFile 13 | , locateRootServicesFile 14 | , readHMOptionsFile 15 | , locateHMOptionsFile 16 | , locateLocalServicesFileMaybeCreate 17 | , writeHMServiceFile 18 | ) 19 | where 20 | 21 | import Data.Validation ( Validation(Failure) ) 22 | import Data.Text.Lens ( unpacked ) 23 | import System.Environment ( getEnv ) 24 | import Control.Monad ( unless ) 25 | import System.FilePath ( () 26 | , takeFileName 27 | ) 28 | import NixManager.Constants ( appName 29 | , rootManagerPath 30 | ) 31 | import Data.String ( IsString ) 32 | import System.Directory ( getXdgDirectory 33 | , doesFileExist 34 | , XdgDirectory(XdgConfig) 35 | ) 36 | import Prelude hiding ( readFile ) 37 | import Control.Lens ( filteredBy 38 | , only 39 | , at 40 | , folded 41 | , (^?) 42 | ) 43 | import NixManager.NixExpr ( NixExpr 44 | ( NixFunctionDecl 45 | , NixSet 46 | , NixNull 47 | ) 48 | , NixFunction(NixFunction) 49 | , parseNixFile 50 | , writeNixFile 51 | ) 52 | import NixManager.Util ( TextualError 53 | , addToError 54 | , toMaybe 55 | ) 56 | 57 | -- | File name for the services Nix file 58 | servicesFileName :: IsString s => s 59 | servicesFileName = "services.nix" 60 | 61 | -- | File name for the services Nix file 62 | hmServicesFileName :: IsString s => s 63 | hmServicesFileName = "home.nix" 64 | 65 | -- | Locate the /local/ services file (the one for the user). Uses the XDG mechanism(s); returns the fill path. 66 | locateLocalServicesFile :: IO FilePath 67 | locateLocalServicesFile = 68 | getXdgDirectory XdgConfig (appName servicesFileName) 69 | 70 | -- | Locate the /local/ services file (the one for the user). Uses the XDG mechanism(s); returns the fill path. 71 | locateHMServicesFile :: IO FilePath 72 | locateHMServicesFile = 73 | getXdgDirectory XdgConfig (appName hmServicesFileName) 74 | 75 | -- | Locate the /local/ services file (the one for the user). Uses the XDG mechanism(s); returns the fill path. 76 | locateHMOptionsFile :: IO (Maybe FilePath) 77 | locateHMOptionsFile = do 78 | home <- getEnv "HOME" 79 | let manifestPath = home ".nix-profile" "manifest.nix" 80 | exists <- doesFileExist manifestPath 81 | if not exists 82 | then pure Nothing 83 | else do 84 | manifestFileContents <- parseNixFile manifestPath NixNull 85 | let extractPath :: NixExpr -> Maybe FilePath 86 | extractPath x = 87 | x 88 | ^? #_NixList 89 | . folded 90 | . #_NixSet 91 | . filteredBy 92 | (at "name" . folded . #_NixString . only "home-manager-path") 93 | . at "out" 94 | . folded 95 | . #_NixSet 96 | . at "outPath" 97 | . folded 98 | . #_NixString 99 | . unpacked 100 | appendFileName :: FilePath -> FilePath 101 | appendFileName x = 102 | x "share" "doc" "home-manager" "options.json" 103 | pure (appendFileName <$> (toMaybe manifestFileContents >>= extractPath)) 104 | 105 | -- | Locate the /root/ services file; returns its full path. 106 | locateRootServicesFile :: IO FilePath 107 | locateRootServicesFile = do 108 | localFile <- locateLocalServicesFile 109 | pure (rootManagerPath takeFileName localFile) 110 | 111 | -- | Locate the /local/ services file and possibly create an empty one (with a valid Nix expression though) if it doesn't exist. 112 | locateLocalServicesFileMaybeCreate :: IO FilePath 113 | locateLocalServicesFileMaybeCreate = do 114 | pkgsFile <- locateLocalServicesFile 115 | exists <- doesFileExist pkgsFile 116 | unless exists (writeLocalServiceFile emptyServiceFileContents) 117 | pure pkgsFile 118 | 119 | -- | Parse the home-manager services json file 120 | readHMOptionsFile :: IO (TextualError NixExpr) 121 | readHMOptionsFile = locateHMOptionsFile >>= \case 122 | Nothing -> pure 123 | (Failure 124 | "Couldn't find the options.json path in the manifest.nix file. Have you installed home-manager correctly?" 125 | ) 126 | Just svcsFile -> 127 | addToError 128 | ("Error parsing the \"" 129 | <> servicesFileName 130 | <> "\" file. This is most likely a syntax error, please investigate the file itself and fix the error. Then restart nixos-manager. The error was: " 131 | ) 132 | <$> parseNixFile svcsFile emptyHMServiceFileContents 133 | 134 | -- | Parse the local Nix services file into a Nix expression, possibly returning an empty packages expression. 135 | readHMServiceFile :: IO (TextualError NixExpr) 136 | readHMServiceFile = do 137 | svcsFile <- locateHMServicesFile 138 | addToError 139 | ("Error parsing the \"" 140 | <> servicesFileName 141 | <> "\" file. This is most likely a syntax error, please investigate the file itself and fix the error. Then restart nixos-manager. The error was: " 142 | ) 143 | <$> parseNixFile svcsFile emptyServiceFileContents 144 | 145 | -- | Parse the local Nix services file into a Nix expression, possibly returning an empty packages expression. 146 | readLocalServiceFile :: IO (TextualError NixExpr) 147 | readLocalServiceFile = do 148 | svcsFile <- locateLocalServicesFile 149 | addToError 150 | ("Error parsing the \"" 151 | <> servicesFileName 152 | <> "\" file. This is most likely a syntax error, please investigate the file itself and fix the error. Then restart nixos-manager. The error was: " 153 | ) 154 | <$> parseNixFile svcsFile emptyServiceFileContents 155 | 156 | -- | The initial, empty services file (containing, of course, no services) 157 | emptyServiceFileContents :: NixExpr 158 | emptyServiceFileContents = 159 | NixFunctionDecl (NixFunction ["config", "pkgs", "..."] (NixSet mempty)) 160 | 161 | -- | The initial, empty services file (containing, of course, no services) 162 | emptyHMServiceFileContents :: NixExpr 163 | emptyHMServiceFileContents = 164 | NixFunctionDecl (NixFunction ["pkgs", "..."] (NixSet mempty)) 165 | 166 | -- | Write a Nix service expression into the corresponding /local/ file. 167 | writeLocalServiceFile :: NixExpr -> IO () 168 | writeLocalServiceFile e = do 169 | svcsFile <- locateLocalServicesFile 170 | writeNixFile svcsFile e 171 | 172 | -- | Write Nix service file for home-manager 173 | writeHMServiceFile :: NixExpr -> IO () 174 | writeHMServiceFile e = do 175 | svcsFile <- locateHMServicesFile 176 | writeNixFile svcsFile e 177 | -------------------------------------------------------------------------------- /src/NixManager/PackageCategory.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Description: Contains the enum for the package category combobox 3 | 4 | Contains the enum for the package category combobox 5 | -} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | module NixManager.PackageCategory 8 | ( PackageCategory(..) 9 | , packageCategories 10 | , categoryToText 11 | , categoryIdx 12 | ) 13 | where 14 | 15 | import Data.List ( elemIndex ) 16 | import Data.Maybe ( fromJust ) 17 | import Data.Text ( Text ) 18 | import Control.Lens ( Iso' 19 | , iso 20 | ) 21 | 22 | -- | All the choices for the category combobox 23 | data PackageCategory = PackageCategoryAll -- ^ Display all packages 24 | | PackageCategoryInstalled -- ^ Display only installed packages 25 | | PackageCategoryPendingInstall -- ^ Display only pending installation packages 26 | | PackageCategoryPendingUninstall -- ^ Display only pending uninstallation packages 27 | deriving(Eq, Bounded, Enum) 28 | 29 | -- | List of all package categories 30 | packageCategories :: [PackageCategory] 31 | packageCategories = [minBound .. maxBound] 32 | 33 | -- | Prettyprint a category 34 | categoryToText :: PackageCategory -> Text 35 | categoryToText PackageCategoryAll = "All" 36 | categoryToText PackageCategoryInstalled = "Installed" 37 | categoryToText PackageCategoryPendingInstall = "Marked for install" 38 | categoryToText PackageCategoryPendingUninstall = "Marked for uninstall" 39 | 40 | -- | Isomorphism between a category and its index in the list of all categories (needed for the combobox logic) 41 | categoryIdx :: Iso' PackageCategory Int 42 | categoryIdx = 43 | iso (fromJust . (`elemIndex` packageCategories)) (packageCategories !!) 44 | -------------------------------------------------------------------------------- /src/NixManager/Packages/Event.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the event type for all events corresponding to the Packages tab 3 | Contains the event type for all events corresponding to the Packages tab 4 | -} 5 | module NixManager.Packages.Event 6 | ( Event(..) 7 | ) 8 | where 9 | 10 | import NixManager.NixPackage ( NixPackage ) 11 | import NixManager.Message ( Message ) 12 | import qualified NixManager.View.PackageEditView 13 | as PackageEditView 14 | 15 | data Event = EventPackageEditView PackageEditView.Event -- ^ Triggered whenever the search entry changes 16 | | EventInstallCompleted [NixPackage] PackageEditView.InstallationType -- ^ Triggered when the installation of a package is successful. We pass the new package cache here so we can immediately update the state with it. 17 | | EventUninstallCompleted [NixPackage] PackageEditView.InstallationType -- ^ Triggered when the uninstallation of a package is successful. We pass the new package cache here so we can immediately update the state with it. 18 | | EventOperationCompleted Message PackageEditView.CompletionType -- ^ Whenever an operation (install/uninstall) completes, we emit this event and display a message 19 | | EventReload -- ^ This is triggered externally whenever we need to reload the cache. For example, when we rebuild successfully, we need to update the package’s status. 20 | | EventReloadFinished [NixPackage] -- ^ Contains the new cache when the reloading finished. 21 | -------------------------------------------------------------------------------- /src/NixManager/Packages/State.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains all the state for the Packages tab 3 | -} 4 | module NixManager.Packages.State 5 | ( State 6 | , initState 7 | , emptyState 8 | ) 9 | where 10 | 11 | import NixManager.NixPackagesUtil ( readPackageCache ) 12 | import NixManager.Util ( TextualError 13 | , ifSuccessIO 14 | ) 15 | import qualified NixManager.View.PackageEditView 16 | as PackageEditView 17 | 18 | type State = PackageEditView.State 19 | 20 | -- | The initial Packages tab state (needs to read the package cache, hence the side-effect) 21 | initState :: IO (TextualError State) 22 | initState = 23 | ifSuccessIO readPackageCache (pure . pure . PackageEditView.initState) 24 | 25 | -- | An empty package state (we need this so we can "no-init" the NixOS package view if HM is enabled) 26 | emptyState :: State 27 | emptyState = PackageEditView.emptyState 28 | -------------------------------------------------------------------------------- /src/NixManager/Packages/Update.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the update logic for the Packages tab 3 | Contains the update logic for the Packages tab 4 | -} 5 | {-# LANGUAGE OverloadedLabels #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE OverloadedLists #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | module NixManager.Packages.Update 10 | ( updateEvent 11 | ) 12 | where 13 | 14 | import Data.Functor ( ($>) ) 15 | import Data.Validation ( Validation(Failure, Success) 16 | , bindValidation 17 | ) 18 | import Control.Lens ( (&) 19 | , (?~) 20 | , (.~) 21 | , (^?) 22 | ) 23 | import NixManager.ManagerState ( ManagerState(..) ) 24 | import NixManager.Packages.Event ( Event 25 | ( EventOperationCompleted 26 | , EventInstallCompleted 27 | , EventUninstallCompleted 28 | , EventReload 29 | , EventReloadFinished 30 | , EventPackageEditView 31 | ) 32 | ) 33 | import qualified NixManager.Admin.Event as AdminEvent 34 | import NixManager.Message ( errorMessage 35 | , infoMessage 36 | , Message 37 | ) 38 | import NixManager.ManagerEvent ( ManagerEvent 39 | ( ManagerEventPackages 40 | ) 41 | , pureTransition 42 | , liftUpdate 43 | , packagesEvent 44 | , adminEvent 45 | ) 46 | import NixManager.NixPackagesUtil ( installPackage 47 | , readPackageCache 48 | , uninstallPackage 49 | ) 50 | import GI.Gtk.Declarative.App.Simple ( Transition(Transition) ) 51 | import Prelude hiding ( length 52 | , putStrLn 53 | ) 54 | import qualified NixManager.View.PackageEditView 55 | as PEV 56 | 57 | -- | What message to display when the install operation completes 58 | installCompletedMessage :: PEV.InstallationType -> Message 59 | installCompletedMessage PEV.Uncancelled = infoMessage 60 | "Marked for installation! Head to the Admin tab to apply the changes." 61 | installCompletedMessage PEV.Cancelled = infoMessage "Uninstall cancelled!" 62 | 63 | -- | What message to display when the uninstall operation completes 64 | uninstallCompletedMessage :: PEV.InstallationType -> Message 65 | uninstallCompletedMessage PEV.Uncancelled = infoMessage 66 | "Marked for uninstall! Head to the Admin tab to apply the changes." 67 | uninstallCompletedMessage PEV.Cancelled = infoMessage "Installation cancelled!" 68 | 69 | -- | The actual update function 70 | updateEvent :: ManagerState -> Event -> Transition ManagerState ManagerEvent 71 | updateEvent s (EventOperationCompleted e completionType) = 72 | Transition (s & #packagesState . #latestMessage ?~ e) $ case completionType of 73 | PEV.CompletionReload -> pure (adminEvent AdminEvent.EventReload) 74 | PEV.CompletionPass -> pure Nothing 75 | updateEvent s (EventInstallCompleted cache installationType) = Transition 76 | ( s 77 | & #packagesState 78 | . #packageCache 79 | .~ cache 80 | & #packagesState 81 | . #selectedIdx 82 | .~ Nothing 83 | ) 84 | (pure 85 | (packagesEvent 86 | (EventOperationCompleted (installCompletedMessage installationType) 87 | PEV.CompletionReload 88 | ) 89 | ) 90 | ) 91 | updateEvent s (EventUninstallCompleted cache installationType) = Transition 92 | ( s 93 | & #packagesState 94 | . #packageCache 95 | .~ cache 96 | & #packagesState 97 | . #selectedIdx 98 | .~ Nothing 99 | ) 100 | (pure 101 | (packagesEvent 102 | (EventOperationCompleted (uninstallCompletedMessage installationType) 103 | PEV.CompletionReload 104 | ) 105 | ) 106 | ) 107 | updateEvent s (EventPackageEditView (PEV.EventInstall installationType)) = 108 | case s ^? #packagesState . PEV.selectedPackage of 109 | Nothing -> pureTransition s 110 | Just selected -> Transition s $ do 111 | installResult <- installPackage selected 112 | cacheResult <- readPackageCache 113 | case installResult *> cacheResult of 114 | Success newCache -> 115 | pure (packagesEvent (EventInstallCompleted newCache installationType)) 116 | Failure e -> pure 117 | (packagesEvent 118 | (EventOperationCompleted (errorMessage ("Install failed: " <> e)) 119 | PEV.CompletionReload 120 | ) 121 | ) 122 | updateEvent s (EventPackageEditView (PEV.EventUninstall installationType)) = 123 | case s ^? #packagesState . PEV.selectedPackage of 124 | Nothing -> pureTransition s 125 | Just selected -> Transition s $ do 126 | uninstallResult <- uninstallPackage selected 127 | cacheResult <- readPackageCache 128 | case uninstallResult *> cacheResult of 129 | Success newCache -> pure 130 | (packagesEvent (EventUninstallCompleted newCache installationType)) 131 | Failure e -> pure 132 | (packagesEvent 133 | (EventOperationCompleted 134 | (errorMessage ("Uninstall failed: " <> e)) 135 | PEV.CompletionReload 136 | ) 137 | ) 138 | updateEvent s EventReload = Transition s $ do 139 | cacheResult <- readPackageCache 140 | case cacheResult of 141 | Success newCache -> pure (packagesEvent (EventReloadFinished newCache)) 142 | Failure e -> pure 143 | (packagesEvent 144 | (EventOperationCompleted 145 | (errorMessage ("Couldn't reload packages cache: " <> e)) 146 | PEV.CompletionPass 147 | ) 148 | ) 149 | updateEvent s (EventReloadFinished newCache) = 150 | pureTransition (s & #packagesState . #packageCache .~ newCache) 151 | updateEvent s (EventPackageEditView e) = liftUpdate 152 | PEV.updateEvent 153 | #packagesState 154 | (ManagerEventPackages . EventPackageEditView) 155 | s 156 | e 157 | -------------------------------------------------------------------------------- /src/NixManager/Packages/View.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the actual GUI (widgets) for the Packages tab 3 | Contains the actual GUI (widgets) for the Packages tab 4 | -} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | module NixManager.Packages.View 8 | ( packagesBox 9 | ) 10 | where 11 | 12 | import qualified NixManager.View.PackageEditView 13 | as PackageEditView 14 | import NixManager.Packages.Event ( Event(EventPackageEditView) ) 15 | import Control.Lens ( (^.) ) 16 | import GI.Gtk.Declarative ( Widget ) 17 | import NixManager.ManagerState ( ManagerState ) 18 | import NixManager.ManagerEvent ( ManagerEvent 19 | ( ManagerEventPackages 20 | ) 21 | ) 22 | 23 | -- | The package list 24 | packagesBox :: ManagerState -> Widget ManagerEvent 25 | packagesBox s = 26 | ManagerEventPackages . EventPackageEditView <$> PackageEditView.packagesBox 27 | (s ^. #packagesState) 28 | -------------------------------------------------------------------------------- /src/NixManager/Password.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Provides the 'Password' type to wrap over 'Text' 3 | Provides the 'Password' type to wrap over 'Text' 4 | -} 5 | module NixManager.Password 6 | ( Password(..) 7 | ) 8 | where 9 | 10 | import Data.Text ( Text ) 11 | 12 | -- | Wrapper for passwords (used for the @sudo@ prompt stuff) 13 | newtype Password = Password { 14 | getPassword :: Text 15 | } 16 | -------------------------------------------------------------------------------- /src/NixManager/PosixTools.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Bash expressions for some POSIX tools 3 | 4 | Bash expressions for some POSIX tools 5 | -} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | module NixManager.PosixTools 8 | ( mkdir 9 | , cp 10 | , mv 11 | , kill 12 | ) 13 | where 14 | 15 | import System.Process ( Pid ) 16 | import Data.Foldable ( toList ) 17 | import NixManager.Util ( mwhen 18 | , showText 19 | ) 20 | import NixManager.Bash ( Expr(Command) 21 | , Arg(LiteralArg, RawArg) 22 | ) 23 | import Data.Text ( pack ) 24 | import Data.List.NonEmpty ( NonEmpty ) 25 | 26 | -- | Wrapper for @mkdir@ (first parameter specifies recursion) 27 | mkdir :: Bool -> NonEmpty FilePath -> Expr 28 | mkdir recursive paths = Command 29 | "mkdir" 30 | (mwhen recursive ["-p"] <> toList (LiteralArg . pack <$> paths)) 31 | 32 | -- | Wrapper for @cp@ 33 | cp :: FilePath -> FilePath -> Expr 34 | cp from to = Command "cp" (LiteralArg <$> [pack from, pack to]) 35 | 36 | -- | Wrapper for @mv@ 37 | mv :: FilePath -> FilePath -> Expr 38 | mv from to = Command "mv" (LiteralArg <$> [pack from, pack to]) 39 | 40 | -- | Wrapper for @kill@ (currently only @-9@) 41 | kill :: Pid -> Expr 42 | kill pid = Command "kill" ["-9", RawArg (showText pid)] 43 | -------------------------------------------------------------------------------- /src/NixManager/Process.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Provides a thin layer above "System.Process" - there’s probably something nice out that that can be used instead. 3 | 4 | Provides a thin layer above "System.Process" - there’s probably something nice out that that can be used instead. 5 | -} 6 | {-# LANGUAGE DeriveAnyClass #-} 7 | {-# LANGUAGE OverloadedLabels #-} 8 | {-# LANGUAGE DeriveGeneric #-} 9 | {-# LANGUAGE OverloadedStrings #-} 10 | module NixManager.Process 11 | ( ProcessOutput 12 | , ProcessData 13 | , runProcess 14 | , runProcessToFinish 15 | , terminate 16 | , waitUntilFinished 17 | , getProcessId 18 | , updateProcess 19 | , noStdin 20 | ) 21 | where 22 | 23 | import Data.Foldable ( for_ ) 24 | import Data.Monoid ( First(First) ) 25 | import Data.ByteString ( ByteString 26 | , hGetNonBlocking 27 | , hPutStr 28 | , hGetContents 29 | ) 30 | import Control.Lens ( view 31 | , (^.) 32 | ) 33 | import System.Process ( ProcessHandle 34 | , getProcessExitCode 35 | , createProcess 36 | , Pid 37 | , getPid 38 | , CreateProcess(..) 39 | , CmdSpec 40 | ( ShellCommand 41 | , RawCommand 42 | ) 43 | , StdStream(CreatePipe) 44 | , terminateProcess 45 | , waitForProcess 46 | ) 47 | import System.IO ( Handle ) 48 | import System.Exit ( ExitCode ) 49 | import NixManager.Bash ( Expr(Command) 50 | , argText 51 | , evalExpr 52 | ) 53 | import Data.Text ( unpack ) 54 | import Data.Text.IO ( putStrLn ) 55 | import Prelude hiding ( putStrLn ) 56 | import GHC.Generics ( Generic ) 57 | import Data.Generics.Labels ( ) 58 | 59 | -- | Represents all the data needed to handle a running process 60 | data ProcessData = ProcessData { 61 | stdoutHandle :: Handle -- ^ The handle to stdout 62 | , stderrHandle :: Handle -- ^ The handle to stderr 63 | , processHandle :: ProcessHandle -- ^ The process handle 64 | } deriving(Generic) 65 | 66 | -- | Represents output from a process (either “in total” or partially) 67 | data ProcessOutput = ProcessOutput { 68 | stdout :: ByteString -- ^ A piece of stdout output 69 | , stderr :: ByteString -- ^ A piece of stderr output 70 | , result :: First ExitCode -- ^ Optional exit code (type chosen so semigroup/monoid works) 71 | } deriving(Generic) 72 | 73 | instance Semigroup ProcessOutput where 74 | (ProcessOutput a b c) <> (ProcessOutput a' b' c') = 75 | ProcessOutput (a <> a') (b <> b') (c <> c') 76 | 77 | instance Monoid ProcessOutput where 78 | mempty = ProcessOutput mempty mempty mempty 79 | 80 | -- | Terminate the process. In case you’re wondering why this isn’t actually used: I tried this on the sudo processes (like for rebuilding), and this terminate doesn’t throw an exception, /however/, it also doesn’t kill the process. This might just be my misunderstanding of Linux processes. 81 | terminate :: ProcessData -> IO () 82 | terminate = terminateProcess . view #processHandle 83 | 84 | -- | Convert a Bash expression (see the corresponding module) to a "System.Process" 'CmdSpec' 85 | exprToCmdSpec :: Expr -> CmdSpec 86 | exprToCmdSpec (Command x args) = 87 | RawCommand (unpack x) (unpack . argText <$> args) 88 | exprToCmdSpec x = ShellCommand (unpack (evalExpr x)) 89 | 90 | -- | Signify “I don’t want to pass anything on stdin”. Yeah, I was too lazy for a separate data type here. 91 | noStdin :: Maybe ByteString 92 | noStdin = Nothing 93 | 94 | -- | Get the processe’s ID (potentially unsafe, though I don’t know under what circumstances) 95 | getProcessId :: ProcessData -> IO (Maybe Pid) 96 | getProcessId = getPid . view #processHandle 97 | 98 | -- | Start a process, wait for it to finish, and return its result. 99 | runProcessToFinish :: Maybe ByteString -> Expr -> IO ProcessOutput 100 | runProcessToFinish stdinString command = do 101 | pd <- runProcess stdinString command 102 | waitUntilFinished pd 103 | 104 | -- | Start a process, potentially feeding a constant amount of data into stdin, and return the data to manage it further. 105 | runProcess :: Maybe ByteString -> Expr -> IO ProcessData 106 | runProcess stdinString command = do 107 | putStrLn ("Executing: " <> evalExpr command) 108 | (Just hin, Just hout, Just herr, ph) <- createProcess $ CreateProcess 109 | { cmdspec = exprToCmdSpec command 110 | , cwd = Nothing 111 | , env = Nothing 112 | , std_in = CreatePipe 113 | , std_out = CreatePipe 114 | , std_err = CreatePipe 115 | , close_fds = False 116 | , create_group = False 117 | , delegate_ctlc = False 118 | , detach_console = False 119 | , create_new_console = False 120 | , new_session = False 121 | , child_group = Nothing 122 | , child_user = Nothing 123 | , use_process_jobs = False 124 | } 125 | for_ stdinString (hPutStr hin) 126 | pure (ProcessData hout herr ph) 127 | 128 | -- | Wait for the process to finish, return all its (remaining) data. 129 | waitUntilFinished :: ProcessData -> IO ProcessOutput 130 | waitUntilFinished pd = do 131 | stdoutContent <- hGetContents (pd ^. #stdoutHandle) 132 | stderrContent <- hGetContents (pd ^. #stderrHandle) 133 | exitCode <- waitForProcess (pd ^. #processHandle) 134 | pure (ProcessOutput stdoutContent stderrContent (First (Just exitCode))) 135 | 136 | -- | Get some data from the process (for potentially the last time). 137 | updateProcess :: ProcessData -> IO ProcessOutput 138 | updateProcess pd = do 139 | newStdout <- hGetNonBlocking (pd ^. #stdoutHandle) 1024 140 | newStderr <- hGetNonBlocking (pd ^. #stderrHandle) 1024 141 | newExitCode <- getProcessExitCode (pd ^. #processHandle) 142 | pure (ProcessOutput newStdout newStderr (First newExitCode)) 143 | -------------------------------------------------------------------------------- /src/NixManager/ProgramArguments.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains "ProgramArguments" for the manager plus a parser for that 3 | Contains "ProgramArguments" for the manager plus a parser for that 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE LambdaCase #-} 7 | module NixManager.ProgramArguments 8 | ( ProgramArguments 9 | , parseArguments 10 | ) 11 | where 12 | 13 | import System.Environment ( getArgs ) 14 | import GHC.Generics ( Generic ) 15 | 16 | newtype ProgramArguments = ProgramArguments { 17 | useHomeManager :: Bool 18 | } deriving(Generic) 19 | 20 | parseArguments :: IO ProgramArguments 21 | parseArguments = getArgs >>= \case 22 | ("--home-manager" : _) -> pure (ProgramArguments True) 23 | _ -> pure (ProgramArguments False) 24 | -------------------------------------------------------------------------------- /src/NixManager/Services/Download.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains all functions relating to the service JSON download 3 | Contains all functions relating to the service JSON download 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE OverloadedLabels #-} 8 | module NixManager.Services.Download 9 | ( result 10 | , start 11 | , cancel 12 | , DownloadState 13 | , DownloadResult 14 | ) 15 | where 16 | 17 | import GHC.Generics ( Generic ) 18 | import Data.Validation ( Validation(Success, Failure) ) 19 | import System.Exit ( ExitCode 20 | ( ExitSuccess 21 | , ExitFailure 22 | ) 23 | ) 24 | import Prelude hiding ( writeFile ) 25 | import System.FilePath ( dropFileName ) 26 | import System.Directory ( createDirectoryIfMissing ) 27 | import NixManager.Bash ( Expr(Command) 28 | , Arg(RawArg) 29 | ) 30 | import NixManager.Process ( runProcessToFinish 31 | , noStdin 32 | ) 33 | import NixManager.NixServiceOption ( desiredOptionsFileLocation ) 34 | import Control.Exception ( try 35 | , SomeException 36 | ) 37 | import Control.Concurrent.MVar ( MVar 38 | , newEmptyMVar 39 | , putMVar 40 | , tryTakeMVar 41 | ) 42 | import Control.Concurrent ( forkIO 43 | , ThreadId 44 | , killThread 45 | ) 46 | import NixManager.Util ( TextualError 47 | , decodeUtf8 48 | , showText 49 | ) 50 | import Control.Lens ( view 51 | , to 52 | , (^.) 53 | , (^?!) 54 | ) 55 | import Data.ByteString.Lazy ( ByteString 56 | , writeFile 57 | ) 58 | import Data.Text ( pack ) 59 | import Data.Monoid ( getFirst ) 60 | 61 | -- | When the download finishes, this type contains either an error or the filepath to the downloaded file 62 | type DownloadResult = TextualError FilePath 63 | 64 | -- | We regularly check for the current state of the download. Locking is done with this 'MVar' 65 | type DownloadVar = MVar DownloadResult 66 | 67 | -- | The current state of the download 68 | data DownloadState = DownloadState { 69 | var :: DownloadVar -- ^ The mutex to check 70 | , threadId :: ThreadId -- ^ The thread we started the download in 71 | } deriving(Generic) 72 | 73 | -- | Start the download, return its state 74 | start :: IO DownloadState 75 | start = do 76 | resultVar <- newEmptyMVar 77 | resultThreadId <- forkIO $ do 78 | optLoc <- desiredOptionsFileLocation 79 | createDirectoryIfMissing True (dropFileName optLoc) 80 | po <- runProcessToFinish noStdin $ Command 81 | "nix-build" 82 | (RawArg 83 | <$> [ "--out-link" 84 | , pack optLoc 85 | , "-E" 86 | , "with import {}; let eval = import (pkgs.path + \"/nixos/lib/eval-config.nix\") { modules = []; }; opts = (nixosOptionsDoc { options = eval.options; }).optionsJSON; in runCommandLocal \"options.json\" { opts = opts; } '' cp \"$opts/share/doc/nixos/options.json\" $out ''" 87 | ] 88 | ) 89 | putMVar resultVar $ case po ^?! #result . to getFirst of 90 | Just ExitSuccess -> Success optLoc 91 | Just (ExitFailure code) -> Failure 92 | ( "Building the options file failed with error code " 93 | <> showText code 94 | <> ", standard error was:\n\n" 95 | <> (po ^. #stderr . decodeUtf8) 96 | ) 97 | pure (DownloadState resultVar resultThreadId) 98 | 99 | -- | Cancel a started download 100 | cancel :: DownloadState -> IO () 101 | cancel = killThread . view #threadId 102 | 103 | -- | Return the result of the download, maybe 104 | result :: DownloadState -> IO (Maybe DownloadResult) 105 | result = tryTakeMVar . view #var 106 | -------------------------------------------------------------------------------- /src/NixManager/Services/Event.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the event type for all events corresponding to the Services tab 3 | Contains the event type for all events corresponding to the Services tab 4 | -} 5 | module NixManager.Services.Event 6 | ( Event(..) 7 | ) 8 | where 9 | 10 | import NixManager.Services.Download ( DownloadState ) 11 | import NixManager.Services.State ( State ) 12 | import NixManager.View.ServiceEditView 13 | ( EditViewEvent ) 14 | 15 | data Event = EventDownloadStart -- ^ Triggered when the user presses the “Start download” button. The next event will be the 'EventDownloadStarted' event. 16 | | EventEditView EditViewEvent -- ^ Sub-event triggered by the "NixManager.Services.EditView" 17 | | EventDownloadCheck DownloadState -- ^ Triggered regularly while the download is in progress to check if it’s finished and to “pulse” the progress bar 18 | | EventDownloadStarted DownloadState -- ^ Triggered just after the download has begun 19 | | EventDownloadCancel -- ^ Triggered when the user presses the Cancel button on a running download 20 | | EventStateResult State -- ^ Triggered when the download has finished and the results are in 21 | | EventStateReload -- ^ This is triggered externally whenever we need to reload the cache. For example, when the download has finished. 22 | 23 | -------------------------------------------------------------------------------- /src/NixManager/Services/ServiceCategory.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the service category comboxbox values 3 | 4 | Contains the service category comboxbox values 5 | -} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | module NixManager.Services.ServiceCategory 8 | ( ServiceCategory(..) 9 | , categoryToText 10 | , categoryToNixPrefix 11 | , serviceCategories 12 | , serviceCategoryIdx 13 | ) 14 | where 15 | 16 | import Data.Maybe ( fromJust ) 17 | import Data.Text ( Text ) 18 | import Control.Lens ( Iso' 19 | , iso 20 | ) 21 | import Data.List ( elemIndex ) 22 | 23 | -- | All values for the service category combobox 24 | data ServiceCategory = ServiceCategoryServices 25 | | ServiceCategoryHardware 26 | | ServiceCategoryPrograms 27 | | ServiceCategoryBoot 28 | | ServiceCategoryNix 29 | deriving(Enum, Bounded, Eq) 30 | 31 | -- | Prettyprint the category 32 | categoryToText :: ServiceCategory -> Text 33 | categoryToText ServiceCategoryServices = "Services" 34 | categoryToText ServiceCategoryPrograms = "Programs" 35 | categoryToText ServiceCategoryHardware = "Hardware" 36 | categoryToText ServiceCategoryBoot = "Boot" 37 | categoryToText ServiceCategoryNix = "Nix" 38 | 39 | -- | Conver a category to its option prefix 40 | categoryToNixPrefix :: ServiceCategory -> Text 41 | categoryToNixPrefix ServiceCategoryServices = "services" 42 | categoryToNixPrefix ServiceCategoryPrograms = "programs" 43 | categoryToNixPrefix ServiceCategoryHardware = "hardware" 44 | categoryToNixPrefix ServiceCategoryBoot = "boot" 45 | categoryToNixPrefix ServiceCategoryNix = "nix" 46 | 47 | -- | List of all the service categories 48 | serviceCategories :: [ServiceCategory] 49 | serviceCategories = [minBound .. maxBound] 50 | 51 | -- | Isomorphism between a category and its index in the list of all categories (needed for the combobox logic) 52 | serviceCategoryIdx :: Iso' ServiceCategory Int 53 | serviceCategoryIdx = 54 | iso (fromJust . (`elemIndex` serviceCategories)) (serviceCategories !!) 55 | -------------------------------------------------------------------------------- /src/NixManager/Services/State.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains all the state for the Services tab 3 | Contains all the state for the Services tab 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | module NixManager.Services.State 7 | ( State(StateInvalidExpr, StateDownloading, StateDone, StateInvalidOptions) 8 | , initState 9 | , StateDownloadingData(StateDownloadingData) 10 | ) 11 | where 12 | 13 | import Data.Validation ( Validation(Success, Failure) ) 14 | import NixManager.Services.StateData ( StateData(StateData) ) 15 | import NixManager.Services.Download ( DownloadState ) 16 | import Data.Text ( Text ) 17 | import NixManager.NixServiceOption ( readOptionsFile 18 | , locateOptionsFile 19 | ) 20 | import NixManager.NixService ( makeServices ) 21 | import NixManager.NixServicesUtil ( readLocalServiceFile ) 22 | import GHC.Generics ( Generic ) 23 | 24 | -- | This contains the all data for the state “we’re currently downloading the services file” 25 | data StateDownloadingData = StateDownloadingData { 26 | counter :: Int -- ^ This field is necessary to “pulse” the GTK progress bar while building, see "NixManager.View.ProgressBar" for details 27 | , var :: DownloadState -- ^ The actual download state 28 | } deriving(Generic) 29 | 30 | data State = StateInvalidOptions (Maybe Text) -- ^ Parsing the service options file failed for some reason 31 | | StateInvalidExpr Text -- ^ Parsing the services Nix expression failed for some reason 32 | | StateDownloading StateDownloadingData -- ^ We’re currently downloading the options file 33 | | StateDone StateData -- ^ We have a valid options file 34 | deriving(Generic) 35 | 36 | -- FIXME: Better happy path 37 | -- | The initial Services tab state (needs to read the options file changes, hence the side-effect) 38 | initState :: IO State 39 | initState = do 40 | optionsFile' <- locateOptionsFile 41 | case optionsFile' of 42 | Nothing -> pure (StateInvalidOptions Nothing) 43 | Just optionsFile -> do 44 | options' <- readOptionsFile optionsFile 45 | case options' of 46 | Failure e -> pure (StateInvalidOptions (Just e)) 47 | Success options -> do 48 | services' <- readLocalServiceFile 49 | case services' of 50 | Failure e -> pure (StateInvalidExpr e) 51 | Success services -> 52 | pure $ StateDone 53 | (StateData (makeServices options) Nothing services mempty 0) 54 | -------------------------------------------------------------------------------- /src/NixManager/Services/StateData.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the service tab data, assuming we have successfully read the options JSON File 3 | 4 | Contains the service tab data, assuming we have successfully read the options JSON File 5 | -} 6 | {-# LANGUAGE DeriveGeneric #-} 7 | module NixManager.Services.StateData 8 | ( StateData(StateData) 9 | ) 10 | where 11 | 12 | import NixManager.NixService ( NixService ) 13 | import NixManager.NixExpr ( NixExpr ) 14 | import Data.Text ( Text ) 15 | import GHC.Generics ( Generic ) 16 | 17 | -- | Contains the service tab data, assuming we have successfully read the options JSON File 18 | data StateData = StateData { 19 | cache :: [NixService] -- ^ The list of all services 20 | , selectedIdx :: Maybe Int -- ^ The currently selected service in the list 21 | , expression :: NixExpr -- ^ The current service expression 22 | , searchString :: Text -- ^ The current service search string 23 | , categoryIdx :: Int -- ^ The currently selected service category, see "NixManager.Services.ServiceCategory" 24 | } deriving(Generic) 25 | -------------------------------------------------------------------------------- /src/NixManager/Services/Update.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains the update logic for the Services tab 3 | Contains the update logic for the Services tab 4 | -} 5 | {-# LANGUAGE OverloadedLabels #-} 6 | module NixManager.Services.Update 7 | ( updateEvent 8 | ) 9 | where 10 | 11 | import Data.Validation ( Validation(Failure, Success) ) 12 | import NixManager.ManagerEvent ( servicesEvent 13 | , pureTransition 14 | , ManagerEvent 15 | ) 16 | import qualified NixManager.View.ServiceEditView 17 | as EditView 18 | import NixManager.Services.State ( State 19 | ( StateDownloading 20 | , StateInvalidOptions 21 | ) 22 | , initState 23 | , StateDownloadingData 24 | ( StateDownloadingData 25 | ) 26 | ) 27 | import qualified NixManager.Services.Download as ServiceDownload 28 | import Data.Foldable ( for_ ) 29 | import Control.Lens ( over 30 | , (&) 31 | , (^?) 32 | , (.~) 33 | , (+~) 34 | , (%~) 35 | , (^?!) 36 | ) 37 | import NixManager.ManagerState ( ManagerState(..) ) 38 | import NixManager.NixServicesUtil ( writeLocalServiceFile ) 39 | import NixManager.Services.Event ( Event 40 | ( EventDownloadStart 41 | , EventDownloadCancel 42 | , EventStateResult 43 | , EventEditView 44 | , EventStateReload 45 | , EventDownloadCheck 46 | , EventDownloadStarted 47 | ) 48 | ) 49 | import NixManager.Util ( threadDelayMillis ) 50 | import GI.Gtk.Declarative.App.Simple ( Transition(Transition) ) 51 | import Prelude hiding ( length 52 | , putStrLn 53 | ) 54 | 55 | 56 | -- | The actual update function 57 | updateEvent :: ManagerState -> Event -> Transition ManagerState ManagerEvent 58 | updateEvent s EventDownloadStart = 59 | Transition s (servicesEvent . EventDownloadStarted <$> ServiceDownload.start) 60 | updateEvent s (EventEditView (EditView.EditViewSettingChanged setter)) = 61 | let newState = over (#serviceState . #_StateDone . #expression) setter s 62 | in Transition newState $ do 63 | writeLocalServiceFile 64 | (newState ^?! #serviceState . #_StateDone . #expression) 65 | pure Nothing 66 | updateEvent s (EventEditView e) = 67 | pureTransition (s & #serviceState . #_StateDone %~ EditView.updateEvent e) 68 | updateEvent s EventDownloadCancel = Transition s $ do 69 | for_ (s ^? #serviceState . #_StateDownloading . #var) ServiceDownload.cancel 70 | pure (servicesEvent EventStateReload) 71 | updateEvent s (EventStateResult newServiceState) = 72 | pureTransition (s & #serviceState .~ newServiceState) 73 | updateEvent s EventStateReload = 74 | Transition s (servicesEvent . EventStateResult <$> initState) 75 | updateEvent s (EventDownloadCheck var) = 76 | Transition (s & #serviceState . #_StateDownloading . #counter +~ 1) $ do 77 | downloadResult <- ServiceDownload.result var 78 | case downloadResult of 79 | Just (Failure e) -> 80 | pure (servicesEvent (EventStateResult (StateInvalidOptions (Just e)))) 81 | Just (Success _) -> pure (servicesEvent EventStateReload) 82 | Nothing -> 83 | threadDelayMillis 500 >> pure (servicesEvent (EventDownloadCheck var)) 84 | updateEvent s (EventDownloadStarted var) = 85 | Transition 86 | (s & #serviceState .~ StateDownloading (StateDownloadingData 0 var)) 87 | $ do 88 | threadDelayMillis 500 89 | pure (servicesEvent (EventDownloadCheck var)) 90 | -------------------------------------------------------------------------------- /src/NixManager/Services/View.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLabels #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE OverloadedLists #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-| 7 | Description: Contains the actual GUI (widgets) for the services tab 8 | Contains the actual GUI (widgets) for the services tab 9 | -} 10 | module NixManager.Services.View 11 | ( servicesBox 12 | , noticeBox 13 | ) 14 | where 15 | 16 | import NixManager.View.ServiceEditView 17 | ( editView ) 18 | import NixManager.View.InformationBox ( informationBox ) 19 | import NixManager.View.ImageButton ( imageButton ) 20 | import qualified NixManager.View.IconName as IconName 21 | import Data.Default ( def ) 22 | import NixManager.View.GtkUtil ( expandAndFill ) 23 | import NixManager.View.ProgressBar ( progressBar ) 24 | import Data.Text ( Text ) 25 | import GI.Gtk.Declarative ( bin 26 | , on 27 | , BoxChild(BoxChild) 28 | , defaultBoxChildProperties 29 | , widget 30 | , Attribute((:=)) 31 | , container 32 | ) 33 | import qualified GI.Gtk as Gtk 34 | import Control.Lens ( (^.) ) 35 | import NixManager.Services.Event ( Event 36 | ( EventEditView 37 | , EventDownloadStart 38 | , EventStateReload 39 | , EventDownloadCancel 40 | ) 41 | ) 42 | import NixManager.Services.State ( State 43 | ( StateInvalidOptions 44 | , StateInvalidExpr 45 | , StateDone 46 | , StateDownloading 47 | ) 48 | ) 49 | import NixManager.ManagerEvent ( ManagerEvent 50 | ( ManagerEventServices 51 | ) 52 | ) 53 | 54 | --servicesBox :: ManagerState -> Widget ManagerEvent 55 | -- This extra container is there to circumvent a bug that switches to the next page when one page is replaced. 56 | servicesBox s = container 57 | Gtk.Box 58 | [] 59 | [BoxChild expandAndFill (servicesBox' (s ^. #serviceState) s)] 60 | 61 | -- | What to display when the service definitions couldn't be parsed 62 | invalidOptionsMessage :: Maybe Text -> Text 63 | invalidOptionsMessage (Just e) = 64 | "Service definition file is invalid, possibly because of a corrupt download. You should try again. The error is:\n\n" 65 | <> e 66 | invalidOptionsMessage Nothing = 67 | "Service definitions need to be downloaded first.\nPress the button below to start the download. It'll only take a few seconds, depending on your internet speed." 68 | 69 | -- | The icon to display in case the service definitions aren't there or invalid 70 | invalidOptionsIcon (Just _) = IconName.DialogError 71 | invalidOptionsIcon Nothing = IconName.EmblemDocuments 72 | 73 | -- | The button text to display in case the service definitions aren't there or invalid 74 | invalidOptionsButtonText (Just _) = "Retry Download" 75 | invalidOptionsButtonText Nothing = "Start Download" 76 | 77 | -- | General function to display the notice box in case the service definitions aren't there or are invalid 78 | noticeBox icon buttonEvent buttonIcon buttonText message = container 79 | Gtk.Box 80 | [ #orientation := Gtk.OrientationVertical 81 | , #spacing := 10 82 | , #marginLeft := 40 83 | , #marginRight := 40 84 | , #marginTop := 5 85 | ] 86 | [ BoxChild def (informationBox False icon message) 87 | , BoxChild 88 | def 89 | (container 90 | Gtk.Box 91 | [#orientation := Gtk.OrientationHorizontal, #halign := Gtk.AlignCenter] 92 | [ BoxChild def $ imageButton 93 | [ #label := buttonText 94 | , on #clicked buttonEvent 95 | , #alwaysShowImage := True 96 | ] 97 | buttonIcon 98 | ] 99 | ) 100 | ] 101 | 102 | -- | The services tab root 103 | servicesBox' (StateDownloading ssdd) _ = container 104 | Gtk.Box 105 | [ #orientation := Gtk.OrientationVertical 106 | , #spacing := 10 107 | , #marginLeft := 40 108 | , #marginRight := 40 109 | , #marginTop := 5 110 | ] 111 | [ BoxChild defaultBoxChildProperties 112 | (widget Gtk.Label [#label := "Downloading services..."]) 113 | , BoxChild defaultBoxChildProperties (progressBar [] (ssdd ^. #counter)) 114 | , BoxChild 115 | defaultBoxChildProperties 116 | (container 117 | Gtk.Box 118 | [#orientation := Gtk.OrientationHorizontal, #halign := Gtk.AlignCenter] 119 | [ widget 120 | Gtk.Button 121 | [ #label := "Cancel" 122 | , on #clicked (ManagerEventServices EventDownloadCancel) 123 | ] 124 | ] 125 | ) 126 | ] 127 | servicesBox' (StateInvalidExpr e) _ = bin Gtk.ScrolledWindow [] $ noticeBox 128 | IconName.DialogError 129 | (ManagerEventServices EventStateReload) 130 | IconName.EmblemDownloads 131 | "Reload service state" 132 | ("Your service expression file is not valid. Maybe you have edited it by hand and it's become corrupted?\nPlease fix the error and then press the button below. The error is:\n" 133 | <> e 134 | ) 135 | servicesBox' (StateInvalidOptions possibleError) _ = 136 | bin Gtk.ScrolledWindow [] $ noticeBox 137 | (invalidOptionsIcon possibleError) 138 | (ManagerEventServices EventDownloadStart) 139 | IconName.EmblemDownloads 140 | (invalidOptionsButtonText possibleError) 141 | (invalidOptionsMessage possibleError) 142 | servicesBox' (StateDone sd) s = 143 | ManagerEventServices . EventEditView <$> editView sd s 144 | -------------------------------------------------------------------------------- /src/NixManager/Update.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLabels #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE OverloadedLists #-} 4 | {-| 5 | Description: Trampoline module for all the update functions (for the separate tabs) 6 | -} 7 | module NixManager.Update 8 | ( update 9 | ) 10 | where 11 | 12 | import qualified NixManager.Admin.Update as AdminUpdate 13 | import qualified NixManager.Services.Update as ServicesUpdate 14 | import qualified NixManager.Packages.Update as PackagesUpdate 15 | import qualified NixManager.HMPackages.Update as HMPackagesUpdate 16 | import qualified NixManager.HMServices.Update as HMServicesUpdate 17 | import qualified NixManager.HMAdmin.Update as HMAdminUpdate 18 | import Control.Lens ( (^.) ) 19 | import NixManager.ManagerState ( ManagerState(..) ) 20 | import NixManager.ManagerEvent ( ManagerEvent(..) 21 | , pureTransition 22 | ) 23 | import GI.Gtk.Declarative.App.Simple ( Transition(Exit) ) 24 | import Prelude hiding ( length 25 | , putStrLn 26 | ) 27 | 28 | 29 | -- | Process an event, change the state, and potentially emit an event and some side-effects 30 | update :: ManagerState -> ManagerEvent -> Transition ManagerState ManagerEvent 31 | update s (ManagerEventAdmin ae) = 32 | AdminUpdate.updateEvent s (s ^. #adminState) ae 33 | update s (ManagerEventServices se) = ServicesUpdate.updateEvent s se 34 | update s (ManagerEventHMServices se) = HMServicesUpdate.updateEvent s se 35 | update s (ManagerEventPackages se) = PackagesUpdate.updateEvent s se 36 | update s (ManagerEventHMPackages se) = HMPackagesUpdate.updateEvent s se 37 | update s (ManagerEventHMAdmin se) = HMAdminUpdate.updateEvent s se 38 | update _ ManagerEventClosed = Exit 39 | update s ManagerEventDiscard = pureTransition s 40 | 41 | -------------------------------------------------------------------------------- /src/NixManager/View/ComboBox.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Declarative @ComboBoxText@ wrapper 3 | 4 | Declarative @ComboBoxText@ wrapper. 5 | -} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE OverloadedLabels #-} 9 | {-# LANGUAGE FlexibleContexts #-} 10 | {-# LANGUAGE OverloadedLists #-} 11 | {-# LANGUAGE OverloadedStrings #-} 12 | module NixManager.View.ComboBox 13 | ( comboBox 14 | , ComboBoxChangeEvent(ComboBoxChangeEvent) 15 | , ComboBoxProperties(ComboBoxProperties) 16 | ) 17 | where 18 | 19 | import Data.Vector ( Vector ) 20 | import GI.Gtk.Declarative.EventSource ( fromCancellation ) 21 | import qualified GI.GObject as GI 22 | import Control.Monad ( when 23 | , forM_ 24 | , void 25 | ) 26 | import GI.Gtk.Declarative ( Widget(Widget) 27 | , CustomWidget(CustomWidget) 28 | , customWidget 29 | , customCreate 30 | , Attribute 31 | , customPatch 32 | , customSubscribe 33 | , customAttributes 34 | , customParams 35 | , CustomPatch 36 | ( CustomKeep 37 | , CustomModify 38 | ) 39 | ) 40 | import Data.Text ( Text ) 41 | import qualified GI.Gtk as Gtk 42 | 43 | -- | The ComboBox properties 44 | data ComboBoxProperties = ComboBoxProperties { 45 | values :: [Text] -- ^ The possible values (note that, sadly, this isn't a list of pairs (T, Text) or something, just texts; patches welcome!) 46 | , active :: Int -- ^ The active index in the combobox. 47 | } deriving(Eq) 48 | 49 | -- | Triggered when the combobox changes its value to a new index 50 | newtype ComboBoxChangeEvent = ComboBoxChangeEvent Int 51 | 52 | -- | Build a Combobox from Gtk attributes and some user-defined ones 53 | comboBox 54 | :: Vector (Attribute Gtk.ComboBoxText ComboBoxChangeEvent) 55 | -> ComboBoxProperties 56 | -> Widget ComboBoxChangeEvent 57 | comboBox customAttributes customParams = Widget 58 | (CustomWidget { customWidget 59 | , customCreate 60 | , customPatch 61 | , customSubscribe 62 | , customAttributes 63 | , customParams 64 | } 65 | ) 66 | where 67 | customWidget = Gtk.ComboBoxText 68 | customCreate :: ComboBoxProperties -> IO (Gtk.ComboBoxText, ()) 69 | customCreate props = do 70 | box <- Gtk.new Gtk.ComboBoxText [] 71 | forM_ (values props) $ Gtk.comboBoxTextInsert box (-1) Nothing 72 | Gtk.comboBoxSetActive box (fromIntegral (active props)) 73 | pure (box, ()) 74 | customSubscribe _params _internalState widget cb = do 75 | h <- 76 | Gtk.on widget #changed 77 | $ cb 78 | . ComboBoxChangeEvent 79 | . fromIntegral 80 | =<< Gtk.comboBoxGetActive widget 81 | pure (fromCancellation (GI.signalHandlerDisconnect widget h)) 82 | customPatch oldParams newParams _ 83 | | oldParams == newParams = CustomKeep 84 | | otherwise = CustomModify $ \widget -> do 85 | when (values oldParams /= values newParams) $ do 86 | Gtk.comboBoxTextRemoveAll widget 87 | forM_ (values newParams) $ Gtk.comboBoxTextInsert widget (-1) Nothing 88 | when (active oldParams /= active newParams) $ void 89 | (Gtk.comboBoxSetActive widget (fromIntegral (active newParams))) 90 | 91 | -------------------------------------------------------------------------------- /src/NixManager/View/Css.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: CSS styles and CSS initialization (see https://developer.gnome.org/gtk3/stable/chap-css-overview.html) 3 | 4 | CSS styles and CSS initialization (see https://developer.gnome.org/gtk3/stable/chap-css-overview.html) 5 | -} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | module NixManager.View.Css where 8 | 9 | import Data.ByteString ( ByteString ) 10 | import qualified GI.Gdk as Gdk 11 | import qualified GI.Gtk as Gtk 12 | 13 | -- | Global app Stylesheet 14 | styles :: ByteString 15 | styles = mconcat 16 | [ ".package-row-installed { background-color: #cdffcd; }" 17 | , ".install-button { font-weight: bold; }" 18 | , ".error-message { background-image: image(#fff3cd); }" 19 | , ".info-message { background-image: image(#bef7ff); }" 20 | , ".package-row-even { }" 21 | , ".package-row-odd { background-color: #f2f2f2; }" 22 | , ".service-headline { font-size: 40px; }" 23 | , ".service-option-title { font-family: monospace; font-weight: bold; }" 24 | , ".unspecified-label { color: #101010; }" 25 | , ".startup-error-message { font-family: monospace; }" 26 | , ".option-type-description { font-style: italic; font-size: 13px; }" 27 | , ".nixos-manager-headline { font-size: 30px; }" 28 | , ".nixos-manager-italic { font-style: italic; }" 29 | , ".nixos-manager-monospace { font-family: monospace; }" 30 | , ".nixos-manager-grey-background { background-color: #eeeeee; }" 31 | ] 32 | 33 | -- | Initialize CSS stylesheets 34 | initCss :: IO () 35 | initCss = do 36 | cssProvider <- Gtk.cssProviderNew 37 | Gtk.cssProviderLoadFromData cssProvider styles 38 | screen <- maybe (fail "No screen?!") return =<< Gdk.screenGetDefault 39 | Gtk.styleContextAddProviderForScreen 40 | screen 41 | cssProvider 42 | (fromIntegral Gtk.STYLE_PROVIDER_PRIORITY_USER) 43 | -------------------------------------------------------------------------------- /src/NixManager/View/DetailsState.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Contains "DetailsState" to signify if a GTK expander is contracted 3 | Contains "DetailsState" to signify if a GTK expander is contracted 4 | -} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | module NixManager.View.DetailsState 7 | ( DetailsState(..) 8 | , detailsBool 9 | ) 10 | where 11 | 12 | import Control.Lens ( Iso' 13 | , iso 14 | ) 15 | import GHC.Generics ( Generic ) 16 | 17 | -- | Signifies if an expander is contracted or expanded 18 | data DetailsState = DetailsContracted 19 | | DetailsExpanded 20 | deriving(Eq, Bounded, Enum, Generic) 21 | 22 | -- | Isomorphism to boolean (contracted being @false@) 23 | detailsBool :: Iso' DetailsState Bool 24 | detailsBool = iso toBool fromBool 25 | where 26 | toBool DetailsContracted = False 27 | toBool DetailsExpanded = True 28 | fromBool False = DetailsContracted 29 | fromBool True = DetailsExpanded 30 | 31 | -------------------------------------------------------------------------------- /src/NixManager/View/ErrorDialog.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: An error dialog which is displayed in case initialization fails 3 | 4 | An error dialog which is displayed in case initialization fails 5 | -} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | {-# LANGUAGE FlexibleContexts #-} 8 | {-# LANGUAGE OverloadedLists #-} 9 | {-# LANGUAGE OverloadedStrings #-} 10 | module NixManager.View.ErrorDialog 11 | ( runErrorDialog 12 | ) 13 | where 14 | 15 | import Text.Wrap ( wrapText 16 | , WrapSettings(WrapSettings) 17 | ) 18 | import Data.Text ( Text ) 19 | import Control.Monad ( void ) 20 | import NixManager.View.GtkUtil ( paddedAround 21 | , expandAndFill 22 | ) 23 | import GI.Gtk.Declarative.App.Simple ( App(App) 24 | , view 25 | , update 26 | , AppView 27 | , Transition(Exit) 28 | , inputs 29 | , initialState 30 | , run 31 | ) 32 | import GI.Gtk.Declarative ( bin 33 | , on 34 | , expand 35 | , container 36 | , fill 37 | , widget 38 | , Attribute((:=)) 39 | , classes 40 | , container 41 | , BoxChild(BoxChild) 42 | , on 43 | ) 44 | import qualified GI.Gtk as Gtk 45 | 46 | -- | There’s just one event, to exit the dialog 47 | data Event = ExitEvent 48 | 49 | -- | The error dialog’s view function 50 | errorDialog :: Text -> () -> AppView Gtk.Dialog Event 51 | errorDialog e _ = 52 | let msgLabel = widget 53 | Gtk.Label 54 | [ #label := wrapText (WrapSettings True False) 80 e 55 | , classes ["startup-error-message"] 56 | ] 57 | in bin 58 | Gtk.Dialog 59 | [ #title := "An error occurred" 60 | , on #deleteEvent (const (True, ExitEvent)) 61 | , #widthRequest := 300 62 | , #heightRequest := 200 63 | ] 64 | $ container 65 | Gtk.Box 66 | [#orientation := Gtk.OrientationVertical] 67 | [ BoxChild expandAndFill (paddedAround 20 msgLabel) 68 | , paddedAround 5 $ container 69 | Gtk.Box 70 | [#halign := Gtk.AlignEnd, #spacing := 5] 71 | [ widget 72 | Gtk.Button 73 | [ #label := "Okay, let me fix this real quick" 74 | , on #clicked ExitEvent 75 | ] 76 | ] 77 | ] 78 | 79 | -- | Display an error dialog, wait for the user to close it again. 80 | runErrorDialog :: Text -> IO () 81 | runErrorDialog e = void $ run App { view = errorDialog e 82 | , update = \_ _ -> Exit 83 | , inputs = [] 84 | , initialState = () 85 | } 86 | -------------------------------------------------------------------------------- /src/NixManager/View/GtkUtil.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Various GTK-related utilities 3 | 4 | Various GTK-related utilities 5 | -} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | {-# LANGUAGE FlexibleContexts #-} 8 | {-# LANGUAGE OverloadedLists #-} 9 | module NixManager.View.GtkUtil where 10 | 11 | import GI.Gtk.Declarative ( padding 12 | , defaultBoxChildProperties 13 | , expand 14 | , container 15 | , fill 16 | , Attribute((:=)) 17 | , container 18 | , BoxChild(BoxChild) 19 | , BoxChildProperties 20 | ) 21 | import qualified GI.Gtk as Gtk 22 | 23 | 24 | -- | Add some padding around a widget 25 | paddedAround spacing = 26 | container Gtk.Box [#orientation := Gtk.OrientationVertical] 27 | . pure 28 | . BoxChild defaultBoxChildProperties { padding = spacing 29 | , expand = True 30 | , fill = True 31 | } 32 | . container Gtk.Box [] 33 | . pure 34 | . BoxChild defaultBoxChildProperties { padding = spacing 35 | , expand = True 36 | , fill = True 37 | } 38 | 39 | -- | A shortcut for a box child that has both the expand and fill flag 40 | expandAndFill :: BoxChildProperties 41 | expandAndFill = defaultBoxChildProperties { expand = True, fill = True } 42 | 43 | -- | A shortcut for a box child that has the fill, but not the expand flag 44 | fillNoExpand :: BoxChildProperties 45 | fillNoExpand = defaultBoxChildProperties { expand = False, fill = True } 46 | 47 | -------------------------------------------------------------------------------- /src/NixManager/View/Icon.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: An icon widget 3 | 4 | An icon widget 5 | -} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE OverloadedLabels #-} 9 | {-# LANGUAGE FlexibleContexts #-} 10 | {-# LANGUAGE OverloadedLists #-} 11 | {-# LANGUAGE OverloadedStrings #-} 12 | module NixManager.View.Icon 13 | ( icon 14 | , IconProps(IconProps) 15 | ) 16 | where 17 | 18 | import GI.Gtk.Declarative.Attributes.Internal 19 | ( addSignalHandler ) 20 | import Data.Vector ( Vector ) 21 | import GI.Gtk.Declarative ( Widget(Widget) 22 | , CustomWidget(CustomWidget) 23 | , customWidget 24 | , customCreate 25 | , Attribute 26 | , customPatch 27 | , customSubscribe 28 | , customAttributes 29 | , customParams 30 | , CustomPatch 31 | ( CustomKeep 32 | , CustomModify 33 | ) 34 | ) 35 | import qualified GI.Gtk as Gtk 36 | import NixManager.View.IconName ( IconName 37 | , nameToGtk 38 | ) 39 | 40 | -- | An icon’s properties 41 | data IconProps = IconProps { 42 | iconSize :: Gtk.IconSize -- ^ The icon’s desired size 43 | , iconName :: IconName -- ^ What icon to display 44 | } deriving(Eq) 45 | 46 | -- | Create an icon widget 47 | icon :: Vector (Attribute Gtk.Image e) -> IconProps -> Widget e 48 | icon customAttributes customParams = Widget 49 | (CustomWidget { customWidget 50 | , customCreate 51 | , customPatch 52 | , customSubscribe 53 | , customAttributes 54 | , customParams 55 | } 56 | ) 57 | where 58 | customWidget = Gtk.Image 59 | customCreate :: IconProps -> IO (Gtk.Image, ()) 60 | customCreate iconProps = do 61 | -- Taken from https://hackage.haskell.org/package/gi-gtk-3.0.32/docs/src/GI.Gtk.Enums.html#IconSize 62 | w <- Gtk.imageNewFromIconName 63 | (Just (nameToGtk (iconName iconProps))) 64 | (fromIntegral (fromEnum (iconSize iconProps))) 65 | pure (w, ()) 66 | customSubscribe _params _currentImage widget cb = 67 | foldMap (addSignalHandler cb widget) customAttributes 68 | customPatch before after _internalState 69 | | before == after = CustomKeep 70 | | otherwise = CustomModify $ \w -> do 71 | Gtk.imageSetFromIconName w 72 | (Just (nameToGtk (iconName after))) 73 | (fromIntegral (fromEnum (iconSize after))) 74 | pure () 75 | 76 | -------------------------------------------------------------------------------- /src/NixManager/View/IconName.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: An enum wrapping GTK’s icon name values 3 | 4 | An enum wrapping GTK’s icon name values 5 | -} 6 | module NixManager.View.IconName 7 | ( IconName(..) 8 | , nameToGtk 9 | ) 10 | where 11 | 12 | import Data.Text ( Text ) 13 | import NixManager.Util ( showText 14 | , kebapize 15 | ) 16 | 17 | -- | An enum wrapping GTK’s icon name values 18 | data IconName = SystemRun 19 | | SystemSoftwareInstall 20 | | PreferencesOther 21 | | PackageXGeneric 22 | | EmblemImportant 23 | | EmblemDocuments 24 | | EmblemDownloads 25 | | EmblemDefault 26 | | DriveMultidisk 27 | | DialogError 28 | | DialogQuestion 29 | | DialogInformation 30 | | UserTrash 31 | | ApplicationsSystem 32 | | EditDelete 33 | | EditClear 34 | | ProcessStop 35 | | ViewRefresh 36 | | UserHome 37 | deriving(Eq, Show) 38 | 39 | -- | Convert the enum to a GTK-compatible string 40 | nameToGtk :: IconName -> Text 41 | nameToGtk = kebapize mempty . showText 42 | -------------------------------------------------------------------------------- /src/NixManager/View/ImageButton.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: An image button widget 3 | 4 | An image button widget 5 | -} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE OverloadedLabels #-} 9 | {-# LANGUAGE FlexibleContexts #-} 10 | {-# LANGUAGE OverloadedLists #-} 11 | {-# LANGUAGE OverloadedStrings #-} 12 | module NixManager.View.ImageButton 13 | ( imageButton 14 | ) 15 | where 16 | 17 | import GI.Gtk.Declarative.Attributes.Internal 18 | ( addSignalHandler ) 19 | import Data.Vector ( Vector ) 20 | import GI.Gtk.Declarative ( Widget(Widget) 21 | , CustomWidget(CustomWidget) 22 | , customWidget 23 | , customCreate 24 | , Attribute 25 | , customPatch 26 | , customSubscribe 27 | , customAttributes 28 | , customParams 29 | , CustomPatch 30 | ( CustomKeep 31 | , CustomModify 32 | ) 33 | ) 34 | import qualified GI.Gtk as Gtk 35 | import NixManager.View.IconName ( IconName 36 | , nameToGtk 37 | ) 38 | 39 | -- | Create an image button widget 40 | imageButton :: Vector (Attribute Gtk.Button e) -> IconName -> Widget e 41 | imageButton customAttributes customParams = Widget 42 | (CustomWidget { customWidget 43 | , customCreate 44 | , customPatch 45 | , customSubscribe 46 | , customAttributes 47 | , customParams 48 | } 49 | ) 50 | where 51 | customWidget = Gtk.Button 52 | customCreate :: IconName -> IO (Gtk.Button, Gtk.Image) 53 | customCreate iconName = do 54 | w <- Gtk.new Gtk.Button [] 55 | -- Taken from https://hackage.haskell.org/package/gi-gtk-3.0.32/docs/src/GI.Gtk.Enums.html#IconSize 56 | image <- Gtk.imageNewFromIconName 57 | (Just (nameToGtk iconName)) 58 | (fromIntegral (fromEnum Gtk.IconSizeButton)) 59 | Gtk.buttonSetImage w (Just image) 60 | pure (w, image) 61 | customSubscribe _params _currentImage widget cb = 62 | foldMap (addSignalHandler cb widget) customAttributes 63 | customPatch before after currentImage 64 | | before == after = CustomKeep 65 | | otherwise = CustomModify $ \w -> do 66 | Gtk.widgetDestroy currentImage 67 | newImage <- Gtk.imageNewFromIconName 68 | (Just (nameToGtk after)) 69 | (fromIntegral (fromEnum Gtk.IconSizeButton)) 70 | Gtk.buttonSetImage w (Just newImage) 71 | pure newImage 72 | -------------------------------------------------------------------------------- /src/NixManager/View/InformationBox.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: Functions to display informational boxes 3 | 4 | Functions to display informational boxes 5 | -} 6 | {-# LANGUAGE OverloadedLabels #-} 7 | {-# LANGUAGE RankNTypes #-} 8 | {-# LANGUAGE FlexibleContexts #-} 9 | {-# LANGUAGE OverloadedLists #-} 10 | {-# LANGUAGE OverloadedStrings #-} 11 | module NixManager.View.InformationBox 12 | ( informationBox 13 | ) 14 | where 15 | 16 | import qualified GI.Gtk as Gtk 17 | import GI.Gtk.Declarative.Container ( Children ) 18 | import GI.Gtk.Declarative ( container 19 | , widget 20 | , classes 21 | , BoxChild(BoxChild) 22 | , Attribute((:=)) 23 | , FromWidget 24 | , Container 25 | ) 26 | import qualified NixManager.View.IconName as IconName 27 | import NixManager.View.Icon ( icon 28 | , IconProps(IconProps) 29 | ) 30 | import Data.Default ( def ) 31 | import Data.Text ( Text ) 32 | 33 | -- | Display a box with an icon and a descriptive text next to it, possibly using Pango markup 34 | informationBox 35 | :: FromWidget (Container Gtk.Box (Children BoxChild)) target 36 | => Bool -- ^ Whether to use pango markup 37 | -> IconName.IconName -- ^ Icon to display 38 | -> Text -- ^ Message to display 39 | -> target event 40 | informationBox useMarkup iconName message = container 41 | Gtk.Box 42 | [ #orientation := Gtk.OrientationHorizontal 43 | , #spacing := 15 44 | , #halign := Gtk.AlignCenter 45 | ] 46 | [ BoxChild def $ icon [] (IconProps Gtk.IconSizeDialog iconName) 47 | , BoxChild def $ widget 48 | Gtk.Label 49 | [ #label := message 50 | , #wrap := True 51 | , #useMarkup := useMarkup 52 | , #halign := Gtk.AlignCenter 53 | , classes ["nixos-manager-italic"] 54 | ] 55 | ] 56 | -------------------------------------------------------------------------------- /src/NixManager/View/ProgressBar.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Description: A progress bar widget 3 | 4 | A progress bar widget 5 | -} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | module NixManager.View.ProgressBar 8 | ( progressBar 9 | ) 10 | where 11 | 12 | import GI.Gtk.Declarative.Attributes.Internal 13 | ( addSignalHandler ) 14 | import Data.Vector ( Vector ) 15 | import GI.Gtk.Declarative ( Widget(Widget) 16 | , CustomWidget(CustomWidget) 17 | , customWidget 18 | , customCreate 19 | , Attribute 20 | , customPatch 21 | , customSubscribe 22 | , customAttributes 23 | , customParams 24 | , CustomPatch 25 | ( CustomKeep 26 | , CustomModify 27 | ) 28 | ) 29 | import qualified GI.Gtk as Gtk 30 | 31 | 32 | -- | Create a progress bar widget. It’s currently not “percentage-based”, but has to be regularly “pulsed” to show that something is happening. You can do this by incrementing (or changing) the integer you provide here. 33 | progressBar :: Vector (Attribute Gtk.ProgressBar e) -> Int -> Widget e 34 | progressBar customAttributes customParams = Widget 35 | (CustomWidget { customWidget 36 | , customCreate 37 | , customPatch 38 | , customSubscribe 39 | , customAttributes 40 | , customParams 41 | } 42 | ) 43 | where 44 | customWidget = Gtk.ProgressBar 45 | customCreate :: Int -> IO (Gtk.ProgressBar, ()) 46 | customCreate _ = do 47 | widget <- Gtk.new Gtk.ProgressBar [] 48 | Gtk.progressBarPulse widget 49 | pure (widget, ()) 50 | customSubscribe _params _internalState widget cb = 51 | foldMap (addSignalHandler cb widget) customAttributes 52 | customPatch before after _internalState 53 | | before == after = CustomKeep 54 | | otherwise = CustomModify $ \widget -> do 55 | Gtk.progressBarPulse widget 56 | pure () 57 | -------------------------------------------------------------------------------- /src/NixManager/View/Root.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLabels #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE OverloadedLists #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-| 6 | Description: The root of the view hierarchy 7 | 8 | The root of the view hierarchy 9 | -} 10 | module NixManager.View.Root 11 | ( view' 12 | ) 13 | where 14 | 15 | import NixManager.ProgramArguments ( ProgramArguments ) 16 | import qualified NixManager.Packages.View as PackagesView 17 | import qualified NixManager.Services.View as ServicesView 18 | import qualified NixManager.Admin.View as AdminView 19 | import qualified NixManager.HMServices.View as HMServicesView 20 | import qualified NixManager.HMPackages.View as HMPackagesView 21 | import qualified NixManager.HMAdmin.View as HMAdminView 22 | import GI.Gtk.Declarative ( Attribute((:=)) 23 | , on 24 | , bin 25 | , notebook 26 | , container 27 | , pageWithTab 28 | , BoxChild(BoxChild) 29 | , widget 30 | ) 31 | import Data.Default ( def ) 32 | import NixManager.View.Icon ( icon 33 | , IconProps(IconProps) 34 | ) 35 | import qualified NixManager.View.IconName as IconName 36 | import GI.Gtk.Declarative.App.Simple ( AppView ) 37 | import qualified GI.Gtk as Gtk 38 | import NixManager.ManagerState ( ManagerState ) 39 | import NixManager.ManagerEvent ( ManagerEvent 40 | ( ManagerEventClosed 41 | ) 42 | ) 43 | import Data.Vector ( Vector ) 44 | import Control.Lens ( (^.) ) 45 | 46 | -- | The main window’s attributes 47 | windowAttributes :: Vector (Attribute Gtk.Window ManagerEvent) 48 | windowAttributes = 49 | [ #title := "nixos-manager 1.0" 50 | , on #deleteEvent (const (True, ManagerEventClosed)) 51 | , #widthRequest := 1024 52 | , #heightRequest := 768 53 | ] 54 | 55 | -- | A label with an image next to it (used in the notebook’s tab headers) 56 | imagedLabel iconProps text = container 57 | Gtk.Box 58 | [#orientation := Gtk.OrientationHorizontal, #spacing := 5] 59 | [ BoxChild def (icon [] iconProps) 60 | , BoxChild def (widget Gtk.Label [#label := text, #valign := Gtk.AlignCenter]) 61 | ] 62 | 63 | -- | The root view function 64 | view' :: ProgramArguments -> ManagerState -> AppView Gtk.Window ManagerEvent 65 | view' pa s = 66 | let adminTab = pageWithTab 67 | (imagedLabel 68 | (IconProps Gtk.IconSizeButton IconName.ApplicationsSystem) 69 | "Administration" 70 | ) 71 | (AdminView.adminBox s) 72 | packagesTab = pageWithTab 73 | (imagedLabel (IconProps Gtk.IconSizeButton IconName.PackageXGeneric) 74 | "Add/Remove Software" 75 | ) 76 | (PackagesView.packagesBox s) 77 | servicesTab = pageWithTab 78 | (imagedLabel (IconProps Gtk.IconSizeButton IconName.PreferencesOther) 79 | "Configure your system" 80 | ) 81 | (ServicesView.servicesBox s) 82 | hmAdminTab = pageWithTab 83 | (imagedLabel 84 | (IconProps Gtk.IconSizeButton IconName.ApplicationsSystem) 85 | "Home Administration" 86 | ) 87 | (HMAdminView.adminBox s) 88 | hmPackagesTab = pageWithTab 89 | (imagedLabel (IconProps Gtk.IconSizeButton IconName.PackageXGeneric) 90 | "Add/Remove Software" 91 | ) 92 | (HMPackagesView.packagesBox s) 93 | hmServicesTab = pageWithTab 94 | (imagedLabel (IconProps Gtk.IconSizeButton IconName.UserHome) 95 | "Configure your Home" 96 | ) 97 | (HMServicesView.servicesBox s) 98 | windowContents = if pa ^. #useHomeManager 99 | then notebook [] [hmAdminTab, hmPackagesTab, hmServicesTab] 100 | else notebook [] [adminTab, packagesTab, servicesTab] 101 | in bin Gtk.Window windowAttributes windowContents 102 | --------------------------------------------------------------------------------