├── .gitignore ├── LICENSE ├── README.md ├── disk-space-usage-app ├── DiskSpaceUsage │ ├── Debounce.fs │ ├── DiskItem.fs │ ├── FolderPath.fs │ ├── Icons.fs │ ├── MainUI.fs │ ├── Program.fs │ ├── SizeView.fs │ ├── Styles.fs │ ├── Time.fs │ ├── TreeMap.fs │ └── TreeMapView.fs ├── Styles.xaml └── disk-space-usage-app.fsproj ├── disk-space-usage-tests ├── DiskSpacesUsageTests │ ├── Program.fs │ └── TreeMap.fs └── disk-space-usage-tests.fsproj ├── disk-space-usage.sln └── screenshot.png /.gitignore: -------------------------------------------------------------------------------- 1 | bin 2 | obj 3 | .idea 4 | *.DotSettings.user 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 Damien Le Berrigaud 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Disk Space Usage 2 | 3 | This is a small desktop app that will allow you to analyze 4 | the disk space usage of a given directory of your choosing. 5 | 6 | It's built in [F#](https://fsharp.org) using [Avalonia](https://avaloniaui.net/) 7 | and its [functional extensions](https://avaloniacommunity.github.io/Avalonia.FuncUI.Docs/). 8 | 9 | It runs cross-platform (on Windows, Linux and Mac OS) using **.NET 5**. 10 | 11 | ## Screenshot 12 | 13 | ![Screenshot](screenshot.png) 14 | 15 | ## Local Setup 16 | 17 | ### Dependencies 18 | [.NET 5](https://dotnet.microsoft.com/download/dotnet/5.0) 19 | 20 | ### Running the build 21 | 22 | ``` 23 | dotnet build 24 | ``` 25 | 26 | ### Running the app 27 | 28 | ``` 29 | dotnet run 30 | ``` 31 | 32 | ### Publishing the app 33 | 34 | I use [warp-packer](https://github.com/dgiagio/warp) to combine the binary and DLLs into a single file. 35 | 36 | #### Windows x64 37 | ``` 38 | dotnet publish disk-space-usage-app -c Release -r win-x64 39 | warp-packer --arch windows-x64 --input_dir disk-space-usage-app/bin/Release/net5.0/win-x64/publish --exec disk-space-usage-app.exe --output disk-space-usage-app/bin/Release/disk-space-usage-win-x64.exe 40 | ``` 41 | 42 | #### Linux x64 43 | ``` 44 | dotnet publish disk-space-usage-app -c Release -r linux-x64 45 | warp-packer --arch linux-x64 --input_dir disk-space-usage-app/bin/Release/net5.0/linux-x64/publish --exec disk-space-usage-app --output disk-space-usage-app/bin/Release/disk-space-usage-linux-x64 46 | ``` 47 | 48 | #### MacOS x64 49 | ``` 50 | dotnet publish disk-space-usage-app -c Release -r osx-x64 51 | warp-packer --arch macos-x64 --input_dir disk-space-usage-app/bin/Release/net5.0/osx-x64/publish --exec disk-space-usage-app --output disk-space-usage-app/bin/Release/disk-space-usage-osx-x64 52 | ``` 53 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/Debounce.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.Debounce 2 | 3 | open DiskSpaceUsage.Time 4 | 5 | [] 6 | module Debounce = 7 | type State = 8 | private { delayInMs: int; lastNotify: Posix } 9 | 10 | let init ms = 11 | { delayInMs = ms; lastNotify = Posix.now() } 12 | 13 | let invoke f state = 14 | let now = Posix.now() 15 | let msSinceLastNotify = Posix.milliseconds now - Posix.milliseconds state.lastNotify 16 | 17 | if msSinceLastNotify > int64 state.delayInMs 18 | then 19 | f() 20 | { state with lastNotify = now } 21 | else 22 | state 23 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/DiskItem.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.DiskItem 2 | 3 | open System.IO 4 | open FSharp.Control 5 | open FolderPath 6 | 7 | type SizeOnDisk = 8 | | Bytes of int64 9 | | Unknown 10 | 11 | type DiskItem = 12 | { name: string 13 | size: SizeOnDisk 14 | itemType: DiskItemType } 15 | and DiskItemType = 16 | | File 17 | | Folder of {| path: FolderPath; children: DiskItem list |} 18 | 19 | type private SystemDir = 20 | | Readable of ReadableRecord 21 | | Unreadable of UnreadableRecord 22 | and private ReadableRecord = 23 | { name: string; files: FileInfo[]; dirs: DirectoryInfo[] } 24 | and private UnreadableRecord = 25 | { name: string } 26 | 27 | [] 28 | module private SystemDir = 29 | let load folderPath = 30 | let dir = folderPath 31 | |> FolderPath.path 32 | |> DirectoryInfo 33 | try 34 | Readable { name = dir.Name 35 | files = dir.GetFiles() 36 | dirs = dir.GetDirectories() } 37 | with _ -> 38 | Unreadable { name = dir.Name } 39 | 40 | [] 41 | module rec DiskItem = 42 | let sizeInBytes (item: DiskItem) = 43 | match item.size with 44 | | Bytes bytes -> Some bytes 45 | | Unknown -> None 46 | 47 | let fileSize (fileInfo: FileInfo) = 48 | try Bytes fileInfo.Length 49 | with _ -> Unknown 50 | 51 | let private createFile (fileInfo: FileInfo) = 52 | { name = fileInfo.Name 53 | size = fileSize fileInfo 54 | itemType = File } 55 | 56 | let private loadUnreadableRecord folderPath record: Async = 57 | async { 58 | let itemType = 59 | Folder {| path = folderPath; children = [] |} 60 | return 61 | { name = record.name 62 | size = Unknown 63 | itemType = itemType } 64 | } 65 | 66 | let loadSubFolders notify (dirs: DirectoryInfo[]) = 67 | asyncSeq { 68 | for d in dirs do 69 | let pathOpt = FolderPath.create d.FullName 70 | match pathOpt with 71 | | Some path -> yield loadAsync notify path 72 | | None -> () 73 | } 74 | |> AsyncSeq.mapAsyncParallel id 75 | |> AsyncSeq.toListAsync 76 | 77 | let private loadReadableRecord notify folderPath record: Async = 78 | async { 79 | let mutable children = 80 | record.files 81 | |> Array.toList 82 | |> List.map createFile 83 | 84 | let! subFolders = loadSubFolders notify record.dirs 85 | 86 | children <- subFolders @ children 87 | 88 | let size = 89 | children 90 | |> List.choose sizeInBytes 91 | |> List.sum 92 | 93 | return { name = record.name 94 | size = Bytes size 95 | itemType = Folder {| path = folderPath; children = children |} } 96 | } 97 | 98 | let loadAsync (notify: FolderPath -> unit) folderPath: Async = 99 | async { 100 | notify folderPath 101 | 102 | let asyncDiskItem = 103 | match SystemDir.load folderPath with 104 | | Unreadable record -> loadUnreadableRecord folderPath record 105 | | Readable record -> loadReadableRecord notify folderPath record 106 | 107 | return! asyncDiskItem 108 | } 109 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/FolderPath.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.FolderPath 2 | 3 | type FolderPath = 4 | private FolderPath of string 5 | 6 | [] 7 | module FolderPath = 8 | open System.IO 9 | 10 | let create path = 11 | if Directory.Exists path 12 | then Some (FolderPath path) 13 | else None 14 | 15 | let path (FolderPath p) = p 16 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/Icons.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.Icons 2 | 3 | type IconColor = 4 | | Enabled 5 | | Disabled 6 | 7 | type IconShape = 8 | | CloseCircle 9 | | ArrowLeftCircle 10 | 11 | [] 12 | module Icons = 13 | open Avalonia.Controls 14 | open Avalonia.Controls.Shapes 15 | open Avalonia.FuncUI.DSL 16 | 17 | let private iconCanvas (color: string) (path: string) = 18 | Canvas.create [ 19 | Canvas.width 24.0 20 | Canvas.height 24.0 21 | Canvas.children [ 22 | Path.create [ 23 | Path.fill color 24 | Path.data path 25 | ] 26 | ] 27 | ] 28 | 29 | let create color path = 30 | let hexColor = 31 | match color with 32 | | Enabled -> "#fff" 33 | | Disabled -> "#9c9c9c" 34 | let svgPath = 35 | match path with 36 | | CloseCircle -> "M12,2C17.53,2 22,6.47 22,12C22,17.53 17.53,22 12,22C6.47,22 2,17.53 2,12C2,6.47 6.47,2 12,2M15.59,7L12,10.59L8.41,7L7,8.41L10.59,12L7,15.59L8.41,17L12,13.41L15.59,17L17,15.59L13.41,12L17,8.41L15.59,7Z" 37 | | ArrowLeftCircle -> "M2,12A10,10 0 0,1 12,2A10,10 0 0,1 22,12A10,10 0 0,1 12,22A10,10 0 0,1 2,12M18,11H10L13.5,7.5L12.08,6.08L6.16,12L12.08,17.92L13.5,16.5L10,13H18V11Z" 38 | 39 | iconCanvas hexColor svgPath 40 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/MainUI.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.MainUI 2 | 3 | open Avalonia 4 | open Elmish 5 | open Avalonia.Layout 6 | open Avalonia.Controls 7 | open Avalonia.FuncUI.DSL 8 | open Avalonia.FuncUI.Types 9 | 10 | open Debounce 11 | open Icons 12 | open Styles 13 | open FolderPath 14 | open DiskItem 15 | open TreeMapView 16 | open SizeView 17 | 18 | type AsyncDiskItem = 19 | | NotLoaded 20 | | Loading of FolderPath 21 | | Loaded of DiskItemNavigation 22 | 23 | type Model = 24 | { window: Window 25 | windowBounds: Rect 26 | asyncDiskItem : AsyncDiskItem } 27 | 28 | let init window _ = 29 | { window = window 30 | windowBounds = window.Bounds 31 | asyncDiskItem = NotLoaded }, Cmd.none 32 | 33 | type Msg = 34 | | OpenFolderSelectDialog 35 | | SelectFolder of FolderPath 36 | | NowLoading of FolderPath 37 | | FinishLoading of DiskItem 38 | | CloseFolder 39 | | NavigateTo of DiskItemNavigation 40 | | NavigateUp 41 | | UpdateWindowBounds of Rect 42 | 43 | [] 44 | module private Navigate = 45 | let mutable private state = Debounce.init 200 46 | 47 | let private debounce f = 48 | state <- Debounce.invoke f state 49 | 50 | let toItem nav dispatch = 51 | fun _ -> dispatch (NavigateTo nav) 52 | |> debounce 53 | 54 | let up dispatch = 55 | fun _ -> dispatch NavigateUp 56 | |> debounce 57 | 58 | module Subscriptions = 59 | let mutable private dispatch = fun _ -> () 60 | let mutable private notifyLoadingDebounce = Debounce.init 100 61 | 62 | let registerDispatch d = 63 | dispatch <- d 64 | 65 | let windowBoundsChanged newBounds = 66 | dispatch (UpdateWindowBounds newBounds) 67 | 68 | let notifyLoading folderPath = 69 | let f = fun _ -> dispatch (NowLoading folderPath) 70 | notifyLoadingDebounce <- Debounce.invoke f notifyLoadingDebounce 71 | 72 | let subscribe model: Cmd = 73 | Cmd.ofSub Subscriptions.registerDispatch 74 | 75 | let private selectFolderAsync window = 76 | let dialog = OpenFolderDialog () 77 | dialog.Title <- "Select Folder" 78 | 79 | let dialogTask = dialog.ShowAsync(window) 80 | 81 | async { 82 | let! folderPath = dialogTask |> Async.AwaitTask 83 | 84 | let msg = 85 | folderPath 86 | |> FolderPath.create 87 | |> Option.map SelectFolder 88 | |> Option.defaultValue CloseFolder 89 | 90 | return msg 91 | } 92 | 93 | let private loadFolderUsageAsync path = 94 | async { 95 | let timer = System.Diagnostics.Stopwatch() 96 | timer.Start() 97 | 98 | let! usage = DiskItem.loadAsync Subscriptions.notifyLoading path 99 | 100 | timer.Stop() 101 | printfn $"Finished loading in %d{timer.ElapsedMilliseconds}ms" 102 | 103 | return FinishLoading usage 104 | } 105 | 106 | let private asyncCmd = Cmd.OfAsync.result 107 | 108 | let private navigateUp (model: Model) = 109 | match model.asyncDiskItem with 110 | | Loaded nav -> 111 | match nav.parent with 112 | | Some parent -> { model with asyncDiskItem = Loaded parent } 113 | | None -> model 114 | | _ -> model 115 | 116 | let private navigateToItem nav (model: Model) = 117 | { model with asyncDiskItem = Loaded nav } 118 | 119 | let update (msg: Msg) (model: Model) : Model * Cmd = 120 | match msg with 121 | | OpenFolderSelectDialog -> 122 | model, asyncCmd (selectFolderAsync model.window) 123 | | SelectFolder path -> 124 | { model with asyncDiskItem = Loading path }, asyncCmd (loadFolderUsageAsync path) 125 | | NowLoading path -> 126 | { model with asyncDiskItem = Loading path }, Cmd.none 127 | | FinishLoading diskItem -> 128 | let loadedItem = Loaded { diskItem = diskItem; parent = None } 129 | { model with asyncDiskItem = loadedItem }, Cmd.none 130 | | CloseFolder -> 131 | { model with asyncDiskItem = NotLoaded }, Cmd.none 132 | | NavigateTo diskItem -> 133 | navigateToItem diskItem model, Cmd.none 134 | | NavigateUp -> 135 | navigateUp model, Cmd.none 136 | | UpdateWindowBounds newBounds -> 137 | { model with windowBounds = newBounds }, Cmd.none 138 | 139 | let private notLoadedView dispatch = 140 | Grid.main [ 141 | Grid.children [ 142 | TextBlock.title "Disk Space Usage" [ 143 | Grid.row 0 144 | ] 145 | TextBlock.subTitle "No folder selected" [ 146 | Grid.row 1 147 | ] 148 | Button.create [ 149 | Grid.row 2 150 | Button.onClick (fun _ -> dispatch OpenFolderSelectDialog) 151 | Button.content "Select Folder" 152 | Button.horizontalAlignment HorizontalAlignment.Center 153 | Button.maxWidth 250.0 154 | Button.margin (50.0, 0.0) 155 | ] 156 | ] 157 | ] 158 | 159 | let private loadingView folderPath dispatch = 160 | Grid.main [ 161 | Grid.children [ 162 | TextBlock.title "Loading..." [ 163 | Grid.row 0 164 | ] 165 | TextBlock.subTitle (FolderPath.path folderPath) [ 166 | Grid.row 1 167 | ] 168 | ] 169 | ] 170 | 171 | let private folderView model (nav: DiskItemNavigation) (children: DiskItem list) dispatch = 172 | let windowBounds = model.window.Bounds 173 | 174 | let treeSize = 175 | { width = windowBounds.Width - 100.0 176 | height = Grid.resizableRowHeight windowBounds.Height |> double } 177 | 178 | let childNav c = { diskItem = c; parent = Some nav } 179 | 180 | let treeViewConfig: TreeMapView.Config = 181 | { children = children |> List.map childNav 182 | size = treeSize 183 | onItemSelected = fun nav -> Navigate.toItem nav dispatch } 184 | 185 | TreeMapView.create treeViewConfig [ 186 | Grid.row 3 187 | ] 188 | 189 | let private fileView diskItem dispatch = 190 | TextBlock.create [ 191 | Grid.row 3 192 | TextBlock.text "file" 193 | ] :> IView 194 | 195 | let private itemView model (nav: DiskItemNavigation) dispatch = 196 | match nav.diskItem.itemType with 197 | | File -> fileView nav dispatch 198 | | Folder attrs -> folderView model nav attrs.children dispatch 199 | 200 | let private upButtonView parent dispatch attrs = 201 | let (enabled, color) = 202 | parent 203 | |> Option.map (fun _ -> true, Enabled) 204 | |> Option.defaultValue (false, Disabled) 205 | 206 | let defaults = [ 207 | Button.verticalAlignment VerticalAlignment.Center 208 | Button.onClick (fun _ -> Navigate.up dispatch) 209 | Button.isEnabled enabled 210 | ] 211 | Button.icon color ArrowLeftCircle (defaults @ attrs) 212 | 213 | let rec navItemParents firstParent = 214 | match firstParent with 215 | | Some parent -> (navItemParents parent.parent) @ [ parent ] 216 | | None -> [] 217 | 218 | let private breadcrumbsView dispatch nav = 219 | let parentsButtons = 220 | navItemParents nav.parent 221 | |> List.map (fun p -> 222 | Button.create [ 223 | Button.content p.diskItem.name 224 | Button.onTapped ((fun _ -> dispatch (NavigateTo p)), OnChangeOf p) 225 | ] :> IView 226 | ) 227 | 228 | let children = parentsButtons @ [ 229 | Button.create [ 230 | Button.content nav.diskItem.name 231 | Button.isEnabled false 232 | ] 233 | ] 234 | 235 | StackPanel.create [ 236 | DockPanel.dock Dock.Right 237 | StackPanel.horizontalAlignment HorizontalAlignment.Center 238 | StackPanel.orientation Orientation.Horizontal 239 | StackPanel.children children 240 | ] 241 | 242 | let private emptyView = 243 | TextBlock.create [ 244 | DockPanel.dock Dock.Right 245 | ] :> IView 246 | 247 | let navBar nav dispatch = 248 | let upButton = 249 | upButtonView nav.parent dispatch [ 250 | DockPanel.dock Dock.Left 251 | ] 252 | 253 | let breadCrumbs = 254 | breadcrumbsView dispatch nav 255 | 256 | let closeButton = 257 | Button.navBarIcon Enabled CloseCircle [ 258 | DockPanel.dock Dock.Right 259 | Button.horizontalAlignment HorizontalAlignment.Right 260 | Button.onClick (fun _ -> dispatch CloseFolder) 261 | ] 262 | 263 | DockPanel.create [ 264 | Grid.row 2 265 | DockPanel.children [ 266 | upButton 267 | closeButton 268 | breadCrumbs 269 | ] 270 | ] 271 | 272 | let private loadedView model (nav: DiskItemNavigation) dispatch = 273 | let sizeText = SizeView.text nav.diskItem.size 274 | 275 | Grid.main [ 276 | Grid.children [ 277 | TextBlock.title sizeText [ 278 | Grid.row 0 279 | ] 280 | TextBlock.subTitle nav.diskItem.name [ 281 | Grid.row 1 282 | ] 283 | navBar nav dispatch 284 | itemView model nav dispatch 285 | ] 286 | ] 287 | 288 | let view (model: Model) (dispatch: Dispatch) = 289 | match model.asyncDiskItem with 290 | | NotLoaded -> notLoadedView dispatch 291 | | Loading path -> loadingView path dispatch 292 | | Loaded nav -> loadedView model nav dispatch 293 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/Program.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.Program 2 | 3 | open Avalonia.Controls 4 | open Avalonia.Media 5 | open Avalonia.Platform 6 | open Elmish 7 | open Avalonia 8 | open Avalonia.Controls.ApplicationLifetimes 9 | open Avalonia.FuncUI 10 | open Avalonia.FuncUI.Elmish 11 | open Avalonia.FuncUI.Components.Hosts 12 | 13 | type MainWindow() as this = 14 | inherit HostWindow() 15 | do 16 | base.Title <- "Disk Space Usage" 17 | base.Width <- 1200.0 18 | base.Height <- 800.0 19 | base.ExtendClientAreaToDecorationsHint <- true 20 | base.TransparencyLevelHint <- WindowTransparencyLevel.AcrylicBlur 21 | base.ExtendClientAreaChromeHints <- ExtendClientAreaChromeHints.PreferSystemChrome 22 | base.Background <- Brush.Parse("#b333") 23 | 24 | ((MainUI.init this), MainUI.update, MainUI.view) 25 | |||> Elmish.Program.mkProgram 26 | |> Program.withSubscription MainUI.subscribe 27 | |> Program.withHost this 28 | |> Program.run 29 | 30 | this 31 | .GetPropertyChangedObservable(Controls.TopLevel.BoundsProperty) 32 | .Subscribe(fun _ -> MainUI.Subscriptions.windowBoundsChanged this.Bounds) 33 | |> ignore 34 | 35 | type App() = 36 | inherit Application() 37 | 38 | override this.Initialize() = 39 | this.Styles.Load "avares://Avalonia.Themes.Fluent/FluentDark.xaml" 40 | this.Styles.Load "avares://disk-space-usage-app/Styles.xaml" 41 | 42 | override this.OnFrameworkInitializationCompleted() = 43 | match this.ApplicationLifetime with 44 | | :? IClassicDesktopStyleApplicationLifetime as desktopLifetime -> 45 | desktopLifetime.MainWindow <- MainWindow() 46 | | _ -> () 47 | 48 | module Program = 49 | 50 | [] 51 | let main(args: string[]) = 52 | AppBuilder 53 | .Configure() 54 | .UsePlatformDetect() 55 | .UseSkia() 56 | .StartWithClassicDesktopLifetime(args) 57 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/SizeView.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.SizeView 2 | 3 | open DiskItem 4 | 5 | [] 6 | module SizeView = 7 | let private tryUnit bytesPerUnit size = 8 | match size with 9 | | Unknown -> None 10 | | Bytes bytes -> 11 | let floatBytes = float bytes 12 | 13 | if floatBytes > bytesPerUnit 14 | then Some (floatBytes / bytesPerUnit) 15 | else None 16 | 17 | let private (|Gigabytes|_|) size = 18 | tryUnit (1024.0 ** 3.0) size 19 | 20 | let private (|Megabytes|_|) size = 21 | tryUnit (1024.0 ** 2.0) size 22 | 23 | let private (|Kilobytes|_|) size = 24 | tryUnit 1024.0 size 25 | 26 | let text size = 27 | match size with 28 | | Gigabytes value -> $"%.1f{value} GB" 29 | | Megabytes value -> $"%.1f{value} MB" 30 | | Kilobytes value -> $"%.1f{value} KB" 31 | | Bytes value -> $"%d{value} B" 32 | | Unknown -> "Unknown" 33 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/Styles.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.Styles 2 | 3 | open Avalonia.Controls 4 | open Avalonia.FuncUI.DSL 5 | open Avalonia.FuncUI.Types 6 | open Avalonia.Layout 7 | 8 | open Icons 9 | 10 | [] 11 | module Button = 12 | let icon color shape attrs: IView = 13 | let defaults = [ 14 | Button.content (Icons.create color shape ) 15 | Button.classes ["icon"] 16 | ] 17 | Button.create (defaults @ attrs) :> IView 18 | 19 | let navBarIcon color shape attrs = 20 | let defaults = [ 21 | Button.verticalAlignment VerticalAlignment.Center 22 | ] 23 | icon color shape (defaults @ attrs) 24 | 25 | [] 26 | module Grid = 27 | let main attrs: IView = 28 | let defaults = [ 29 | Grid.columnDefinitions "*" 30 | Grid.rowDefinitions "80, 80, 80, *, 80" 31 | ] 32 | Grid.create (defaults @ attrs) :> IView 33 | 34 | let resizableRowHeight windowHeight = 35 | windowHeight - 80.0 * 4.0 36 | 37 | [] 38 | module TextBlock = 39 | let title text attrs: IView = 40 | let defaults = [ 41 | TextBlock.classes ["title"] 42 | TextBlock.text text 43 | ] 44 | TextBlock.create (defaults @ attrs) :> IView 45 | 46 | let subTitle text attrs: IView = 47 | let defaults = [ 48 | TextBlock.classes ["subTitle"] 49 | TextBlock.text text 50 | ] 51 | TextBlock.create (defaults @ attrs) :> IView 52 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/Time.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.Time 2 | 3 | type Posix = 4 | Posix of milliseconds: int64 5 | 6 | [] 7 | module Posix = 8 | open System 9 | let fromDateTimeOffset (d: DateTimeOffset) = Posix (d.ToUnixTimeMilliseconds()) 10 | let now () = fromDateTimeOffset DateTimeOffset.Now 11 | let milliseconds (Posix m) = m 12 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/TreeMap.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.TreeMap 2 | 3 | type BinaryTree<'a> = 4 | | Leaf of Leaf<'a> 5 | | Branch of Branch<'a> 6 | and Leaf<'a> = 7 | { data: 'a 8 | weight: int64 } 9 | and Branch<'a> = 10 | { left: BinaryTree<'a> 11 | right: BinaryTree<'a> } 12 | 13 | type TreeMap<'a> = 14 | private TreeMap of root:BinaryTree<'a> 15 | 16 | [] 17 | module TreeMap = 18 | 19 | let root (TreeMap root) = root 20 | 21 | let rec weight tree = 22 | match tree with 23 | | Leaf leaf -> leaf.weight 24 | | Branch branch -> (weight branch.left) + (weight branch.right) 25 | 26 | let rec private leafCount tree = 27 | match tree with 28 | | Leaf _ -> 1 29 | | Branch branch -> (leafCount branch.left) + (leafCount branch.right) 30 | 31 | let create (leaves: Leaf<'a> list): TreeMap<'a> option = 32 | let mutable sortedLeaves: BinaryTree<'a> list = 33 | leaves 34 | |> List.sortBy (fun l -> l.weight) 35 | |> List.map Leaf 36 | 37 | let mutable sortedTrees: BinaryTree<'a> list = [] 38 | 39 | let treeIsCompleted () = 40 | match sortedTrees with 41 | | [tree] -> leafCount tree = List.length leaves 42 | | _ -> false 43 | 44 | let takeLightestTree (): BinaryTree<'a> option = 45 | match sortedLeaves, sortedTrees with 46 | | leaf :: remainingLeaves, tree :: remainingTrees -> 47 | if weight leaf < weight tree 48 | then 49 | sortedLeaves <- remainingLeaves 50 | Some leaf 51 | else 52 | sortedTrees <- remainingTrees 53 | Some tree 54 | 55 | | leaf :: remainingLeaves, [] -> 56 | sortedLeaves <- remainingLeaves 57 | Some leaf 58 | 59 | | [], tree :: remainingTrees -> 60 | sortedTrees <- remainingTrees 61 | Some tree 62 | 63 | | [], [] -> 64 | None 65 | 66 | let mutable left: BinaryTree<'a> option = None 67 | 68 | while not (treeIsCompleted ()) do 69 | let lightestTree = takeLightestTree () 70 | 71 | match left, lightestTree with 72 | | None, Some _ -> 73 | left <- lightestTree 74 | | Some leftTree, Some rightTree -> 75 | left <- None 76 | sortedTrees <- sortedTrees @ [ 77 | Branch { left = leftTree; right = rightTree } 78 | ] 79 | | Some leftTree, None -> 80 | left <- None 81 | sortedTrees <- sortedTrees @ [ leftTree ] 82 | | _ -> () 83 | 84 | sortedTrees 85 | |> List.tryHead 86 | |> Option.map TreeMap 87 | -------------------------------------------------------------------------------- /disk-space-usage-app/DiskSpaceUsage/TreeMapView.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsage.TreeMapView 2 | 3 | open Avalonia.Layout 4 | open Avalonia.Media 5 | open Avalonia.Controls 6 | open Avalonia.FuncUI.DSL 7 | open Avalonia.FuncUI.Types 8 | 9 | open TreeMap 10 | open DiskItem 11 | open SizeView 12 | open Styles 13 | 14 | module private Backgrounds = 15 | let private all = [ "#844"; "#484"; "#448"; "#488"; "#848" ] 16 | let mutable private cursor = 0 17 | 18 | let reset () = 19 | cursor <- 0 20 | 21 | let next () = 22 | let next = List.item cursor all 23 | let total = List.length all 24 | cursor <- (cursor + 1) % total 25 | next 26 | 27 | type Size = { width: double; height: double } 28 | type Offset = { top: double; left: double } 29 | 30 | [] 31 | module Canvas = 32 | let make offset size attrs = 33 | let defaults = [ 34 | Canvas.left offset.left 35 | Canvas.top offset.top 36 | Canvas.width size.width 37 | Canvas.height size.height 38 | ] 39 | Canvas.create (defaults @ attrs) 40 | 41 | type DiskItemNavigation = 42 | { diskItem: DiskItem 43 | parent: DiskItemNavigation option } 44 | 45 | [] 46 | module rec TreeMapView = 47 | 48 | type Config = 49 | { children: DiskItemNavigation list 50 | size: Size 51 | onItemSelected: DiskItemNavigation -> unit } 52 | 53 | let private noOffset = { top = 0.0; left = 0.0 } 54 | let private leafPadding = 2.0 55 | let private leafRectangleColor = "#6fff" 56 | 57 | let private leafView (depth: int) (leaf: Leaf) (config: Config): IView list = 58 | let size = config.size 59 | let titleOffset = noOffset 60 | let titleSize = { width = size.width; height = 20.0 } 61 | let leafOffset = { top = titleSize.height; left = leafPadding } 62 | let leafSize = { width = size.width - leafPadding * 2.0; height = size.height - titleSize.height - leafPadding } 63 | 64 | let diskItem = leaf.data.diskItem 65 | 66 | let topBar = 67 | DockPanel.create [ 68 | DockPanel.width titleSize.width 69 | DockPanel.height titleSize.height 70 | DockPanel.children [ 71 | TextBlock.create [ DockPanel.dock Dock.Right 72 | TextBlock.verticalAlignment VerticalAlignment.Center 73 | TextBlock.margin (4.0, 0.0) 74 | TextBlock.text (SizeView.text diskItem.size) ] 75 | TextBlock.create [ DockPanel.dock Dock.Left 76 | TextBlock.verticalAlignment VerticalAlignment.Center 77 | TextBlock.margin (4.0, 0.0) 78 | TextBlock.textTrimming TextTrimming.CharacterEllipsis 79 | TextBlock.text diskItem.name ] 80 | ] 81 | ] 82 | 83 | let topBarButton = 84 | Button.create [ 85 | Canvas.top titleOffset.top 86 | Canvas.left titleOffset.left 87 | Button.width titleSize.width 88 | Button.height titleSize.height 89 | Button.onTapped ((fun _ -> config.onItemSelected leaf.data), OnChangeOf leaf.data) 90 | Button.classes ["topBar"] 91 | Button.content topBar 92 | ] 93 | 94 | let rectangleView children = 95 | Canvas.make leafOffset leafSize 96 | [ Canvas.background leafRectangleColor 97 | Canvas.children children ] 98 | 99 | let childrenViews = 100 | match diskItem.itemType with 101 | | File -> [] 102 | | Folder attrs -> 103 | if depth >= 2 104 | then [] 105 | else 106 | let childrenInset = 16.0 107 | let childrenOffset = { top = childrenInset; left = childrenInset } 108 | let childrenSize = { width = leafSize.width - childrenInset * 2.0 109 | height = leafSize.height - childrenInset * 2.0 } 110 | 111 | let childNav c = { diskItem = c; parent = Some leaf.data } 112 | let children = attrs.children |> List.map childNav 113 | 114 | let childrenConfig = { config with size = childrenSize; children = children } 115 | 116 | [ createWithDepth (depth + 1) childrenConfig [ 117 | Canvas.top childrenOffset.top 118 | Canvas.left childrenOffset.left 119 | ] ] 120 | 121 | [ Canvas.make noOffset size [ 122 | Canvas.background (Backgrounds.next()) 123 | Canvas.children [ topBarButton; rectangleView childrenViews ] 124 | ] ] 125 | 126 | let branchView depth (branch: Branch) (config: Config): IView list = 127 | let size = config.size 128 | let leftWeight = TreeMap.weight branch.left |> double 129 | let rightWeight = TreeMap.weight branch.right |> double 130 | let leftRatio = leftWeight / (leftWeight + rightWeight) 131 | 132 | let leftSize, rightSize, rightOffset = 133 | if size.width > size.height 134 | then 135 | let leftWidth = size.width * leftRatio 136 | ({ width = leftWidth; height = size.height }, 137 | { width = size.width - leftWidth; height = size.height }, 138 | { top = 0.0; left = leftWidth }) 139 | else 140 | let leftHeight = size.height * leftRatio 141 | ({ width = size.width; height = leftHeight }, 142 | { width = size.width; height = size.height - leftHeight }, 143 | { top = leftHeight; left = 0.0 }) 144 | 145 | let createBranch tree offset size = 146 | Canvas.make offset size [ 147 | Canvas.children (createTree depth tree { config with size = size }) 148 | ] 149 | 150 | [ createBranch branch.left { top = 0.0; left = 0.0 } leftSize 151 | createBranch branch.right rightOffset rightSize ] 152 | 153 | let private minSize = { width = 75.0; height = 25.0 } 154 | 155 | let private emptyView config = 156 | let childSize = { width = config.size.width - leafPadding * 2.0 157 | height = config.size.height - leafPadding * 2.0 } 158 | let childOffset = { top = leafPadding 159 | left = leafPadding } 160 | 161 | Canvas.make noOffset config.size [ 162 | Canvas.background (Backgrounds.next()) 163 | Canvas.children [ 164 | Canvas.make childOffset childSize [ 165 | Canvas.background leafRectangleColor 166 | ] 167 | ] 168 | ] 169 | 170 | let private createTree (depth: int) (tree: BinaryTree) (config: Config): IView list = 171 | if config.size.width >= minSize.width && config.size.height >= minSize.height 172 | then 173 | match tree with 174 | | Leaf leaf -> leafView depth leaf config 175 | | Branch branch -> branchView depth branch config 176 | else 177 | [ emptyView config ] 178 | 179 | let private toLeaf nav = 180 | nav.diskItem 181 | |> DiskItem.sizeInBytes 182 | |> Option.map (fun size -> { data = nav; weight = size }) 183 | 184 | let createWithDepth depth config attrs: IView = 185 | let leaves = 186 | config.children 187 | |> List.choose toLeaf 188 | |> List.filter (fun leaf -> leaf.weight > int64 0) 189 | 190 | let childViews = 191 | leaves 192 | |> TreeMap.create 193 | |> Option.map TreeMap.root 194 | |> Option.map (fun root -> createTree depth root config) 195 | |> Option.defaultValue [] 196 | 197 | let defaults = [ Canvas.width config.size.width 198 | Canvas.height config.size.height 199 | Canvas.children childViews ] 200 | 201 | Canvas.create (defaults @ attrs) :> IView 202 | 203 | let create config attrs: IView = 204 | Backgrounds.reset () 205 | createWithDepth 0 config attrs 206 | -------------------------------------------------------------------------------- /disk-space-usage-app/Styles.xaml: -------------------------------------------------------------------------------- 1 |  2 | 5 | 6 | 11 | 12 | 17 | 18 | 23 | 26 | 29 | 30 | 33 | 34 | 41 | 42 | 47 | 50 | 54 | 59 | 62 | 63 | -------------------------------------------------------------------------------- /disk-space-usage-app/disk-space-usage-app.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Exe 5 | net5.0 6 | 7 | true 8 | true 9 | 10 | true 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /disk-space-usage-tests/DiskSpacesUsageTests/Program.fs: -------------------------------------------------------------------------------- 1 | module Program 2 | 3 | open FsUnit 4 | 5 | type InitMsgUtils() = 6 | inherit FSharpCustomMessageFormatter() 7 | 8 | let [] main _ = 0 9 | -------------------------------------------------------------------------------- /disk-space-usage-tests/DiskSpacesUsageTests/TreeMap.fs: -------------------------------------------------------------------------------- 1 | module DiskSpaceUsageTests.TreeMap 2 | 3 | open NUnit.Framework 4 | open FsUnit 5 | 6 | open DiskSpaceUsage.TreeMap 7 | 8 | let private leaf data weight = { data = data; weight = int64 weight } 9 | let private leafNode data weight = Leaf (leaf data weight) 10 | let private branchNode left right = Branch { left = left; right = right } 11 | 12 | [] 13 | let ``building a simple tree map`` () = 14 | let leaves: Leaf list = [ 15 | leaf "File A" 9 16 | leaf "File C" 11 17 | leaf "File B" 10 18 | leaf "File E" 30 19 | leaf "File D" 15 20 | ] 21 | 22 | let tree = TreeMap.create leaves 23 | 24 | let expectedTree = 25 | branchNode 26 | (leafNode "File E" 30) 27 | (branchNode 28 | (branchNode 29 | (leafNode "File A" 9) 30 | (leafNode "File B" 10) 31 | ) 32 | (branchNode 33 | (leafNode "File C" 11) 34 | (leafNode "File D" 15) 35 | ) 36 | ) 37 | 38 | tree |> Option.map TreeMap.root |> should equal (Some expectedTree) 39 | 40 | [] 41 | let ``building a tree map with a single leaf`` () = 42 | let leaves = [ leaf "File A" 9 ] 43 | 44 | let tree = TreeMap.create leaves 45 | 46 | let expectedTree = (leafNode "File A" 9) 47 | 48 | tree |> Option.map TreeMap.root |> should equal (Some expectedTree) 49 | -------------------------------------------------------------------------------- /disk-space-usage-tests/disk-space-usage-tests.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net5.0 5 | disk_space_usage_tests 6 | 7 | false 8 | false 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /disk-space-usage.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 16 4 | VisualStudioVersion = 16.6.30114.105 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "disk-space-usage-app", "disk-space-usage-app\disk-space-usage-app.fsproj", "{74027B16-EA46-42DF-B323-917987995AD6}" 7 | EndProject 8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "disk-space-usage-tests", "disk-space-usage-tests\disk-space-usage-tests.fsproj", "{914D69FD-5358-4DB4-8355-05D61BD98BE0}" 9 | EndProject 10 | Global 11 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 12 | Debug|Any CPU = Debug|Any CPU 13 | Debug|x64 = Debug|x64 14 | Debug|x86 = Debug|x86 15 | Release|Any CPU = Release|Any CPU 16 | Release|x64 = Release|x64 17 | Release|x86 = Release|x86 18 | EndGlobalSection 19 | GlobalSection(SolutionProperties) = preSolution 20 | HideSolutionNode = FALSE 21 | EndGlobalSection 22 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 23 | {74027B16-EA46-42DF-B323-917987995AD6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 24 | {74027B16-EA46-42DF-B323-917987995AD6}.Debug|Any CPU.Build.0 = Debug|Any CPU 25 | {74027B16-EA46-42DF-B323-917987995AD6}.Debug|x64.ActiveCfg = Debug|Any CPU 26 | {74027B16-EA46-42DF-B323-917987995AD6}.Debug|x64.Build.0 = Debug|Any CPU 27 | {74027B16-EA46-42DF-B323-917987995AD6}.Debug|x86.ActiveCfg = Debug|Any CPU 28 | {74027B16-EA46-42DF-B323-917987995AD6}.Debug|x86.Build.0 = Debug|Any CPU 29 | {74027B16-EA46-42DF-B323-917987995AD6}.Release|Any CPU.ActiveCfg = Release|Any CPU 30 | {74027B16-EA46-42DF-B323-917987995AD6}.Release|Any CPU.Build.0 = Release|Any CPU 31 | {74027B16-EA46-42DF-B323-917987995AD6}.Release|x64.ActiveCfg = Release|Any CPU 32 | {74027B16-EA46-42DF-B323-917987995AD6}.Release|x64.Build.0 = Release|Any CPU 33 | {74027B16-EA46-42DF-B323-917987995AD6}.Release|x86.ActiveCfg = Release|Any CPU 34 | {74027B16-EA46-42DF-B323-917987995AD6}.Release|x86.Build.0 = Release|Any CPU 35 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 36 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Debug|Any CPU.Build.0 = Debug|Any CPU 37 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Debug|x64.ActiveCfg = Debug|Any CPU 38 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Debug|x64.Build.0 = Debug|Any CPU 39 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Debug|x86.ActiveCfg = Debug|Any CPU 40 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Debug|x86.Build.0 = Debug|Any CPU 41 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Release|Any CPU.ActiveCfg = Release|Any CPU 42 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Release|Any CPU.Build.0 = Release|Any CPU 43 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Release|x64.ActiveCfg = Release|Any CPU 44 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Release|x64.Build.0 = Release|Any CPU 45 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Release|x86.ActiveCfg = Release|Any CPU 46 | {914D69FD-5358-4DB4-8355-05D61BD98BE0}.Release|x86.Build.0 = Release|Any CPU 47 | EndGlobalSection 48 | EndGlobal 49 | -------------------------------------------------------------------------------- /screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dam5s/disk-space-usage-fsharp/3a8386197de2863edb7d381d9cac25f2f59c6154/screenshot.png --------------------------------------------------------------------------------