Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Avoid attributes recomputation #109

Merged
merged 4 commits into from
Mar 12, 2018
Merged

Avoid attributes recomputation #109

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
d599485
Don't recompute UnionCaseInfo attributes
vbfox Mar 11, 2018
82a3189
Remove some printf usages
vbfox Mar 11, 2018
c9d5d4b
Fix review comments
vbfox Mar 12, 2018
35a8a9e
Apply more comments from review
vbfox Mar 12, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
69 changes: 44 additions & 25 deletions src/Argu/PreCompute.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,22 @@ open System.Text.RegularExpressions

open FSharp.Reflection

[<AutoOpen>]
module private FastAttributes =
let inline hasAttribute<'T when 'T :> Attribute> (attributes: obj[]) =
attributes |> Array.exists (fun x -> x :? 'T)

let inline hasAttribute2<'T when 'T :> Attribute> (attributes: obj[]) (declaringTypeAttributes: obj[]) =
(hasAttribute<'T> attributes) || (hasAttribute<'T> declaringTypeAttributes)

let inline tryGetAttribute<'T when 'T :> Attribute> (attributes: obj[]) =
attributes |> Array.tryPick (function :? 'T as t -> Some t | _ -> None)

let inline tryGetAttribute2<'T when 'T :> Attribute> (attributes: obj[]) (declaringTypeAttributes: obj[]) =
match tryGetAttribute<'T> attributes with
| Some _ as attr -> attr
| None -> tryGetAttribute<'T> declaringTypeAttributes

let defaultHelpParam = "help"
let defaultHelpDescription = "display this list of options."

Expand All @@ -21,9 +37,9 @@ let getDefaultHelpParam (t : Type) =
prefixString + defaultHelpParam

/// construct a CLI param from UCI name
let generateOptionName (uci : UnionCaseInfo) =
let generateOptionName (uci : UnionCaseInfo) (attributes: obj[]) (declaringTypeAttributes: obj[])=
let prefixString =
match uci.TryGetAttribute<CliPrefixAttribute>(true) with
match tryGetAttribute2<CliPrefixAttribute> attributes declaringTypeAttributes with
| None -> CliPrefix.DoubleDash
| Some pf -> pf.Prefix

Expand Down Expand Up @@ -133,7 +149,7 @@ let tryGetDuEnumerationParser label (t : Type) =
let tagReader = lazy(FSharpValue.PreComputeUnionTagReader(t, allBindings))
let extractUciInfo (uci : UnionCaseInfo) =
let name =
match uci.TryGetAttribute<CustomCommandLineAttribute>() with
match tryGetAttribute<CustomCommandLineAttribute> (uci.GetCustomAttributes()) with
| None -> generateEnumName uci.Name
| Some attr -> attr.Name

Expand Down Expand Up @@ -280,18 +296,21 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
let current = ref None
let tryGetCurrent = fun () -> !current

let isNoCommandLine = lazy(uci.ContainsAttribute<NoCommandLineAttribute> (true))
let isAppSettingsCSV = lazy(uci.ContainsAttribute<ParseCSVAttribute> ())
let isExactlyOnce = lazy(uci.ContainsAttribute<ExactlyOnceAttribute> (true))
let isMandatory = lazy(isExactlyOnce.Value || uci.ContainsAttribute<MandatoryAttribute> (true))
let isUnique = lazy(isExactlyOnce.Value || uci.ContainsAttribute<UniqueAttribute> (true))
let isInherited = lazy(uci.ContainsAttribute<InheritAttribute> ())
let isGatherAll = lazy(uci.ContainsAttribute<GatherAllSourcesAttribute> ())
let isRest = lazy(uci.ContainsAttribute<RestAttribute> ())
let isHidden = lazy(uci.ContainsAttribute<HiddenAttribute> ())
let attributes = lazy(uci.GetCustomAttributes())
let declaringTypeAttributes = lazy(uci.DeclaringType.GetCustomAttributes(true))

let isNoCommandLine = lazy(hasAttribute2<NoCommandLineAttribute> attributes.Value declaringTypeAttributes.Value)
let isAppSettingsCSV = lazy(hasAttribute<ParseCSVAttribute> attributes.Value)
let isExactlyOnce = lazy(hasAttribute2<ExactlyOnceAttribute> attributes.Value declaringTypeAttributes.Value)
let isMandatory = lazy(isExactlyOnce.Value || hasAttribute2<MandatoryAttribute> attributes.Value declaringTypeAttributes.Value)
let isUnique = lazy(isExactlyOnce.Value || hasAttribute2<UniqueAttribute> attributes.Value declaringTypeAttributes.Value)
let isInherited = lazy(hasAttribute<InheritAttribute> attributes.Value)
let isGatherAll = lazy(hasAttribute<GatherAllSourcesAttribute> attributes.Value)
let isRest = lazy(hasAttribute<RestAttribute> attributes.Value)
let isHidden = lazy(hasAttribute<HiddenAttribute> attributes.Value)

let mainCommandName = lazy(
match uci.TryGetAttribute<MainCommandAttribute> () with
match tryGetAttribute<MainCommandAttribute> attributes.Value with
| None -> None
| Some _ when isNoCommandLine.Value -> arguExn "parameter '%O' contains conflicting attributes 'MainCommand' and 'NoCommandLine'." uci
| Some _ when types.Length = 0 -> arguExn "parameter '%O' contains MainCommand attribute but has unsupported arity 0." uci
Expand All @@ -304,7 +323,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
let isMainCommand = lazy(Option.isSome mainCommandName.Value)

let cliPosition = lazy(
match uci.TryGetAttribute<CliPositionAttribute> () with
match tryGetAttribute<CliPositionAttribute> attributes.Value with
| Some attr ->
match attr.Position with
| CliPosition.Unspecified
Expand All @@ -314,7 +333,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
| None -> CliPosition.Unspecified)

let customAssignmentSeparator = lazy(
match uci.TryGetAttribute<CustomAssignmentAttribute> (true) with
match tryGetAttribute2<CustomAssignmentAttribute> attributes.Value declaringTypeAttributes.Value with
| Some attr ->
if isMainCommand.Value && types.Length = 1 then
arguExn "parameter '%O' of arity 1 contains incompatible attributes 'CustomAssignment' and 'MainCommand'." uci
Expand All @@ -329,7 +348,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
| None -> None)

let isGatherUnrecognized = lazy(
if uci.ContainsAttribute<GatherUnrecognizedAttribute>() then
if hasAttribute<GatherUnrecognizedAttribute> attributes.Value then
match types with
| _ when isMainCommand.Value -> arguExn "parameter '%O' contains incompatible combination of attributes 'MainCommand' and 'GatherUnrecognized'." uci
| [|t|] when t = typeof<string> -> true
Expand All @@ -338,7 +357,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
false)

let appSettingsSeparators, appSettingsSplitOptions =
match uci.TryGetAttribute<AppSettingsSeparatorAttribute> (true) with
match tryGetAttribute2<AppSettingsSeparatorAttribute> attributes.Value declaringTypeAttributes.Value with
| None -> [|","|], StringSplitOptions.None
| Some attr when attr.Separators.Length = 0 ->
arguExn "parameter '%O' specifies a null or empty AppSettings separator." uci
Expand Down Expand Up @@ -408,23 +427,23 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
if isMainCommand.Value || isNoCommandLine.Value then []
else
let cliNames = [
match uci.TryGetAttribute<CustomCommandLineAttribute> () with
| None -> yield generateOptionName uci
match tryGetAttribute<CustomCommandLineAttribute> attributes.Value with
| None -> yield generateOptionName uci attributes.Value declaringTypeAttributes.Value
| Some attr -> yield attr.Name ; yield! attr.AltNames

yield!
uci.GetAttributes<AltCommandLineAttribute>()
|> Seq.collect (fun attr -> attr.Names)
attributes.Value
|> Array.collect(function | :? AltCommandLineAttribute as a -> a.Names | _ -> [||])
]

for name in cliNames do validateCliParam name

cliNames)

let appSettingsName = lazy(
if uci.ContainsAttribute<NoAppSettingsAttribute> (true) then None
if hasAttribute2<NoAppSettingsAttribute> attributes.Value declaringTypeAttributes.Value then None
else
match uci.TryGetAttribute<CustomAppSettingsAttribute> () with
match tryGetAttribute<CustomAppSettingsAttribute> attributes.Value with
| None -> Some <| generateAppSettingsName uci
| Some _ when parsers.Value.Type = ArgumentType.SubCommand -> arguExn "CustomAppSettings in %O not supported in subcommands." uci
| Some attr when not <| String.IsNullOrWhiteSpace attr.Name -> Some attr.Name
Expand All @@ -437,9 +456,9 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
| [] when isMainCommand.Value ->
match parsers.Value with
| Primitives ps ->
let name = ps |> Seq.map (fun p -> sprintf "<%s>" p.Description) |> String.concat " "
let name = ps |> Seq.map (fun p -> "<" + p.Description + ">" ) |> String.concat " "
if isRest.Value then name + "..." else name
| ListParam(_,p) -> sprintf "<%s>..." p.Description
| ListParam(_,p) -> "<" + p.Description + ">..."
| _ -> arguExn "internal error in argu parser representation %O." uci
| _ when Option.isSome appSettingsName.Value -> appSettingsName.Value.Value
| _ -> arguExn "parameter '%O' needs to have at least one parse source." uci)
Expand Down
34 changes: 0 additions & 34 deletions src/Argu/Utils.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -137,40 +137,6 @@ type IDictionary<'K,'V> with

let currentProgramName = lazy(System.Diagnostics.Process.GetCurrentProcess().MainModule.ModuleName)

type UnionCaseInfo with
member uci.GetAttributes<'T when 'T :> Attribute> (?includeDeclaringTypeAttrs : bool) =
let includeDeclaringTypeAttrs = defaultArg includeDeclaringTypeAttrs false

let caseAttrs = uci.GetCustomAttributes typeof<'T> |> Seq.cast<Attribute>
let attrs =
if includeDeclaringTypeAttrs then
uci.DeclaringType.GetCustomAttributes(typeof<'T>, false)
|> Seq.cast<Attribute>
|> Seq.append caseAttrs
else
caseAttrs

attrs |> Seq.map (fun o -> o :?> 'T)

member uci.TryGetAttribute<'T when 'T :> Attribute> (?includeDeclaringTypeAttrs : bool) =
let includeDeclaringTypeAttrs = defaultArg includeDeclaringTypeAttrs false

match uci.GetCustomAttributes typeof<'T> with
| [||] when includeDeclaringTypeAttrs ->
match uci.DeclaringType.GetCustomAttributes(typeof<'T>, false) |> Seq.toArray with
| [||] -> None
| attrs -> Some (attrs.[0] :?> 'T)
| [||] -> None
| attrs -> Some (attrs.[0] :?> 'T)

member uci.ContainsAttribute<'T when 'T :> Attribute> (?includeDeclaringTypeAttrs : bool) =
let includeDeclaringTypeAttrs = defaultArg includeDeclaringTypeAttrs false
if uci.GetCustomAttributes typeof<'T> |> Array.isEmpty |> not then true
elif includeDeclaringTypeAttrs then
uci.DeclaringType.GetCustomAttributes(typeof<'T>, false) |> Seq.isEmpty |> not
else
false

/// recognize exprs that strictly contain DU constructors
/// e.g. <@ Case @> is valid but <@ fun x y -> Case y x @> is invalid
let expr2Uci (e : Expr) =
Expand Down