├── .gitignore ├── ErrorHandling.fsx ├── Guard.csx ├── Guard.fsx ├── GuardFP.fsx ├── Image.csx ├── JpegDecoder.csx ├── JpegDecoder.fsx ├── JpegDecoderFP.fsx ├── LICENSE.md ├── Member.csx ├── Member.fsx ├── MemberChangeTracker.csx ├── MemberChangeTracker.fsx ├── MemberFP.fsx ├── README.md ├── RefactoringFSharp.fsproj ├── RefactoringFSharp.sln └── TipsAndSmells.fsx /.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | 4 | # User-specific files 5 | *.suo 6 | *.user 7 | *.sln.docstates 8 | 9 | # Build results 10 | 11 | [Dd]ebug/ 12 | [Rr]elease/ 13 | x64/ 14 | build/ 15 | [Bb]in/ 16 | [Oo]bj/ 17 | 18 | # Enable "build/" folder in the NuGet Packages folder since NuGet packages use it for MSBuild targets 19 | !packages/*/build/ 20 | 21 | # MSTest test Results 22 | [Tt]est[Rr]esult*/ 23 | [Bb]uild[Ll]og.* 24 | 25 | *_i.c 26 | *_p.c 27 | *.ilk 28 | *.meta 29 | *.obj 30 | *.pch 31 | *.pdb 32 | *.pgc 33 | *.pgd 34 | *.rsp 35 | *.sbr 36 | *.tlb 37 | *.tli 38 | *.tlh 39 | *.tmp 40 | *.tmp_proj 41 | *.log 42 | *.vspscc 43 | *.vssscc 44 | .builds 45 | *.pidb 46 | *.log 47 | *.scc 48 | 49 | # Visual C++ cache files 50 | ipch/ 51 | *.aps 52 | *.ncb 53 | *.opensdf 54 | *.sdf 55 | *.cachefile 56 | 57 | # Visual Studio profiler 58 | *.psess 59 | *.vsp 60 | *.vspx 61 | 62 | # Guidance Automation Toolkit 63 | *.gpState 64 | 65 | # ReSharper is a .NET coding add-in 66 | _ReSharper*/ 67 | *.[Rr]e[Ss]harper 68 | 69 | # TeamCity is a build add-in 70 | _TeamCity* 71 | 72 | # DotCover is a Code Coverage Tool 73 | *.dotCover 74 | 75 | # NCrunch 76 | *.ncrunch* 77 | .*crunch*.local.xml 78 | 79 | # Installshield output folder 80 | [Ee]xpress/ 81 | 82 | # DocProject is a documentation generator add-in 83 | DocProject/buildhelp/ 84 | DocProject/Help/*.HxT 85 | DocProject/Help/*.HxC 86 | DocProject/Help/*.hhc 87 | DocProject/Help/*.hhk 88 | DocProject/Help/*.hhp 89 | DocProject/Help/Html2 90 | DocProject/Help/html 91 | 92 | # Click-Once directory 93 | publish/ 94 | 95 | # Publish Web Output 96 | *.Publish.xml 97 | *.pubxml 98 | 99 | # NuGet Packages Directory 100 | ## TODO: If you have NuGet Package Restore enabled, uncomment the next line 101 | #packages/ 102 | 103 | # Windows Azure Build Output 104 | csx 105 | *.build.csdef 106 | 107 | # Windows Store app package directory 108 | AppPackages/ 109 | 110 | # Others 111 | sql/ 112 | *.Cache 113 | ClientBin/ 114 | [Ss]tyle[Cc]op.* 115 | ~$* 116 | *~ 117 | *.dbmdl 118 | *.[Pp]ublish.xml 119 | *.pfx 120 | *.publishsettings 121 | 122 | # RIA/Silverlight projects 123 | Generated_Code/ 124 | 125 | # Backup & report files from converting an old project file to a newer 126 | # Visual Studio version. Backup files are not needed, because we have git ;-) 127 | _UpgradeReport_Files/ 128 | Backup*/ 129 | UpgradeLog*.XML 130 | UpgradeLog*.htm 131 | 132 | # SQL Server files 133 | App_Data/*.mdf 134 | App_Data/*.ldf 135 | 136 | # ========================= 137 | # Windows detritus 138 | # ========================= 139 | 140 | # Windows image file caches 141 | Thumbs.db 142 | ehthumbs.db 143 | 144 | # Folder config file 145 | Desktop.ini 146 | 147 | # Recycle Bin used on file shares 148 | $RECYCLE.BIN/ 149 | 150 | # Mac crap 151 | .DS_Store 152 | -------------------------------------------------------------------------------- /ErrorHandling.fsx: -------------------------------------------------------------------------------- 1 | [] 2 | module Result = 3 | (** 4 | 5 | Error handling types and functions 6 | 7 | See fsharpforfunandprofit.com/rop 8 | 9 | **) 10 | 11 | type Result<'success, 'failure> = 12 | | Success of 'success 13 | | Failure of 'failure 14 | 15 | /// Create a success case 16 | let success x = Success x 17 | 18 | /// Create a failure case 19 | let failure x = Failure x 20 | 21 | /// Create a failure case where the failures are expected to be a list (e.g for validation) 22 | let failureList x = Failure [ x ] 23 | 24 | /// Map a function over the success case 25 | let map f result = 26 | match result with 27 | | Success success -> Success(f success) 28 | | Failure msgs -> Failure msgs 29 | 30 | /// Map a function over the failure case 31 | let mapFailure f result = 32 | match result with 33 | | Success success -> Success success 34 | | Failure msgs -> Failure(f msgs) 35 | 36 | /// Map a unit function over the success case 37 | let iter (f : _ -> unit) result = map f result |> ignore 38 | 39 | /// Apply Result function to a Result value 40 | let apply fR xR = 41 | match fR, xR with 42 | | Success f, Success x -> Success(f x) 43 | | Failure msgs1, Success _ -> Failure msgs1 44 | | Success _, Failure msgs2 -> Failure msgs2 45 | | Failure msgs1, Failure msgs2 -> Failure(msgs1 @ msgs2) 46 | 47 | /// Apply a monadic function to a Result value 48 | let bind f result = 49 | match result with 50 | | Success success -> f success 51 | | Failure msgs -> Failure msgs 52 | 53 | /// Lift a two parameter function to use Result parameters 54 | let lift2 f x1 x2 = 55 | let () = map 56 | let (<*>) = apply 57 | f x1 <*> x2 58 | 59 | /// Lift a three parameter function to use Result parameters 60 | let lift3 f x1 x2 x3 = 61 | let () = map 62 | let (<*>) = apply 63 | f x1 <*> x2 <*> x3 64 | 65 | /// Lift a four parameter function to use Result parameters 66 | let lift4 f x1 x2 x3 x4 = 67 | let () = map 68 | let (<*>) = apply 69 | f x1 <*> x2 <*> x3 <*> x4 70 | 71 | /// Apply a monadic two parameter function 72 | let bind2 f x1 x2 = lift2 f x1 x2 |> bind id 73 | 74 | /// Apply a monadic three parameter function 75 | let bind3 f x1 x2 x3 = lift3 f x1 x2 x3 |> bind id 76 | 77 | /// Convert an Option into a Result 78 | let fromOption msg opt = 79 | match opt with 80 | | Some v -> success v 81 | | None -> failure msg 82 | 83 | /// Convert the success case into an Option (useful for List.choose) 84 | let toOption = 85 | function 86 | | Success s -> Some s 87 | | Failure _ -> None 88 | 89 | /// Convert the failure case into an Option (useful for List.choose) 90 | let toFailureOption = 91 | function 92 | | Success _ -> None 93 | | Failure e -> Some e 94 | 95 | /// Predicate that returns true on success 96 | let isSuccess = 97 | function 98 | | Success _ -> true 99 | | Failure _ -> false 100 | 101 | /// Predicate that returns true on failure 102 | let isFailure x = 103 | x 104 | |> isSuccess 105 | |> not 106 | 107 | /// Lift a given predicate into a predicate that works on Results 108 | let filter pred = 109 | function 110 | | Success x -> pred x 111 | | Failure _ -> true 112 | 113 | /// Return a value for the failure case 114 | let ifFailure defaultVal = 115 | function 116 | | Success x -> x 117 | | Failure _ -> defaultVal 118 | 119 | /// Convert a list of Result into a Result using applicative style. 120 | /// All errors will be combined. The error type must be a list. 121 | let sequence resultList = 122 | let cons head tail = head :: tail 123 | let consR = lift2 cons 124 | let initR = success [] 125 | List.foldBack consR resultList initR 126 | 127 | /// Convert a list of Result into a Result using monadic style. 128 | /// Only the first error is returned. The error type need not be a list. 129 | let sequenceM resultList = 130 | let folder result state = 131 | state |> bind (fun list -> 132 | result |> bind (fun element -> 133 | success (element :: list) 134 | )) 135 | let initState = success [] 136 | List.foldBack folder resultList initState 137 | 138 | /// Get the Success value and throw an exception if failure 139 | /// Warning: use only in scripts or testing, not in production! 140 | let successValue = 141 | function 142 | | Success x -> x 143 | | Failure _ -> failwith "Expected Success state" 144 | 145 | /// The `result` computation expression is available globally without qualification 146 | [] 147 | module ResultCE = 148 | // ================================== 149 | // Computation expressions 150 | // ================================== 151 | type ResultBuilder() = 152 | member __.Return(x) = Result.success x 153 | member __.Bind(x, f) = Result.bind f x 154 | 155 | member __.ReturnFrom(x) = x 156 | member this.Zero() = this.Return () 157 | 158 | member __.Delay(f) = f 159 | member __.Run(f) = f() 160 | 161 | member this.While(guard, body) = 162 | if not (guard()) 163 | then this.Zero() 164 | else this.Bind( body(), fun () -> 165 | this.While(guard, body)) 166 | 167 | member this.TryWith(body, handler) = 168 | try this.ReturnFrom(body()) 169 | with e -> handler e 170 | 171 | member this.TryFinally(body, compensation) = 172 | try this.ReturnFrom(body()) 173 | finally compensation() 174 | 175 | member this.Using(disposable:#System.IDisposable, body) = 176 | let body' = fun () -> body disposable 177 | this.TryFinally(body', fun () -> 178 | match disposable with 179 | | null -> () 180 | | disp -> disp.Dispose()) 181 | 182 | member this.For(sequence:seq<_>, body) = 183 | this.Using(sequence.GetEnumerator(),fun enum -> 184 | this.While(enum.MoveNext, 185 | this.Delay(fun () -> body enum.Current))) 186 | 187 | member this.Combine (a,b) = 188 | this.Bind(a, fun () -> b()) 189 | 190 | let result = ResultBuilder() 191 | 192 | -------------------------------------------------------------------------------- /Guard.csx: -------------------------------------------------------------------------------- 1 | // From https://github.com/JimBobSquarePants/ImageProcessor/blob/Core/src/ImageProcessorCore/Common/Helpers/Guard.cs 2 | 3 | // -------------------------------------------------------------------------------------------------------------------- 4 | // 5 | // Copyright (c) James Jackson-South and contributors. 6 | // Licensed under the Apache License, Version 2.0. 7 | // 8 | // 9 | // Provides methods to protect against invalid parameters. 10 | // 11 | // -------------------------------------------------------------------------------------------------------------------- 12 | 13 | using System.Runtime.CompilerServices; 14 | 15 | [assembly: InternalsVisibleTo("ImageProcessorCore.Tests")] 16 | namespace ImageProcessorCore 17 | { 18 | using System; 19 | using System.Diagnostics; 20 | 21 | /// 22 | /// Provides methods to protect against invalid parameters. 23 | /// 24 | [DebuggerStepThrough] 25 | internal static class Guard 26 | { 27 | /// 28 | /// Verifies, that the method parameter with specified object value is not null 29 | /// and throws an exception if it is found to be so. 30 | /// 31 | /// 32 | /// The target object, which cannot be null. 33 | /// 34 | /// 35 | /// The name of the parameter that is to be checked. 36 | /// 37 | /// 38 | /// The error message, if any to add to the exception. 39 | /// 40 | /// 41 | /// is null 42 | /// 43 | public static void NotNull(object target, string parameterName, string message = "") 44 | { 45 | if (target == null) 46 | { 47 | if (string.IsNullOrWhiteSpace(message)) 48 | { 49 | throw new ArgumentNullException(parameterName, message); 50 | } 51 | 52 | throw new ArgumentNullException(parameterName); 53 | } 54 | } 55 | 56 | /// 57 | /// Verifies, that the string method parameter with specified object value and message 58 | /// is not null, not empty and does not contain only blanks and throws an exception 59 | /// if the object is null. 60 | /// 61 | /// The target string, which should be checked against being null or empty. 62 | /// Name of the parameter. 63 | /// 64 | /// is null. 65 | /// 66 | /// 67 | /// is 68 | /// empty or contains only blanks. 69 | /// 70 | public static void NotNullOrEmpty(string target, string parameterName) 71 | { 72 | if (target == null) 73 | { 74 | throw new ArgumentNullException(parameterName); 75 | } 76 | 77 | if (string.IsNullOrWhiteSpace(target)) 78 | { 79 | throw new ArgumentException("Value cannot be null or empty and cannot contain only blanks.", parameterName); 80 | } 81 | } 82 | 83 | /// 84 | /// Verifies that the specified value is less than a maximum value 85 | /// and throws an exception if it is not. 86 | /// 87 | /// The target value, which should be validated. 88 | /// The maximum value. 89 | /// The name of the parameter that is to be checked. 90 | /// The type of the value. 91 | /// 92 | /// is greater than the maximum value. 93 | /// 94 | public static void MustBeLessThan(TValue value, TValue max, string parameterName) 95 | where TValue : IComparable 96 | { 97 | if (value.CompareTo(max) >= 0) 98 | { 99 | throw new ArgumentOutOfRangeException( 100 | parameterName, 101 | $"Value must be less than {max}."); 102 | } 103 | } 104 | 105 | /// 106 | /// Verifies that the specified value is less than or equal to a maximum value 107 | /// and throws an exception if it is not. 108 | /// 109 | /// The target value, which should be validated. 110 | /// The maximum value. 111 | /// The name of the parameter that is to be checked. 112 | /// The type of the value. 113 | /// 114 | /// is greater than the maximum value. 115 | /// 116 | public static void MustBeLessThanOrEqualTo(TValue value, TValue max, string parameterName) 117 | where TValue : IComparable 118 | { 119 | if (value.CompareTo(max) > 0) 120 | { 121 | throw new ArgumentOutOfRangeException( 122 | parameterName, 123 | $"Value must be less than or equal to {max}."); 124 | } 125 | } 126 | 127 | /// 128 | /// Verifies that the specified value is greater than a minimum value 129 | /// and throws an exception if it is not. 130 | /// 131 | /// The target value, which should be validated. 132 | /// The minimum value. 133 | /// The name of the parameter that is to be checked. 134 | /// The type of the value. 135 | /// 136 | /// is less than the minimum value. 137 | /// 138 | public static void MustBeGreaterThan(TValue value, TValue min, string parameterName) 139 | where TValue : IComparable 140 | { 141 | if (value.CompareTo(min) <= 0) 142 | { 143 | throw new ArgumentOutOfRangeException( 144 | parameterName, 145 | $"Value must be greater than {min}."); 146 | } 147 | } 148 | 149 | /// 150 | /// Verifies that the specified value is greater than or equal to a minimum value 151 | /// and throws an exception if it is not. 152 | /// 153 | /// The target value, which should be validated. 154 | /// The minimum value. 155 | /// The name of the parameter that is to be checked. 156 | /// The type of the value. 157 | /// 158 | /// is less than the minimum value. 159 | /// 160 | public static void MustBeGreaterThanOrEqualTo(TValue value, TValue min, string parameterName) 161 | where TValue : IComparable 162 | { 163 | if (value.CompareTo(min) < 0) 164 | { 165 | throw new ArgumentOutOfRangeException( 166 | parameterName, 167 | $"Value must be greater than or equal to {min}."); 168 | } 169 | } 170 | 171 | /// 172 | /// Verifies that the specified value is greater than or equal to a minimum value and less than 173 | /// or equal to a maximum value and throws an exception if it is not. 174 | /// 175 | /// The target value, which should be validated. 176 | /// The minimum value. 177 | /// The maximum value. 178 | /// The name of the parameter that is to be checked. 179 | /// The type of the value. 180 | /// 181 | /// is less than the minimum value of greater than the maximum value. 182 | /// 183 | public static void MustBeBetweenOrEqualTo(TValue value, TValue min, TValue max, string parameterName) 184 | where TValue : IComparable 185 | { 186 | if (value.CompareTo(min) < 0 || value.CompareTo(max) > 0) 187 | { 188 | throw new ArgumentOutOfRangeException( 189 | parameterName, 190 | $"Value must be greater than or equal to {min} and less than or equal to {max}."); 191 | } 192 | } 193 | } 194 | } -------------------------------------------------------------------------------- /Guard.fsx: -------------------------------------------------------------------------------- 1 | // From https://github.com/JimBobSquarePants/ImageProcessor/blob/Core/src/ImageProcessorCore/Common/Helpers/Guard.cs 2 | 3 | open System 4 | open System.Diagnostics 5 | 6 | /// Provides methods to protect against invalid parameters. 7 | type Guard() = 8 | 9 | /// Verifies, that the method parameter with specified object value is not null 10 | /// and throws an exception if it is found to be so. 11 | static member NotNull(target, parameterName, ?message0) = 12 | let message = defaultArg message0 "" 13 | 14 | if (target = null) then 15 | if (String.IsNullOrWhiteSpace(message)) then 16 | raise <| ArgumentNullException(parameterName, message) 17 | raise <| ArgumentNullException(parameterName) 18 | 19 | 20 | 21 | /// Verifies, that the string method parameter with specified object value and message 22 | /// is not null, not empty and does not contain only blanks and throws an exception 23 | /// if the object is null. 24 | static member NotNullOrEmpty(target, parameterName) = 25 | 26 | if (target = null) then 27 | raise <| ArgumentNullException(parameterName) 28 | 29 | if (String.IsNullOrWhiteSpace(target)) then 30 | raise <| ArgumentException("Value cannot be null or empty and cannot contain only blanks.", parameterName) 31 | 32 | 33 | 34 | /// Verifies that the specified value is less than a maximum value 35 | /// and throws an exception if it is not. 36 | static member MustBeLessThan<'TValue when 'TValue :> IComparable<'TValue> >(value:'TValue, max:'TValue, parameterName) = 37 | 38 | if (value.CompareTo(max) >= 0) then 39 | raise <| ArgumentOutOfRangeException( 40 | parameterName, 41 | "Value must be less than max.") 42 | 43 | /// Verifies that the specified value is less than or equal to a maximum value 44 | /// and throws an exception if it is not. 45 | static member MustBeLessThanOrEqualTo<'TValue when 'TValue :> IComparable<'TValue> >(value:'TValue, max:'TValue, parameterName) = 46 | //where TValue : IComparable 47 | 48 | if (value.CompareTo(max) > 0) then 49 | raise <| ArgumentOutOfRangeException( 50 | parameterName, 51 | "Value must be less than or equal to max.") 52 | 53 | 54 | 55 | /// Verifies that the specified value is greater than a minimum value 56 | /// and throws an exception if it is not. 57 | static member MustBeGreaterThan<'TValue when 'TValue :> IComparable<'TValue> >(value:'TValue, min:'TValue, parameterName) = 58 | 59 | if (value.CompareTo(min) <= 0) then 60 | raise <| ArgumentOutOfRangeException( 61 | parameterName, 62 | "Value must be greater than min.") 63 | 64 | 65 | 66 | /// Verifies that the specified value is greater than or equal to a minimum value 67 | /// and throws an exception if it is not. 68 | static member MustBeGreaterThanOrEqualTo<'TValue when 'TValue :> IComparable<'TValue> >(value:'TValue, min:'TValue, parameterName) = 69 | 70 | if (value.CompareTo(min) < 0) then 71 | raise <| ArgumentOutOfRangeException( 72 | parameterName, 73 | "Value must be greater than or equal to min.") 74 | 75 | /// Verifies that the specified value is greater than or equal to a minimum value and less than 76 | /// or equal to a maximum value and throws an exception if it is not. 77 | static member MustBeBetweenOrEqualTo<'TValue when 'TValue :> IComparable<'TValue> >(value:'TValue, min:'TValue, max:'TValue, parameterName) = 78 | 79 | if (value.CompareTo(min) < 0 || value.CompareTo(max) > 0) then 80 | raise <| ArgumentOutOfRangeException( 81 | parameterName, 82 | "Value must be greater than or equal to min and less than or equal to max.") 83 | 84 | 85 | 86 | -------------------------------------------------------------------------------- /GuardFP.fsx: -------------------------------------------------------------------------------- 1 | // From https://github.com/JimBobSquarePants/ImageProcessor/blob/Core/src/ImageProcessorCore/Common/Helpers/Guard.cs 2 | 3 | open System 4 | open System.Diagnostics 5 | 6 | /// Provides methods to protect against invalid parameters. 7 | module Guard = 8 | 9 | /// Verifies, that the method parameter with specified object value is not null 10 | /// and throws an exception if it is found to be so. 11 | let notNull(target, parameterName) = 12 | if (target = null) then 13 | nullArg parameterName 14 | 15 | let notNullWithMessage(target, parameterName, message) = 16 | if (target = null) then 17 | if (String.IsNullOrWhiteSpace(message)) then 18 | raise <| ArgumentNullException(parameterName,message) 19 | else 20 | nullArg parameterName 21 | 22 | let (|IsNullOrWhiteSpace|_|) str = 23 | if String.IsNullOrWhiteSpace(str) then 24 | Some IsNullOrWhiteSpace 25 | else 26 | None 27 | 28 | /// Verifies, that the string method parameter with specified object value and message 29 | /// is not null, not empty and does not contain only blanks and throws an exception 30 | /// if the object is null. 31 | let notNullOrEmpty(target, parameterName) = 32 | match target with 33 | | null -> 34 | nullArg parameterName 35 | | IsNullOrWhiteSpace -> 36 | invalidArg parameterName "Value cannot be null or empty and cannot contain only blanks." 37 | | _ -> 38 | () // value is OK 39 | 40 | let rangeCheck predicate message value parameterName= 41 | if predicate value then 42 | raise <| ArgumentOutOfRangeException(paramName=parameterName, message=message) 43 | 44 | /// Verifies that the specified value is less than a maximum value 45 | /// and throws an exception if it is not. 46 | let mustBeLessThan max parameterName = 47 | let predicate (value:#IComparable) = 48 | value.CompareTo(max) >= 0 49 | let message = sprintf "Value must be less than %O." max 50 | rangeCheck predicate message 51 | 52 | /// Verifies that the specified value is less than or equal to a maximum value 53 | /// and throws an exception if it is not. 54 | let mustBeLessThanOrEqualTo max parameterName = 55 | let predicate (value:#IComparable) = 56 | value.CompareTo(max) > 0 57 | let message = sprintf "Value must be less than or equal to %O." max 58 | rangeCheck predicate message 59 | 60 | /// Verifies that the specified value is greater than a minimum value 61 | /// and throws an exception if it is not. 62 | let mustBeGreaterThan min parameterName = 63 | let predicate (value:#IComparable) = 64 | value.CompareTo(min) <= 0 65 | let message = sprintf "Value must be greater than %O." min 66 | rangeCheck predicate message 67 | 68 | /// Verifies that the specified value is greater than or equal to a minimum value 69 | /// and throws an exception if it is not. 70 | let mustBeGreaterThanOrEqualTo min parameterName = 71 | let predicate (value:#IComparable) = 72 | value.CompareTo(min) < 0 73 | let message = sprintf "Value must be greater than or equal to %O." min 74 | rangeCheck predicate message 75 | 76 | /// Verifies that the specified value is greater than or equal to a minimum value and less than 77 | /// or equal to a maximum value and throws an exception if it is not. 78 | let mustBeBetweenOrEqualTo min max parameterName = 79 | let predicate (value:#IComparable) = 80 | value.CompareTo(min) < 0 || value.CompareTo(max) > 0 81 | let message = sprintf "Value must be greater than or equal to %O and less than or equal to %O." min max 82 | rangeCheck predicate message 83 | 84 | 85 | 86 | 87 | -------------------------------------------------------------------------------- /Image.csx: -------------------------------------------------------------------------------- 1 | // from https://github.com/JimBobSquarePants/ImageProcessor/blob/Core/src/ImageProcessorCore/Image.cs 2 | 3 | // 4 | // Copyright (c) James Jackson-South and contributors. 5 | // Licensed under the Apache License, Version 2.0. 6 | // 7 | 8 | namespace ImageProcessorCore 9 | { 10 | using System; 11 | using System.Collections.Generic; 12 | using System.Diagnostics; 13 | using System.IO; 14 | using System.Linq; 15 | using System.Text; 16 | 17 | using Formats; 18 | 19 | /// 20 | /// Encapsulates an image, which consists of the pixel data for a graphics image and its attributes. 21 | /// 22 | /// 23 | /// The image data is always stored in BGRA format, where the blue, green, red, and 24 | /// alpha values are simple bytes. 25 | /// 26 | [DebuggerDisplay("Image: {Width}x{Height}")] 27 | public class Image : ImageBase, IImage 28 | { 29 | /// 30 | /// The default horizontal resolution value (dots per inch) in x direction. 31 | /// The default value is 96 dots per inch. 32 | /// 33 | public const double DefaultHorizontalResolution = 96; 34 | 35 | /// 36 | /// The default vertical resolution value (dots per inch) in y direction. 37 | /// The default value is 96 dots per inch. 38 | /// 39 | public const double DefaultVerticalResolution = 96; 40 | 41 | /// 42 | /// The default collection of . 43 | /// 44 | private static readonly Lazy> DefaultFormats = 45 | new Lazy>(() => new List 46 | { 47 | new BmpFormat(), 48 | new JpegFormat(), 49 | new PngFormat(), 50 | new GifFormat(), 51 | }); 52 | 53 | /// 54 | /// Initializes a new instance of the class. 55 | /// 56 | public Image() 57 | { 58 | this.HorizontalResolution = DefaultHorizontalResolution; 59 | this.VerticalResolution = DefaultVerticalResolution; 60 | this.CurrentImageFormat = DefaultFormats.Value.First(f => f.GetType() == typeof(PngFormat)); 61 | } 62 | 63 | /// 64 | /// Initializes a new instance of the class 65 | /// with the height and the width of the image. 66 | /// 67 | /// The width of the image in pixels. 68 | /// The height of the image in pixels. 69 | public Image(int width, int height) 70 | : base(width, height) 71 | { 72 | this.HorizontalResolution = DefaultHorizontalResolution; 73 | this.VerticalResolution = DefaultVerticalResolution; 74 | this.CurrentImageFormat = DefaultFormats.Value.First(f => f.GetType() == typeof(PngFormat)); 75 | } 76 | 77 | /// 78 | /// Initializes a new instance of the class 79 | /// by making a copy from another image. 80 | /// 81 | /// The other image, where the clone should be made from. 82 | /// is null. 83 | public Image(Image other) 84 | : base(other) 85 | { 86 | foreach (ImageFrame frame in other.Frames) 87 | { 88 | if (frame != null) 89 | { 90 | this.Frames.Add(new ImageFrame(frame)); 91 | } 92 | } 93 | 94 | this.RepeatCount = other.RepeatCount; 95 | this.HorizontalResolution = other.HorizontalResolution; 96 | this.VerticalResolution = other.VerticalResolution; 97 | this.CurrentImageFormat = other.CurrentImageFormat; 98 | } 99 | 100 | /// 101 | /// Initializes a new instance of the class. 102 | /// 103 | /// 104 | /// The other to create this instance from. 105 | /// 106 | /// 107 | /// Thrown if the given is null. 108 | /// 109 | public Image(ImageFrame other) 110 | : base(other) 111 | { 112 | this.HorizontalResolution = DefaultHorizontalResolution; 113 | this.VerticalResolution = DefaultVerticalResolution; 114 | 115 | // Most likely a gif 116 | // TODO: Should this be aproperty on ImageFrame? 117 | this.CurrentImageFormat = DefaultFormats.Value.First(f => f.GetType() == typeof(GifFormat)); 118 | } 119 | 120 | /// 121 | /// Initializes a new instance of the class. 122 | /// 123 | /// 124 | /// The stream containing image information. 125 | /// 126 | /// Thrown if the is null. 127 | public Image(Stream stream) 128 | { 129 | Guard.NotNull(stream, nameof(stream)); 130 | this.Load(stream, Formats); 131 | } 132 | 133 | /// 134 | /// Initializes a new instance of the class. 135 | /// 136 | /// 137 | /// The stream containing image information. 138 | /// 139 | /// 140 | /// The collection of . 141 | /// 142 | /// Thrown if the stream is null. 143 | public Image(Stream stream, params IImageFormat[] formats) 144 | { 145 | Guard.NotNull(stream, nameof(stream)); 146 | this.Load(stream, formats); 147 | } 148 | 149 | /// 150 | /// Gets a list of supported image formats. 151 | /// 152 | public static IList Formats => DefaultFormats.Value; 153 | 154 | /// 155 | public double HorizontalResolution { get; set; } 156 | 157 | /// 158 | public double VerticalResolution { get; set; } 159 | 160 | /// 161 | public double InchWidth 162 | { 163 | get 164 | { 165 | double resolution = this.HorizontalResolution; 166 | 167 | if (resolution <= 0) 168 | { 169 | resolution = DefaultHorizontalResolution; 170 | } 171 | 172 | return this.Width / resolution; 173 | } 174 | } 175 | 176 | /// 177 | public double InchHeight 178 | { 179 | get 180 | { 181 | double resolution = this.VerticalResolution; 182 | 183 | if (resolution <= 0) 184 | { 185 | resolution = DefaultVerticalResolution; 186 | } 187 | 188 | return this.Height / resolution; 189 | } 190 | } 191 | 192 | /// 193 | public bool IsAnimated => this.Frames.Count > 0; 194 | 195 | /// 196 | public ushort RepeatCount { get; set; } 197 | 198 | /// 199 | public IList Frames { get; } = new List(); 200 | 201 | /// 202 | public IList Properties { get; } = new List(); 203 | 204 | /// 205 | public IImageFormat CurrentImageFormat { get; internal set; } 206 | 207 | /// 208 | public void Save(Stream stream) 209 | { 210 | Guard.NotNull(stream, nameof(stream)); 211 | this.CurrentImageFormat.Encoder.Encode(this, stream); 212 | } 213 | 214 | /// 215 | public void Save(Stream stream, IImageFormat format) 216 | { 217 | Guard.NotNull(stream, nameof(stream)); 218 | format.Encoder.Encode(this, stream); 219 | } 220 | 221 | /// 222 | /// Loads the image from the given stream. 223 | /// 224 | /// 225 | /// The stream containing image information. 226 | /// 227 | /// 228 | /// The collection of . 229 | /// 230 | /// 231 | /// Thrown if the stream is not readable nor seekable. 232 | /// 233 | private void Load(Stream stream, IList formats) 234 | { 235 | if (!stream.CanRead) 236 | { 237 | throw new NotSupportedException("Cannot read from the stream."); 238 | } 239 | 240 | if (!stream.CanSeek) 241 | { 242 | throw new NotSupportedException("The stream does not support seeking."); 243 | } 244 | 245 | if (formats.Count > 0) 246 | { 247 | int maxHeaderSize = formats.Max(x => x.Decoder.HeaderSize); 248 | if (maxHeaderSize > 0) 249 | { 250 | byte[] header = new byte[maxHeaderSize]; 251 | 252 | stream.Position = 0; 253 | stream.Read(header, 0, maxHeaderSize); 254 | stream.Position = 0; 255 | 256 | IImageFormat format = formats.FirstOrDefault(x => x.Decoder.IsSupportedFileFormat(header)); 257 | if (format != null) 258 | { 259 | format.Decoder.Decode(this, stream); 260 | this.CurrentImageFormat = format; 261 | return; 262 | } 263 | } 264 | } 265 | 266 | StringBuilder stringBuilder = new StringBuilder(); 267 | stringBuilder.AppendLine("Image cannot be loaded. Available formats:"); 268 | 269 | foreach (IImageFormat format in formats) 270 | { 271 | stringBuilder.AppendLine("-" + format); 272 | } 273 | 274 | throw new NotSupportedException(stringBuilder.ToString()); 275 | } 276 | } 277 | } 278 | -------------------------------------------------------------------------------- /JpegDecoder.csx: -------------------------------------------------------------------------------- 1 | // From https://github.com/JimBobSquarePants/ImageProcessor/blob/Core/src/ImageProcessorCore/Formats/Jpg/JpegDecoder.cs 2 | 3 | // 4 | // Copyright (c) James Jackson-South and contributors. 5 | // Licensed under the Apache License, Version 2.0. 6 | // 7 | 8 | namespace ImageProcessorCore.Formats 9 | { 10 | using System; 11 | using System.IO; 12 | using System.Threading.Tasks; 13 | 14 | using BitMiracle.LibJpeg; 15 | 16 | /// 17 | /// Image decoder for generating an image out of a jpg stream. 18 | /// 19 | public class JpegDecoder : IImageDecoder 20 | { 21 | /// 22 | /// Gets the size of the header for this image type. 23 | /// 24 | /// The size of the header. 25 | public int HeaderSize => 11; 26 | 27 | /// 28 | /// Indicates if the image decoder supports the specified 29 | /// file extension. 30 | /// 31 | /// The file extension. 32 | /// 33 | /// true, if the decoder supports the specified 34 | /// extensions; otherwise false. 35 | /// 36 | /// 37 | /// is null (Nothing in Visual Basic). 38 | /// is a string 39 | /// of length zero or contains only blanks. 40 | public bool IsSupportedFileExtension(string extension) 41 | { 42 | Guard.NotNullOrEmpty(extension, "extension"); 43 | 44 | if (extension.StartsWith(".")) 45 | { 46 | extension = extension.Substring(1); 47 | } 48 | 49 | return extension.Equals("JPG", StringComparison.OrdinalIgnoreCase) || 50 | extension.Equals("JPEG", StringComparison.OrdinalIgnoreCase) || 51 | extension.Equals("JFIF", StringComparison.OrdinalIgnoreCase); 52 | } 53 | 54 | /// 55 | /// Indicates if the image decoder supports the specified 56 | /// file header. 57 | /// 58 | /// The file header. 59 | /// 60 | /// true, if the decoder supports the specified 61 | /// file header; otherwise false. 62 | /// 63 | /// 64 | /// is null (Nothing in Visual Basic). 65 | public bool IsSupportedFileFormat(byte[] header) 66 | { 67 | Guard.NotNull(header, "header"); 68 | 69 | bool isSupported = false; 70 | 71 | if (header.Length >= 11) 72 | { 73 | bool isJfif = IsJfif(header); 74 | bool isExif = IsExif(header); 75 | bool isJpeg = IsJpeg(header); 76 | 77 | isSupported = isJfif || isExif || isJpeg; 78 | } 79 | 80 | return isSupported; 81 | } 82 | 83 | /// 84 | /// Decodes the image from the specified stream and sets 85 | /// the data to image. 86 | /// 87 | /// The image, where the data should be set to. 88 | /// Cannot be null (Nothing in Visual Basic). 89 | /// The stream, where the image should be 90 | /// decoded from. Cannot be null (Nothing in Visual Basic). 91 | /// 92 | /// is null (Nothing in Visual Basic). 93 | /// - or - 94 | /// is null (Nothing in Visual Basic). 95 | /// 96 | public void Decode(Image image, Stream stream) 97 | { 98 | Guard.NotNull(image, "image"); 99 | Guard.NotNull(stream, "stream"); 100 | JpegImage jpg = new JpegImage(stream); 101 | 102 | int pixelWidth = jpg.Width; 103 | int pixelHeight = jpg.Height; 104 | 105 | float[] pixels = new float[pixelWidth * pixelHeight * 4]; 106 | 107 | if (jpg.Colorspace == Colorspace.RGB && jpg.BitsPerComponent == 8) 108 | { 109 | Parallel.For( 110 | 0, 111 | pixelHeight, 112 | y => 113 | { 114 | SampleRow row = jpg.GetRow(y); 115 | 116 | for (int x = 0; x < pixelWidth; x++) 117 | { 118 | Sample sample = row.GetAt(x); 119 | 120 | int offset = ((y * pixelWidth) + x) * 4; 121 | 122 | pixels[offset + 0] = sample[0] / 255f; 123 | pixels[offset + 1] = sample[1] / 255f; 124 | pixels[offset + 2] = sample[2] / 255f; 125 | pixels[offset + 3] = 1; 126 | } 127 | }); 128 | } 129 | else if (jpg.Colorspace == Colorspace.Grayscale && jpg.BitsPerComponent == 8) 130 | { 131 | Parallel.For( 132 | 0, 133 | pixelHeight, 134 | y => 135 | { 136 | SampleRow row = jpg.GetRow(y); 137 | 138 | for (int x = 0; x < pixelWidth; x++) 139 | { 140 | Sample sample = row.GetAt(x); 141 | 142 | int offset = ((y * pixelWidth) + x) * 4; 143 | 144 | pixels[offset + 0] = sample[0] / 255f; 145 | pixels[offset + 1] = sample[0] / 255f; 146 | pixels[offset + 2] = sample[0] / 255f; 147 | pixels[offset + 3] = 1; 148 | } 149 | }); 150 | } 151 | else 152 | { 153 | throw new NotSupportedException("JpegDecoder only supports RGB and Grayscale color spaces."); 154 | } 155 | 156 | image.SetPixels(pixelWidth, pixelHeight, pixels); 157 | 158 | jpg.Dispose(); 159 | } 160 | 161 | /// 162 | /// Returns a value indicating whether the given bytes identify Jfif data. 163 | /// 164 | /// The bytes representing the file header. 165 | /// The 166 | private static bool IsJfif(byte[] header) 167 | { 168 | bool isJfif = 169 | header[6] == 0x4A && // J 170 | header[7] == 0x46 && // F 171 | header[8] == 0x49 && // I 172 | header[9] == 0x46 && // F 173 | header[10] == 0x00; 174 | 175 | return isJfif; 176 | } 177 | 178 | /// 179 | /// Returns a value indicating whether the given bytes identify EXIF data. 180 | /// 181 | /// The bytes representing the file header. 182 | /// The 183 | private static bool IsExif(byte[] header) 184 | { 185 | bool isExif = 186 | header[6] == 0x45 && // E 187 | header[7] == 0x78 && // x 188 | header[8] == 0x69 && // i 189 | header[9] == 0x66 && // f 190 | header[10] == 0x00; 191 | 192 | return isExif; 193 | } 194 | 195 | /// 196 | /// Returns a value indicating whether the given bytes identify Jpeg data. 197 | /// This is a last chance resort for jpegs that contain ICC information. 198 | /// 199 | /// The bytes representing the file header. 200 | /// The 201 | private static bool IsJpeg(byte[] header) 202 | { 203 | bool isJpg = 204 | header[0] == 0xFF && // 255 205 | header[1] == 0xD8; // 216 206 | 207 | return isJpg; 208 | } 209 | } 210 | } -------------------------------------------------------------------------------- /JpegDecoder.fsx: -------------------------------------------------------------------------------- 1 | // From https://github.com/JimBobSquarePants/ImageProcessor/blob/Core/src/ImageProcessorCore/Formats/Jpg/JpegDecoder.cs 2 | 3 | open System 4 | open System.IO 5 | open System.Threading.Tasks 6 | 7 | //open BitMiracle.LibJpeg 8 | 9 | #load "Guard.fsx" 10 | open Guard 11 | 12 | /// ======================================= 13 | /// Dummy classes to make code compile 14 | /// ======================================= 15 | 16 | 17 | [] 18 | type Image() = 19 | member this.Height = 1 20 | member this.Width = 1 21 | member this.SetPixels(pixelWidth, pixelHeight, pixels) = () 22 | 23 | type Sample = int16[] 24 | 25 | type SampleRow() = 26 | member this.GetAt(x) = [||] 27 | 28 | type Colorspace = RGB | Grayscale 29 | 30 | type JpegImage(stream) = 31 | member this.Height = 1 32 | member this.Width = 1 33 | member this.Colorspace = Colorspace.RGB 34 | member this.BitsPerComponent = 1 35 | member this.GetRow(x) = SampleRow() 36 | member self.Dispose() = () 37 | interface IDisposable with 38 | member self.Dispose() = () 39 | 40 | /// ======================================= 41 | /// Main code 42 | /// ======================================= 43 | 44 | /// Image decoder for generating an image out of a jpg stream. 45 | type JpegDecoder() = 46 | 47 | /// Gets the size of the header for this image type. 48 | member this.HeaderSize :int = 11 49 | 50 | /// 51 | /// Indicates if the image decoder supports the specified 52 | /// file extension. 53 | /// 54 | /// 55 | /// is null (Nothing in Visual Basic). 56 | /// is a string 57 | /// of length zero or contains only blanks. 58 | member this.IsSupportedFileExtension (extension:string) : bool = 59 | 60 | Guard.NotNullOrEmpty(extension, "extension") 61 | 62 | let mutable extension = extension 63 | 64 | if (extension.StartsWith(".")) then 65 | extension <- extension.Substring(1) 66 | 67 | extension.Equals("JPG", StringComparison.OrdinalIgnoreCase) || 68 | extension.Equals("JPEG", StringComparison.OrdinalIgnoreCase) || 69 | extension.Equals("JFIF", StringComparison.OrdinalIgnoreCase) 70 | 71 | /// 72 | /// Indicates if the image decoder supports the specified 73 | /// file header. 74 | /// 75 | /// 76 | /// is null (Nothing in Visual Basic). 77 | member this.IsSupportedFileFormat(header : byte[]) : bool = 78 | 79 | Guard.NotNull(header, "header") 80 | 81 | let mutable isSupported = false 82 | 83 | if (header.Length >= 11) then 84 | let isJfif = JpegDecoder.IsJfif(header) 85 | let isExif = JpegDecoder.IsExif(header) 86 | let isJpeg = JpegDecoder.IsJpeg(header) 87 | isSupported <- isJfif || isExif || isJpeg 88 | 89 | isSupported 90 | 91 | 92 | /// Decodes the image from the specified stream and sets 93 | /// the data to image. 94 | member this.Decode(image:Image, stream:Stream) :unit = 95 | 96 | Guard.NotNull(image, "image") 97 | Guard.NotNull(stream, "stream") 98 | 99 | let jpg = new JpegImage(stream) 100 | 101 | let pixelWidth = jpg.Width 102 | let pixelHeight = jpg.Height 103 | 104 | let pixels :float[] = Array.zeroCreate(pixelWidth * pixelHeight * 4) 105 | 106 | if (jpg.Colorspace = Colorspace.RGB && jpg.BitsPerComponent = 8) then 107 | 108 | Parallel.For( 109 | 0, 110 | pixelHeight, 111 | fun y -> 112 | 113 | let row : SampleRow = jpg.GetRow(y) 114 | 115 | for x = 0 to pixelWidth-1 do 116 | 117 | let sample : Sample = row.GetAt(x) 118 | 119 | let offset : int = ((y * pixelWidth) + x) * 4 120 | 121 | pixels.[offset + 0] <- float sample.[0] / 255.0 122 | pixels.[offset + 1] <- float sample.[1] / 255.0 123 | pixels.[offset + 2] <- float sample.[2] / 255.0 124 | pixels.[offset + 3] <- 1.0 125 | 126 | ) |> ignore 127 | 128 | else if (jpg.Colorspace = Colorspace.Grayscale && jpg.BitsPerComponent = 8) then 129 | 130 | Parallel.For( 131 | 0, 132 | pixelHeight, 133 | fun y -> 134 | 135 | let row : SampleRow = jpg.GetRow(y) 136 | 137 | for x = 0 to pixelWidth-1 do 138 | 139 | let sample : Sample = row.GetAt(x) 140 | 141 | let offset : int = ((y * pixelWidth) + x) * 4 142 | 143 | pixels.[offset + 0] <- float sample.[0] / 255.0 144 | pixels.[offset + 1] <- float sample.[0] / 255.0 145 | pixels.[offset + 2] <- float sample.[0] / 255.0 146 | pixels.[offset + 3] <- 1.0 147 | 148 | ) |> ignore 149 | else 150 | 151 | raise <| NotSupportedException("JpegDecoder only supports RGB and Grayscale color spaces.") 152 | 153 | 154 | image.SetPixels(pixelWidth, pixelHeight, pixels) 155 | 156 | jpg.Dispose() 157 | 158 | 159 | /// 160 | /// Returns a value indicating whether the given bytes identify Jfif data. 161 | /// 162 | /// The bytes representing the file header. 163 | /// The 164 | static member IsJfif(header : byte[] ) : bool = 165 | 166 | let isJfif = 167 | header.[6] = 0x4Auy && // J 168 | header.[7] = 0x46uy && // F 169 | header.[8] = 0x49uy && // I 170 | header.[9] = 0x46uy && // F 171 | header.[10] = 0x00uy 172 | 173 | isJfif 174 | 175 | 176 | /// 177 | /// Returns a value indicating whether the given bytes identify EXIF data. 178 | /// 179 | /// The bytes representing the file header. 180 | /// The 181 | static member IsExif(header : byte[] ) : bool = 182 | 183 | let isExif = 184 | header.[6] = 0x45uy && // E 185 | header.[7] = 0x78uy && // x 186 | header.[8] = 0x69uy && // i 187 | header.[9] = 0x66uy && // f 188 | header.[10] = 0x00uy 189 | 190 | isExif 191 | 192 | 193 | /// 194 | /// Returns a value indicating whether the given bytes identify Jpeg data. 195 | /// This is a last chance resort for jpegs that contain ICC information. 196 | /// 197 | /// The bytes representing the file header. 198 | /// The 199 | static member IsJpeg(header : byte[] ) : bool = 200 | 201 | let isJpg = 202 | header.[0] = 0xFFuy && // 255 203 | header.[1] = 0xD8uy // 216 204 | 205 | isJpg 206 | 207 | 208 | 209 | -------------------------------------------------------------------------------- /JpegDecoderFP.fsx: -------------------------------------------------------------------------------- 1 | // From https://github.com/JimBobSquarePants/ImageProcessor/blob/Core/src/ImageProcessorCore/Formats/Jpg/JpegDecoder.cs 2 | 3 | open System 4 | open System.IO 5 | open System.Threading.Tasks 6 | 7 | //open BitMiracle.LibJpeg 8 | 9 | #load "Guard.fsx" 10 | open Guard 11 | 12 | #load "ErrorHandling.fsx" 13 | open ErrorHandling 14 | 15 | /// ======================================= 16 | /// Dummy classes to make code compile 17 | /// ======================================= 18 | 19 | 20 | [] 21 | type Image() = 22 | member this.Height = 1 23 | member this.Width = 1 24 | member this.SetPixels(pixelWidth, pixelHeight, pixels) = () 25 | static member FromPixels(pixelWidth, pixelHeight, pixels) = Image() 26 | 27 | type Sample = int16[] 28 | 29 | type SampleRow() = 30 | member this.GetAt(x) = [||] 31 | 32 | type Colorspace = RGB | Grayscale 33 | 34 | type JpegImage(stream) = 35 | member this.Height = 1 36 | member this.Width = 1 37 | member this.Colorspace = Colorspace.RGB 38 | member this.BitsPerComponent = 1 39 | member this.GetRow(x) = SampleRow() 40 | member self.Dispose() = () 41 | interface IDisposable with 42 | member self.Dispose() = () 43 | 44 | /// ======================================= 45 | /// Main code 46 | /// ======================================= 47 | 48 | type FileExtension = 49 | | PNG 50 | | GIF 51 | | JPG 52 | | JPEG 53 | | JFIF 54 | | UNKNOWN 55 | 56 | /// Image decoder for generating an image out of a jpg stream. 57 | module JpegDecoder1 = 58 | 59 | let (|EqualI|_|) compare (str:string) = 60 | if str.Equals(compare, StringComparison.OrdinalIgnoreCase) then 61 | Some () 62 | else 63 | None 64 | 65 | let toFileExtension extensionStr = 66 | match extensionStr with 67 | | null -> UNKNOWN 68 | | EqualI "png" -> PNG 69 | | EqualI "gif" -> GIF 70 | | EqualI "jpg" -> JPG 71 | | EqualI "jpeg" -> JPEG 72 | | EqualI "jfif" -> JFIF 73 | | _ -> UNKNOWN 74 | 75 | (* 76 | toFileExtension "png" 77 | toFileExtension null 78 | toFileExtension ".doc" 79 | *) 80 | 81 | 82 | let isSupportedFileExtension extension = 83 | match extension with 84 | | JPG 85 | | JPEG 86 | | JFIF -> true 87 | | PNG 88 | | GIF 89 | | UNKNOWN -> false 90 | 91 | 92 | 93 | 94 | 95 | 96 | let headerHasTag (header : byte[]) (tag:byte[]) start = 97 | let mutable allEqual = true 98 | 99 | for i=0 to tag.Length-1 do 100 | let elementEqual = 101 | header.[start+i] = tag.[i] 102 | allEqual <- allEqual && elementEqual 103 | 104 | allEqual 105 | 106 | (* 107 | let exifTag = "Exif"B 108 | let header = "abcdefExifxxx"B 109 | headerHasTag header exifTag 6 110 | *) 111 | 112 | 113 | let headerHasTagV2 header tag start = 114 | let len = Array.length tag 115 | let segment = Array.sub header start len 116 | segment = tag 117 | 118 | (* 119 | headerHasTagV2 header exifTag 6 120 | headerHasTagV2 header exifTag 3 121 | 122 | // this is generic and should be renamed -- Array.hasSegment or similar 123 | *) 124 | 125 | 126 | let isJfif header = 127 | let exifTag = "JFIF"B 128 | headerHasTagV2 header exifTag 6 129 | 130 | let isExif header = 131 | let exifTag = "Exif"B 132 | headerHasTagV2 header exifTag 6 133 | 134 | let isJpeg header = 135 | let jpegTag = [| 0xFFuy; 0xD8uy |] 136 | headerHasTagV2 header jpegTag 0 137 | 138 | let isSupportedFileFormat header = 139 | 140 | Guard.NotNull(header, "header") 141 | 142 | (Array.length header >= 11) && 143 | (isJfif header || isExif header || isJpeg header) 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | module JpegDecoder2 = 154 | 155 | // all the stuff from above, plus.. 156 | open JpegDecoder1 157 | 158 | type DecoderInput = { 159 | Image:Image 160 | Stream:Stream 161 | } 162 | 163 | type DecodingError = 164 | | DecodingUnsupported 165 | | DecodingFailed 166 | 167 | let parallelFor f fromInclusive toExclusive = 168 | Parallel.For(fromInclusive=fromInclusive,toExclusive=toExclusive,body=Action(f) ) |> ignore 169 | 170 | let updateFromSample getPixels (jpg:JpegImage) (pixels:float[]) y = 171 | let row : SampleRow = jpg.GetRow(y) 172 | let pixelWidth = jpg.Width 173 | 174 | for x = 0 to pixelWidth-1 do 175 | let sample : Sample = row.GetAt(x) 176 | let offset : int = ((y * pixelWidth) + x) * 4 177 | 178 | let sample0,sample1,sample2,sample3 = getPixels sample 179 | 180 | pixels.[offset + 0] <- sample0 181 | pixels.[offset + 1] <- sample1 182 | pixels.[offset + 2] <- sample2 183 | pixels.[offset + 3] <- sample3 184 | 185 | 186 | let (|RGB8bit|Grayscale8bit|Unsupported|) (jpg:JpegImage) = 187 | if (jpg.Colorspace = Colorspace.RGB && jpg.BitsPerComponent = 8) then 188 | RGB8bit 189 | elif (jpg.Colorspace = Colorspace.Grayscale && jpg.BitsPerComponent = 8) then 190 | Grayscale8bit 191 | else 192 | Unsupported 193 | 194 | /// Decodes the image from the specified stream and sets 195 | /// the data to image. 196 | let decode (input:DecoderInput) = 197 | 198 | use jpg = new JpegImage(input.Stream) 199 | 200 | let pixelWidth = jpg.Width 201 | let pixelHeight = jpg.Height 202 | 203 | let pixels = Array.zeroCreate(pixelWidth * pixelHeight * 4) 204 | 205 | match jpg with 206 | | RGB8bit -> 207 | let getPixels (sample:Sample) = 208 | float sample.[0] / 255.0, 209 | float sample.[1] / 255.0, 210 | float sample.[2] / 255.0, 211 | 1.0 212 | let update = updateFromSample getPixels jpg pixels 213 | parallelFor update 0 pixelHeight 214 | 215 | Image.FromPixels(pixelWidth, pixelHeight, pixels) 216 | |> Result.success 217 | 218 | | Grayscale8bit -> 219 | let getPixels (sample:Sample) = 220 | float sample.[0] / 255.0, 221 | float sample.[0] / 255.0, 222 | float sample.[0] / 255.0, 223 | 1.0 224 | let update = updateFromSample getPixels jpg pixels 225 | parallelFor update 0 pixelHeight 226 | 227 | Image.FromPixels(pixelWidth, pixelHeight, pixels) 228 | |> Result.success 229 | 230 | | Unsupported -> 231 | Result.failure DecodingUnsupported 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | 240 | 241 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # Apache 2.0 2 | 3 | Copyright 2016 4 | 5 | Scott Wlaschin (@ScottWlaschin) 6 | 7 | Licensed under the Apache License, Version 2.0 (the "License"); 8 | you may not use this file except in compliance with the License. 9 | You may obtain a copy of the License at 10 | 11 | http://www.apache.org/licenses/LICENSE-2.0 12 | 13 | Unless required by applicable law or agreed to in writing, software 14 | distributed under the License is distributed on an "AS IS" BASIS, 15 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16 | See the License for the specific language governing permissions and 17 | limitations under the License. -------------------------------------------------------------------------------- /Member.csx: -------------------------------------------------------------------------------- 1 | // from https://github.com/VaughnVernon/IDDD_Samples_NET/blob/master/iddd_agilepm/Domain.Model/Teams/Member.cs 2 | 3 | 4 | // Copyright 2012,2013 Vaughn Vernon 5 | // 6 | // Licensed under the Apache License, Version 2.0 (the "License"); 7 | // you may not use this file except in compliance with the License. 8 | // You may obtain a copy of the License at 9 | // 10 | // http://www.apache.org/licenses/LICENSE-2.0 11 | // 12 | // Unless required by applicable law or agreed to in writing, software 13 | // distributed under the License is distributed on an "AS IS" BASIS, 14 | // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | // See the License for the specific language governing permissions and 16 | // limitations under the License. 17 | 18 | using System; 19 | using SaaSOvation.AgilePM.Domain.Model.Tenants; 20 | using SaaSOvation.Common.Domain.Model; 21 | 22 | public abstract class Member : EntityWithCompositeId 23 | { 24 | public Member( 25 | TenantId tenantId, 26 | string userName, 27 | string firstName, 28 | string lastName, 29 | string emailAddress, 30 | DateTime initializedOn) 31 | { 32 | AssertionConcern.AssertArgumentNotNull(tenantId, "The tenant id must be provided."); 33 | 34 | this.TenantId = tenantId; 35 | this.EmailAddress = emailAddress; 36 | this.Enabled = true; 37 | this.FirstName = firstName; 38 | this.LastName = lastName; 39 | this.changeTracker = new MemberChangeTracker(initializedOn, initializedOn, initializedOn); 40 | } 41 | 42 | string userName; 43 | string emailAddress; 44 | string firstName; 45 | string lastName; 46 | 47 | public TenantId TenantId { get; private set; } 48 | 49 | public string Username 50 | { 51 | get { return this.userName; } 52 | private set 53 | { 54 | AssertionConcern.AssertArgumentNotEmpty(value, "The username must be provided."); 55 | AssertionConcern.AssertArgumentLength(value, 250, "The username must be 250 characters or less."); 56 | this.userName = value; 57 | } 58 | } 59 | 60 | public string EmailAddress 61 | { 62 | get { return this.emailAddress; } 63 | private set 64 | { 65 | if (value != null) 66 | AssertionConcern.AssertArgumentLength(emailAddress, 100, "Email address must be 100 characters or less."); 67 | this.emailAddress = value; 68 | } 69 | } 70 | 71 | public string FirstName 72 | { 73 | get { return this.firstName; } 74 | private set 75 | { 76 | if (value != null) 77 | AssertionConcern.AssertArgumentLength(value, 50, "First name must be 50 characters or less."); 78 | this.firstName = value; 79 | } 80 | } 81 | 82 | public string LastName 83 | { 84 | get { return this.lastName; } 85 | private set 86 | { 87 | if (value != null) 88 | AssertionConcern.AssertArgumentLength(value, 50, "Last name must be 50 characters or less."); 89 | this.lastName = value; 90 | } 91 | } 92 | 93 | public bool Enabled { get; private set; } 94 | 95 | MemberChangeTracker changeTracker; 96 | 97 | public void ChangeEmailAddress(string emailAddress, DateTime asOfDate) 98 | { 99 | if (this.changeTracker.CanChangeEmailAddress(asOfDate) 100 | && !this.EmailAddress.Equals(emailAddress)) 101 | { 102 | this.EmailAddress = emailAddress; 103 | this.changeTracker = this.changeTracker.EmailAddressChangedOn(asOfDate); 104 | } 105 | } 106 | 107 | public void ChangeName(string firstName, string lastName, DateTime asOfDate) 108 | { 109 | if (this.changeTracker.CanChangeName(asOfDate)) 110 | { 111 | this.FirstName = firstName; 112 | this.LastName = lastName; 113 | this.changeTracker = this.changeTracker.NameChangedOn(asOfDate); 114 | } 115 | } 116 | 117 | public void Disable(DateTime asOfDate) 118 | { 119 | if (this.changeTracker.CanToggleEnabling(asOfDate)) 120 | { 121 | this.Enabled = false; 122 | this.changeTracker = this.changeTracker.EnablingOn(asOfDate); 123 | } 124 | } 125 | 126 | public void Enable(DateTime asOfDate) 127 | { 128 | if (this.changeTracker.CanToggleEnabling(asOfDate)) 129 | { 130 | this.Enabled = true; 131 | this.changeTracker = this.changeTracker.EnablingOn(asOfDate); 132 | } 133 | } 134 | } 135 | -------------------------------------------------------------------------------- /Member.fsx: -------------------------------------------------------------------------------- 1 | // from https://github.com/VaughnVernon/IDDD_Samples_NET/blob/master/iddd_agilepm/Domain.Model/Teams/Member.cs 2 | 3 | 4 | open System 5 | 6 | #load "Guard.fsx" 7 | open Guard 8 | 9 | #load "MemberChangeTracker.fsx" 10 | open MemberChangeTracker 11 | 12 | /// ======================================= 13 | /// Dummy classes to make code compile 14 | /// ======================================= 15 | 16 | type TenantId = TenantId of int 17 | 18 | type AssertionConcern() = 19 | static member AssertArgumentNotEmpty(value, message) = () 20 | static member AssertArgumentLength(value,length,message) = () 21 | 22 | 23 | /// ======================================= 24 | /// Main code 25 | /// ======================================= 26 | 27 | [] 28 | type Member(tenantId : TenantId, 29 | userName : string , 30 | firstName : string , 31 | lastName : string , 32 | emailAddress : string , 33 | initializedOn : DateTime ) = 34 | 35 | let mutable tenantId = tenantId 36 | let mutable userName = userName 37 | let mutable emailAddress = emailAddress 38 | let mutable enabled = true 39 | let mutable firstName = firstName 40 | let mutable lastName = lastName 41 | let mutable changeTracker = MemberChangeTracker(initializedOn, initializedOn, initializedOn) 42 | 43 | member this.TenantId :TenantId = tenantId 44 | 45 | member this.Username 46 | with get () = userName 47 | and set (value) = 48 | AssertionConcern.AssertArgumentNotEmpty(value, "The username must be provided.") 49 | AssertionConcern.AssertArgumentLength(value, 250, "The username must be 250 characters or less.") 50 | userName <- value 51 | 52 | member this.EmailAddress 53 | with get () = this.EmailAddress 54 | and set (value) = 55 | if (value <> null) then 56 | AssertionConcern.AssertArgumentLength(emailAddress, 100, "Email address must be 100 characters or less.") 57 | emailAddress <- value 58 | 59 | member this.FirstName 60 | with get () = firstName 61 | and set (value) = 62 | if (value <> null) then 63 | AssertionConcern.AssertArgumentLength(value, 50, "First name must be 50 characters or less.") 64 | firstName <- value 65 | 66 | member this.LastName 67 | with get () = lastName 68 | and set (value) = 69 | if (value <> null) then 70 | AssertionConcern.AssertArgumentLength(value, 50, "Last name must be 50 characters or less.") 71 | this.LastName <- value 72 | 73 | member this.Enabled = enabled 74 | 75 | member this.ChangeEmailAddress(emailAddress:string, asOfDate:DateTime) = 76 | if changeTracker.CanChangeEmailAddress(asOfDate) 77 | && this.EmailAddress <> emailAddress then 78 | this.EmailAddress <- emailAddress 79 | changeTracker <- changeTracker.EmailAddressChangedOn(asOfDate) 80 | 81 | member this.ChangeName(firstName:string, lastName:string, asOfDate:DateTime) = 82 | if changeTracker.CanChangeName(asOfDate) then 83 | this.FirstName <- firstName 84 | this.LastName <- lastName 85 | changeTracker <- changeTracker.NameChangedOn(asOfDate) 86 | 87 | member this.Disable(asOfDate:DateTime) = 88 | if changeTracker.CanToggleEnabling(asOfDate) then 89 | enabled <- false 90 | changeTracker <- changeTracker.EnablingOn(asOfDate) 91 | 92 | member this.Enable(asOfDate:DateTime) = 93 | if changeTracker.CanToggleEnabling(asOfDate) then 94 | enabled <- true 95 | changeTracker <- changeTracker.EnablingOn(asOfDate) 96 | -------------------------------------------------------------------------------- /MemberChangeTracker.csx: -------------------------------------------------------------------------------- 1 | // From https://github.com/VaughnVernon/IDDD_Samples_NET/blob/master/iddd_agilepm/Domain.Model/Teams/MemberChangeTracker.cs 2 | 3 | // Copyright 2012,2013 Vaughn Vernon 4 | // 5 | // Licensed under the Apache License, Version 2.0 (the "License"); 6 | // you may not use this file except in compliance with the License. 7 | // You may obtain a copy of the License at 8 | // 9 | // http://www.apache.org/licenses/LICENSE-2.0 10 | // 11 | // Unless required by applicable law or agreed to in writing, software 12 | // distributed under the License is distributed on an "AS IS" BASIS, 13 | // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | // See the License for the specific language governing permissions and 15 | // limitations under the License. 16 | 17 | using System; 18 | 19 | 20 | public class MemberChangeTracker 21 | { 22 | internal MemberChangeTracker(DateTime enablingOn, DateTime nameChangedOn, DateTime emailAddressChangedOn) 23 | { 24 | this.emailAddressChangedOnDate = emailAddressChangedOn; 25 | this.enablingOnDate = enablingOn; 26 | this.nameChangedOnDate = nameChangedOn; 27 | } 28 | 29 | readonly DateTime enablingOnDate; 30 | readonly DateTime nameChangedOnDate; 31 | readonly DateTime emailAddressChangedOnDate; 32 | 33 | public bool CanChangeEmailAddress(DateTime asOfDateTime) 34 | { 35 | return this.emailAddressChangedOnDate < asOfDateTime; 36 | } 37 | 38 | public bool CanChangeName(DateTime asOfDateTime) 39 | { 40 | return this.nameChangedOnDate < asOfDateTime; 41 | } 42 | 43 | public bool CanToggleEnabling(DateTime asOfDateTime) 44 | { 45 | return this.enablingOnDate < asOfDateTime; 46 | } 47 | 48 | public MemberChangeTracker EmailAddressChangedOn(DateTime asOfDateTime) 49 | { 50 | return new MemberChangeTracker(this.enablingOnDate, this.nameChangedOnDate, asOfDateTime); 51 | } 52 | 53 | public MemberChangeTracker EnablingOn(DateTime asOfDateTime) 54 | { 55 | return new MemberChangeTracker(asOfDateTime, this.nameChangedOnDate, this.emailAddressChangedOnDate); 56 | } 57 | 58 | public MemberChangeTracker NameChangedOn(DateTime asOfDateTime) 59 | { 60 | return new MemberChangeTracker(this.enablingOnDate, asOfDateTime, this.emailAddressChangedOnDate); 61 | } 62 | 63 | protected override System.Collections.Generic.IEnumerable GetEqualityComponents() 64 | { 65 | yield return this.enablingOnDate; 66 | yield return this.nameChangedOnDate; 67 | yield return this.emailAddressChangedOnDate; 68 | } 69 | } 70 | -------------------------------------------------------------------------------- /MemberChangeTracker.fsx: -------------------------------------------------------------------------------- 1 | // From https://github.com/VaughnVernon/IDDD_Samples_NET/blob/master/iddd_agilepm/Domain.Model/Teams/MemberChangeTracker.cs 2 | 3 | open System 4 | 5 | type MemberChangeTracker(enablingOn:DateTime, nameChangedOn:DateTime, emailAddressChangedOn:DateTime) = 6 | 7 | member this.CanChangeEmailAddress(asOfDateTime:DateTime) : bool = 8 | emailAddressChangedOn < asOfDateTime 9 | 10 | member this.CanChangeName(asOfDateTime:DateTime) : bool = 11 | nameChangedOn < asOfDateTime 12 | 13 | member this.CanToggleEnabling(asOfDateTime:DateTime) : bool = 14 | enablingOn < asOfDateTime 15 | 16 | member this.EmailAddressChangedOn(asOfDateTime:DateTime) : MemberChangeTracker = 17 | MemberChangeTracker(enablingOn, nameChangedOn, asOfDateTime) 18 | 19 | member this.EnablingOn(asOfDateTime:DateTime) : MemberChangeTracker = 20 | MemberChangeTracker(asOfDateTime, nameChangedOn, emailAddressChangedOn) 21 | 22 | member this.NameChangedOn(asOfDateTime:DateTime) : MemberChangeTracker = 23 | MemberChangeTracker(enablingOn, asOfDateTime, emailAddressChangedOn) 24 | 25 | member this.GetEqualityComponents() = 26 | seq { 27 | yield this.EnablingOn 28 | yield this.NameChangedOn 29 | yield this.EmailAddressChangedOn 30 | } 31 | 32 | -------------------------------------------------------------------------------- /MemberFP.fsx: -------------------------------------------------------------------------------- 1 | // from https://github.com/VaughnVernon/IDDD_Samples_NET/blob/master/iddd_agilepm/Domain.Model/Teams/Member.cs 2 | 3 | 4 | open System 5 | 6 | #load "ErrorHandling.fsx" 7 | open ErrorHandling 8 | 9 | /// ======================================= 10 | /// Dummy classes to make code compile 11 | /// ======================================= 12 | 13 | type TenantId = TenantId of int 14 | 15 | type AssertionConcern() = 16 | static member AssertArgumentNotEmpty(value, message) = () 17 | static member AssertArgumentLength(value,length,message) = () 18 | 19 | 20 | /// ======================================= 21 | /// Common domain 22 | /// ======================================= 23 | 24 | // for how to make the constructors private, see https://gist.github.com/swlaschin/54cfff886669ccab895a 25 | type String50 = String50 of string 26 | type String100 = String100 of string 27 | type String250 = String250 of string 28 | 29 | let createString50 s = 30 | if String.IsNullOrEmpty(s) then 31 | Result.failureList "NullOrEmpty" 32 | elif String.length s > 50 then 33 | Result.failureList "Longer than 50" 34 | else 35 | Result.success (String50 s) 36 | 37 | let createString100 s = 38 | if String.IsNullOrEmpty(s) then 39 | Result.failureList "NullOrEmpty" 40 | elif String.length s > 100 then 41 | Result.failureList "Longer than 100" 42 | else 43 | Result.success (String100 s) 44 | 45 | let createString250 s = 46 | if String.IsNullOrEmpty(s) then 47 | Result.failureList "NullOrEmpty" 48 | elif String.length s > 250 then 49 | Result.failureList "Longer than 250" 50 | else 51 | Result.success (String250 s) 52 | 53 | /// ======================================= 54 | /// Main domain 55 | /// ======================================= 56 | 57 | type UserName = UserName of String250 58 | type FirstName = FirstName of String50 59 | type LastName = LastName of String50 60 | type EmailAddress = EmailAddress of String100 61 | 62 | type PersonalName = { 63 | FirstName : FirstName 64 | LastName : LastName 65 | } 66 | 67 | type MemberInfo = { 68 | TenantId : TenantId 69 | UserName : UserName 70 | PersonalName : PersonalName 71 | EmailAddress : EmailAddress 72 | PersonalNameChangedOn : DateTime 73 | EmailAddressChangedOn : DateTime 74 | } 75 | 76 | type TeamMember = 77 | | EnabledMember of MemberInfo * DateTime 78 | | DisabledMember of MemberInfo * DateTime 79 | 80 | 81 | /// ======================================= 82 | /// Business logic 83 | /// ======================================= 84 | 85 | let changeEmailAddress emailAddress asOfDate memberInfo = // note that member info is last parameter 86 | if memberInfo.EmailAddressChangedOn < asOfDate && memberInfo.EmailAddress <> emailAddress then 87 | Some {memberInfo with EmailAddress=emailAddress; EmailAddressChangedOn=asOfDate} 88 | else 89 | None 90 | // could change design to return same object, but we probably want to know 91 | // that a change happened so we can update the database 92 | 93 | let changeName personalName asOfDate memberInfo = 94 | if memberInfo.PersonalNameChangedOn < asOfDate && memberInfo.PersonalName <> personalName then 95 | Some {memberInfo with PersonalName=personalName; PersonalNameChangedOn=asOfDate} 96 | else 97 | None 98 | 99 | let disable asOfDate teamMember = 100 | match teamMember with 101 | | EnabledMember (memberInfo,stateChanged) -> 102 | if stateChanged < asOfDate then 103 | Some (DisabledMember (memberInfo,asOfDate)) 104 | else 105 | None 106 | | DisabledMember _ -> 107 | None 108 | 109 | let enable asOfDate teamMember = 110 | match teamMember with 111 | | DisabledMember (memberInfo,stateChanged) -> 112 | if stateChanged < asOfDate then 113 | Some (EnabledMember (memberInfo,asOfDate)) 114 | else 115 | None 116 | | EnabledMember _ -> 117 | None 118 | 119 | let mapTeamMember f teamMember = 120 | match teamMember with 121 | | EnabledMember (memberInfo,stateChanged) -> 122 | EnabledMember (f memberInfo,stateChanged) 123 | | DisabledMember (memberInfo,stateChanged) -> 124 | DisabledMember (f memberInfo,stateChanged) 125 | 126 | 127 | /// ======================================= 128 | /// Constructors 129 | /// ======================================= 130 | 131 | let createTenantId id = 132 | if id <= 0 then 133 | Result.failureList "TenantId must be positive" 134 | else 135 | Result.success (TenantId id) 136 | 137 | let createUserName s = 138 | createString250 s 139 | |> Result.map (fun s250 -> UserName s250) 140 | 141 | let createFirstName s = 142 | createString50 s 143 | |> Result.map FirstName 144 | 145 | let createLastName s = 146 | createString50 s 147 | |> Result.map LastName 148 | 149 | let createEmailAddress s = 150 | createString100 s 151 | |> Result.bind (fun s100 -> 152 | if s.Contains("@") then 153 | Result.success (EmailAddress s100) 154 | else 155 | Result.failureList "Email must contain an @ sign" 156 | ) 157 | 158 | let createPersonalName firstName lastName = 159 | let ctor firstName lastName = 160 | {FirstName=firstName; LastName=lastName} 161 | let firstNameResult = createFirstName firstName 162 | let lastNameResult = createLastName lastName 163 | Result.lift2 ctor firstNameResult lastNameResult 164 | 165 | let createMemberInfo utcNow tenantId userName firstName lastName emailAddress = 166 | let ctor tenantId userName firstName lastName emailAddress = 167 | let personalName = {FirstName=firstName; LastName=lastName} 168 | { 169 | TenantId = tenantId 170 | UserName = userName 171 | PersonalName = personalName 172 | EmailAddress = emailAddress 173 | PersonalNameChangedOn = utcNow 174 | EmailAddressChangedOn = utcNow 175 | } 176 | 177 | let tenantIdResult = createTenantId tenantId 178 | let userNameResult = createUserName userName 179 | let firstNameResult = createFirstName firstName 180 | let lastNameResult = createLastName lastName 181 | let emailAddressResult = createEmailAddress emailAddress 182 | 183 | let ( ) = Result.map 184 | let ( <*> ) = Result.apply 185 | 186 | ctor tenantIdResult <*> userNameResult <*> firstNameResult <*> lastNameResult <*> emailAddressResult 187 | 188 | 189 | /// ======================================= 190 | /// Constructors 191 | /// ======================================= 192 | 193 | let time1 = DateTime(2016,1,1) 194 | let time2 = DateTime(2016,2,2) 195 | 196 | // example 197 | let emailAddressResult = createEmailAddress "me@example.com" 198 | let emailAddressResult2 = createEmailAddress "example.com" 199 | 200 | let memberInfoResult = createMemberInfo time1 1 "aadams" "Alice" "Adams" "me@example.com" 201 | let memberInfoResult2 = createMemberInfo time1 0 "aadams" "Alice" "Adams" "example.com" 202 | 203 | let changeEmailAddressR email asOf mi = 204 | changeEmailAddress email asOf mi 205 | |> Result.fromOption ["Couldn't change email address"] 206 | 207 | // try to change email address 208 | let emailAddress1 = createEmailAddress "me@example.com" |> Result.successValue 209 | let emailAddress2 = createEmailAddress "test@example.com" |> Result.successValue 210 | 211 | 212 | 213 | memberInfoResult 214 | |> Result.bind (changeEmailAddressR emailAddress1 time2) 215 | 216 | memberInfoResult 217 | |> Result.bind (changeEmailAddressR emailAddress2 time2) 218 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## "Refactoring F#" 2 | 3 | Examples from my "Refactoring F#" talk. 4 | 5 | Code available at https://github.com/swlaschin/RefactoringFSharp 6 | 7 | 8 | ## Key principles of functional programming 9 | 10 | * Separate code from data 11 | * Every function has an output -- this is important for composition 12 | * Functions should not have hidden side-effects 13 | 14 | ## Functional Design Guidelines 15 | 16 | * Composition everywhere 17 | * E.g. Convert everything to the same "level" using lifting - then composition is easier. 18 | * Parameterize all the things 19 | * E.g. remove dependencies on global code by passing in functions 20 | * There is no problem that cannot be solved by wrapping it in a type 21 | * Model the system like a compiler: 22 | 1. Parse the (untrusted) input into a trusted internal representation (use Option.ofObj, ofNullable, etc) 23 | 2. Process and transform the data 24 | 3. Emit data back to the untrusted world: transform domain types back to strings and ints. 25 | 26 | 27 | ## Tips for refactoring from imperative code 28 | 29 | * Replace throwing exceptions with returning a Result. Chain results together using "bind". See http://fsharpforfunandprofit.com/rop/ 30 | * Change void-returning methods to return something. 31 | * Use types to remove the need for validation. Obviously no nulls, but also e.g PositiveInteger 32 | * Pass the buck! It's the caller's responsibility to give you valid data 33 | * Replace inheritance with discriminated unions where appropriate. 34 | * Replace if/then/else tests with pattern matching -- it helps you detect edge cases 35 | * Use Active patterns to make conditional logic clearer 36 | 37 | ## Tips for converting imperative loops 38 | 39 | * If you are iterating over all the elements, use fold 40 | * If you need to break early, use recursion, or fold with a flag. 41 | * Take full advantage of the built-in collection functions -- see http://fsharpforfunandprofit.com/posts/list-module-functions/ 42 | * Don't forget `choose` and `pick` 43 | * Don't treat lists like indexed collections 44 | 45 | 46 | ## General Tips 47 | 48 | * Using Some/None matching with options can generally be replaced with Option.map or Option.bind. 49 | * Use #IComparable, etc., instead of ugly type constraints 50 | * Booleans 51 | * If you see boolean flags in a data structure, chances are it's a state machine. Use a DU instead. 52 | * If you see a function returning a boolean, replace the result with something useful. 53 | 54 | 55 | ## Code smells 56 | 57 | * Ignoring the output of an expression 58 | * Throwing exceptions rather than returning error types. 59 | * Returning unit rather than something useful. 60 | * Null checks in the core domain -- these should only be done at the boundary 61 | * Wildcards in pattern matching 62 | * Primitive obsession: Using strings and ints everywhere, rather than exploiting the type system. 63 | * Accessing "global" functions and state rather than having them be passed in as parameters 64 | * Treating lists like indexed collections 65 | * Treating lists as appendable collections 66 | * Over-reliance on "if" expressions and booleans rather than using pattern matching. 67 | * Over-reliance on booleans (see tip above) 68 | * Unwrapping and rewrapping options using "IsSome" rather than using staying in the world of options and using Option.map and Option.bind. 69 | * See http://fsharpforfunandprofit.com/series/map-and-bind-and-apply-oh-my.html 70 | * Having deeply nested lambdas - I prefer the use of private helpers 71 | 72 | -------------------------------------------------------------------------------- /RefactoringFSharp.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | Debug 6 | AnyCPU 7 | 2.0 8 | 02696999-8f45-4855-9731-d27e38f5aefc 9 | Library 10 | FsCapBased 11 | FsCapBased 12 | v4.5.2 13 | true 14 | 4.4.0.0 15 | FsCapBased 16 | 17 | 18 | true 19 | full 20 | false 21 | false 22 | bin\Debug\ 23 | DEBUG;TRACE 24 | 3 25 | AnyCPU 26 | bin\Debug\FsCapBased.XML 27 | true 28 | 29 | 30 | pdbonly 31 | true 32 | true 33 | bin\Release\ 34 | TRACE 35 | 3 36 | AnyCPU 37 | bin\Release\FsCapBased.XML 38 | true 39 | 40 | 41 | 11 42 | 43 | 44 | 45 | 46 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets 47 | 48 | 49 | 50 | 51 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | True 77 | 78 | 79 | 80 | 81 | 88 | -------------------------------------------------------------------------------- /RefactoringFSharp.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio 14 4 | VisualStudioVersion = 14.0.24720.0 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "RefactoringFSharp", "RefactoringFSharp.fsproj", "{02696999-8F45-4855-9731-D27E38F5AEFC}" 7 | EndProject 8 | Global 9 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 10 | Debug|Any CPU = Debug|Any CPU 11 | Release|Any CPU = Release|Any CPU 12 | EndGlobalSection 13 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 14 | {02696999-8F45-4855-9731-D27E38F5AEFC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 15 | {02696999-8F45-4855-9731-D27E38F5AEFC}.Debug|Any CPU.Build.0 = Debug|Any CPU 16 | {02696999-8F45-4855-9731-D27E38F5AEFC}.Release|Any CPU.ActiveCfg = Release|Any CPU 17 | {02696999-8F45-4855-9731-D27E38F5AEFC}.Release|Any CPU.Build.0 = Release|Any CPU 18 | EndGlobalSection 19 | GlobalSection(SolutionProperties) = preSolution 20 | HideSolutionNode = FALSE 21 | EndGlobalSection 22 | EndGlobal 23 | -------------------------------------------------------------------------------- /TipsAndSmells.fsx: -------------------------------------------------------------------------------- 1 | (* 2 | Examples of tips and smells 3 | *) 4 | 5 | // ====================================== 6 | // Code smells around not fully embracing functional programming 7 | // 8 | // * use immutable data 9 | // * use higher order functions 10 | // * treat everything an an expression 11 | // ====================================== 12 | 13 | 14 | // For example, here is a function to count the elements of a list using a loop and a mutable counter: 15 | 16 | let countElements list = 17 | let mutable count = 0 18 | for element in list do 19 | count <- count + 1 20 | count 21 | 22 | // In cases when you are iterating over a list and accumulating things, a `fold` can do the same thing in fewer lines: 23 | 24 | let countElementsWithFold list = 25 | let foldAction state element = state + 1 26 | let initialValue = 0 27 | list |> Seq.fold foldAction initialValue 28 | 29 | (* 30 | Let's say that you have a list of objects, and some way of extracting a key, and you want to find the one that is largest, or newest, or whatever. 31 | 32 | In a mutable approach, you would have a global candidate key and element which is updated 33 | if you find a better one as you iterate through the list ([C# version](http://stackoverflow.com/a/914198/1136133)). 34 | 35 | *) 36 | 37 | /// Given a list of objects, and a function to extract a key, and an initial candidate 38 | /// return the object with the highest key. 39 | /// Return the initialCandidate if the list is empty. 40 | let maxBy keySelector initialCandidate list = 41 | let mutable candidate = initialCandidate 42 | let mutable maxKeySoFar = keySelector initialCandidate 43 | for element in list do 44 | let key = keySelector element 45 | if key > maxKeySoFar then 46 | maxKeySoFar <- key 47 | candidate <- element 48 | candidate 49 | 50 | 51 | // Here's the same version rewritten using `fold`. 52 | 53 | /// Given a list of objects, and a function to extract a key, and an initial candidate 54 | /// return the object with the highest key. 55 | /// Return the initialCandidate if the list is empty. 56 | let maxByWithFold keySelector initialCandidate list = 57 | 58 | // given an existing candidate and the next element 59 | // compare their keys and return the one with the higher key 60 | let compareKeys state element = 61 | let (maxKeySoFar,candidate) = state 62 | let key = keySelector element 63 | if key > maxKeySoFar then 64 | key,element // new state 65 | else 66 | state // old state 67 | 68 | // use the fold function to iterate over the list 69 | let initialKey = keySelector initialCandidate 70 | let initialState = initialKey,initialCandidate 71 | list |> Seq.fold compareKeys initialState |> snd 72 | 73 | // Everything that you can do with `fold` can be done with recursion and vice versa. So here's a recursive version as well. 74 | 75 | 76 | /// Given a list of objects, and a function to extract a key 77 | /// return the object with the highest key. 78 | /// Return the initialCandidate if the list is empty. 79 | let maxByWithRecursion keySelector initialCandidate list = 80 | 81 | // given an existing candidate and the next element 82 | // compare their keys and return the one with the higher key 83 | let compareKeys state element = 84 | let (maxKeySoFar,candidate) = state 85 | let key = keySelector element 86 | if key > maxKeySoFar then 87 | key,element // new state 88 | else 89 | state // old state 90 | 91 | // inner recursive version 92 | let rec loop state list = 93 | match list with 94 | | [] -> state 95 | | element::rest -> 96 | let newState = compareKeys state element 97 | loop newState rest 98 | 99 | // use the inner loop function to iterate over the list 100 | let initialKey = keySelector initialCandidate 101 | let initialState = initialKey,initialCandidate 102 | loop initialState list |> snd 103 | 104 | 105 | // In general I prefer to use `fold` rather than recursion because it's cleaner and avoids any issues with not having tail recursion. 106 | // On the other hand, recursion can be simpler sometimes, especially if you want to return or break early. 107 | // Either approach is better than using `mutable`! 108 | 109 | // One more example. Let's say that you need to read lines from the input until a blank line occurs, and then process them. 110 | 111 | open System 112 | 113 | /// Read lines from the input until a blank line occurs 114 | /// then return the list of strings 115 | let readLinesFromInput() = 116 | let mutable list = [] 117 | let mutable input = Console.ReadLine() 118 | while input <> "" do 119 | list <- list @ [input] 120 | input <- Console.ReadLine() 121 | list 122 | 123 | (* 124 | To test this, paste this into the F# interactive window: 125 | 126 | readLinesFromInput();; 127 | *) 128 | 129 | 130 | // Now here's what a recursive version might look like: 131 | 132 | 133 | /// Read lines from the input until a blank line occurs 134 | /// then return the list of strings 135 | let readLinesFromInputRecursive() = 136 | // inner recursive function 137 | let rec loop listSoFar = 138 | let input = Console.ReadLine() 139 | match input with 140 | | "" -> 141 | // terminate loop and return 142 | listSoFar 143 | | _ -> 144 | // append to make a new list and keep going 145 | let newList = listSoFar @ [input] 146 | loop newList 147 | loop [] 148 | 149 | // And here's a version using `Seq.initInfinite` which is of course lazy: 150 | 151 | /// Read lines from the input until a blank line occurs 152 | /// then return the list of strings 153 | let readLinesFromInputSeq() = 154 | Seq.initInfinite (fun i -> Console.ReadLine()) 155 | |> Seq.takeWhile (fun s -> s <> "") 156 | |> Seq.toList 157 | 158 | 159 | 160 | // ====================================== 161 | // taking full advantage of the built-in collection functions 162 | // ====================================== 163 | 164 | (* 165 | There are lot of really useful functions available to you in `List` and `Seq` modules. 166 | If you understand what they all do, you can often save yourself quite a bit of time and make your code simpler. 167 | 168 | And if you are looking for functions that aren't there, chances are someone else has already written it for you. 169 | For example, the excellent "[FSharpx.Collections](https://github.com/fsprojects/FSharpx.Collections)" project 170 | has [useful extensions for `List`, `Map`, etc.](https://fsprojects.github.io/FSharpx.Collections/reference/index.html) so try there first. 171 | 172 | *) 173 | 174 | 175 | // I could have just written: 176 | 177 | let countElements list = 178 | Seq.length list 179 | 180 | let maxBy keySelector initialCandidate list = 181 | // prepend the initialCandidate 182 | let newSeq = seq { yield initialCandidate; yield! list} 183 | newSeq |> Seq.maxBy keySelector 184 | 185 | // ====================================== 186 | // Choose `choose` 187 | // ====================================== 188 | 189 | (* 190 | One collection function that deserves more attention is `choose`, which can replace a `filter` and `map` with one step. 191 | 192 | For example, let's say that you have a collection of options, and you only want to return the valid ones, where they are `Some`. 193 | 194 | if you didn't know about `choose` you might use `filter` to find all the valid ones, and then `map` to extract the values, like this: 195 | *) 196 | 197 | let selectSome (aListOfOptions:'a option list) = 198 | aListOfOptions 199 | // only include the valid ones 200 | |> List.filter (fun e -> e.IsSome ) 201 | // extract the data 202 | |> List.map (fun e -> e.Value) 203 | 204 | // test 205 | [Some 1; Some 2; None] |> selectSome 206 | 207 | (* 208 | This is also really smelly because I am using the methods `e.IsSome` and `e.Value`, 209 | which in turn means that I have specify the type of the `aListOfOptions` parameter. 210 | 211 | I could replace `(fun e -> e.IsSome )` with just `Option.isSome`, which also has the benefit of letting the type inference do its thing, 212 | so that we no longer need the type annotation on the parameter: 213 | *) 214 | 215 | let selectSomeV2 aListOfOptions= 216 | aListOfOptions 217 | // only include the valid ones 218 | |> List.filter Option.isSome 219 | // extract the data 220 | |> List.map (fun e -> e.Value) 221 | 222 | // But why even bother with this two step approach -- `choose` will do this in one step! 223 | 224 | let selectSomeV3 aListOfOptions = 225 | aListOfOptions 226 | |> List.choose id 227 | 228 | // test 229 | [Some 1; Some 2; None] |> selectSomeV3 230 | 231 | 232 | // In this case, I'm using `id` as the choose function, because the elements in the list are options already. 233 | 234 | // In this next example, the elements in the list are of type `Person`, and I want to extract the names of persons that fulfil a certain property. 235 | 236 | // Using `filter` and `map` I might write it like this: 237 | 238 | type Person = {name:string; age:int} 239 | 240 | let selectNamesOfPeopleLegalToDrive listOfPeople = 241 | listOfPeople 242 | // only include the valid ones 243 | |> List.filter (fun e -> e.age >= 18) 244 | // extract the data 245 | |> List.map (fun e -> e.name) 246 | 247 | // test 248 | let persons = [ 249 | {name="Alice"; age=10} 250 | {name="Bob"; age=20} 251 | {name="Carol"; age=30} ] 252 | 253 | persons |> selectNamesOfPeopleLegalToDrive 254 | 255 | // But with `choose`, I could write it like this instead: 256 | 257 | let selectNamesOfPeopleLegalToDriveV2 listOfPeople = 258 | let nameOfLegalPerson p = 259 | if p.age >= 18 then Some p.name else None 260 | 261 | listOfPeople 262 | |> List.choose nameOfLegalPerson 263 | 264 | // test 265 | persons |> selectNamesOfPeopleLegalToDriveV2 266 | 267 | // ====================================== 268 | // Treating lists like indexed collections 269 | // ====================================== 270 | 271 | (* 272 | If you are coming from C#, you might have a tendency to think of F# lists as just like indexable collections such as arrays or `List`. 273 | 274 | F# lists are *not* indexable collections. You cannot do `myList[0]` in F# -- not when `myList` is a list, anyway. 275 | 276 | And yes, it is quite confusing that the C# `List` is not the same as the F# `list`. Sorry about that! 277 | In fact the C# `List` *is* available in F#, but under the name `ResizeArray`, which reflects how it is used, as a resizable, mutable, indexable collection. 278 | 279 | The clue that someone is thinking of F# lists as indexable collections is when you see `List.nth` used a lot. For example, in something like this: 280 | *) 281 | 282 | let printList list = 283 | let len = List.length list 284 | for i=0 to len-1 do 285 | let element = List.nth list i 286 | printfn "The %ith element is %A" i element 287 | 288 | // test 289 | [1..5] |> printList 290 | 291 | (* 292 | There are two reasons not to do this: 293 | 294 | First, `List.nth` involves traversing the list from the beginning *every time*, because lists are implemented somewhat like linked lists ([here is good explanation of this](http://diditwith.net/2008/03/03/WhyILoveFListsTheBasics.aspx)). 295 | 296 | Second, because there is already a built-in function that will do what you want: `iteri` in this case (there is also `mapi`). Here's a version using `iteri`: 297 | *) 298 | let printListV2 list = 299 | list 300 | |> List.iteri (fun i element -> 301 | printfn "The %ith element is %A" i element ) 302 | 303 | // test 304 | [1..5] |> printListV2 305 | 306 | 307 | // When using collection functions like this, I also like to make little helper functions internally, which help keep the main pipeline code clean and easy to understand: 308 | 309 | 310 | let printListV3 list = 311 | // internal helper 312 | let printElement i element = 313 | printfn "The %ith element is %A" i element 314 | 315 | // main pipeline is easier to understand 316 | list 317 | |> List.iteri printElement 318 | 319 | 320 | 321 | // ====================================== 322 | // Treating lists as appendable collections 323 | // ====================================== 324 | 325 | (* 326 | Another smell is when you see items appended to the end of a list. 327 | 328 | In C#, a `List` is commonly appended to with methods such as [`Add`](https://msdn.microsoft.com/en-us/library/bb310301(v=vs.110).aspx). 329 | In F# appending to a list is expensive, while prepending is cheap. 330 | 331 | This leads to an idiom where new lists are built by *prepending only* and then reversed as a final step. 332 | 333 | For example, in the `readLinesFromInputRecursive` example above, I used the code `listSoFar @ [input]` to append a one element list (`[input]`) to the `listSoFar`: 334 | *) 335 | 336 | /// Read lines from the input until a blank line occurs 337 | /// then return the list of strings 338 | let readLinesFromInputRecursive() = 339 | // inner recursive function 340 | let rec loop listSoFar = 341 | let input = Console.ReadLine() 342 | match input with 343 | | "" -> 344 | // terminate loop and return 345 | listSoFar 346 | | _ -> 347 | // append to make a new list and keep going 348 | let newList = listSoFar @ [input] 349 | loop newList 350 | loop [] 351 | 352 | (* 353 | The use of `@` in that code is a bit funny. A much more idiomatic approach would be to do 354 | `let newList = input :: listSoFar` for each iteration and then do `listSoFar |> List.rev` at the end, like this: 355 | *) 356 | 357 | let readLinesFromInputRecursiveV2() = 358 | // inner recursive function 359 | let rec loop listSoFar = 360 | let input = Console.ReadLine() 361 | match input with 362 | | "" -> 363 | // terminate loop and return reversed list 364 | listSoFar |> List.rev 365 | | _ -> 366 | // prepend to make a new list and keep going 367 | let newList = input :: listSoFar 368 | loop newList 369 | loop [] 370 | 371 | (* 372 | Appending to lists is considered to be much slower than prepending, but for small lists (less than 100 elements) it might not be that big a deal. 373 | ([I did some performance tests here](http://fsharpforfunandprofit.com/posts/monoids-part3/#performance)). 374 | 375 | It is more of idiomatic thing -- you should be aware of how lists work! 376 | *) 377 | 378 | 379 | // ====================================== 380 | // Ignoring the output of an expression 381 | // ====================================== 382 | 383 | (* 384 | In F# everything is an expression and therefore there is always an "output" that should be consumed. 385 | When the value of an expression is ignored, that can often be a sign of bad code. 386 | 387 | Now it is true that you *do* sometimes have to ignore the value of an expression, especially when interacting with side-effecting methods in the .NET libraries. 388 | For example, you might safely ignore the result of [`SqlCommand.ExecuteNonQuery`](https://msdn.microsoft.com/enus/library/system.data.sqlclient.sqlcommand.executenonquery(v=vs.110).aspx) 389 | or even something like [`List.RemoveAll`](https://msdn.microsoft.com/en-us/library/wdka673a(v=vs.110).aspx). 390 | 391 | But if you are interacting with pure F# code, seeing `ignore` is generally a sign of a bad design. 392 | 393 | Let's look at an example. Say that you have a `updateDatabase` function that returns success or failure, like this: 394 | *) 395 | 396 | type SuccessFailure<'a> = 397 | | Success of 'a 398 | | Failure of string 399 | 400 | let updateDatabase record = 401 | // do something 402 | Success "OK" 403 | 404 | 405 | // And then you want to update two records in a row like this: 406 | 407 | 408 | let highLevelFunction() = 409 | let record1 = "test" 410 | updateDatabase record1 // This expression should have type 'unit', 411 | 412 | let record2 = "test" 413 | updateDatabase record2 414 | 415 | 416 | // The problem is that the compiler complains about the `updateDatabase record1` line, because it should have type 'unit' rather than type `SuccessFailure`. 417 | 418 | // No problem -- just add `ignore` afterwards to make the error go away, right? 419 | 420 | 421 | let highLevelFunctionWithIgnore() = 422 | let record1 = "test" 423 | updateDatabase record1 |> ignore 424 | 425 | let record2 = "test" 426 | updateDatabase record2 |> ignore 427 | 428 | 429 | // Nooooo! That's the code smell right there. Why are you ignoring the error? What should you do if `record1` was *not* updated? 430 | 431 | // By using `ignore` you've turned off a helpful diagnostic tool that the compiler is giving you. 432 | 433 | // One approach which is better is to handle the error explicitly, like this: 434 | 435 | 436 | let highLevelWithErrorHandling() = 437 | let record1 = "test" 438 | match updateDatabase record1 with 439 | | Success _ -> 440 | let record2 = "test" 441 | updateDatabase record2 442 | | Failure err -> 443 | Failure err 444 | 445 | (* 446 | There are other approaches that you can use too. But please, make the errors visible rather than ignoring them. 447 | 448 | If you think that handling all these error codes will get complicated, please see my talk on [error handling](/rop/). 449 | *) 450 | 451 | let bind f xResult = 452 | match xResult with 453 | | Success x -> f x 454 | | Failure err -> Failure err 455 | 456 | let highLevelWithErrorHandlingV2() = 457 | let record1 = "test" 458 | let record2 = "test" 459 | 460 | updateDatabase record1 461 | |> bind (fun _ -> updateDatabase record2) 462 | 463 | 464 | // ====================================== 465 | // Throwing exceptions rather than returning error types. 466 | // ====================================== 467 | 468 | (* 469 | I don't recommend throwing exceptions except for certain cases such as truly unrecoverable errors or simple scripts. 470 | 471 | The reason is that exceptions do not show up in the type signature, and so you can not be sure what a function does just by looking at its signature. 472 | 473 | For example, if I have this code: 474 | 475 | *) 476 | 477 | 478 | let updateDatebase record = 479 | // do something 480 | let result = true 481 | if result then 482 | () // no return value 483 | else 484 | failwith "Duplicate Key" 485 | 486 | (* 487 | 488 | It has the signature `Customer -> unit`, say, which implies that it will always succeed. This is not true! The signature is lying to us! 489 | 490 | On the other hand, if the code is written like this: 491 | *) 492 | 493 | let updateDatebaseWithError record = 494 | // do something 495 | let result = true 496 | if result then 497 | Success () 498 | else 499 | Failure "Duplicate Key" 500 | 501 | (* 502 | It has the signature `Customer -> SuccessFailure`, say, which implies that it might not always succeed and that we have to be prepared to handle errors. 503 | This signature is not lying to us, and so it is preferable to the exception throwing version. 504 | *) 505 | 506 | --------------------------------------------------------------------------------