/
Engine.fs
118 lines (105 loc) · 4.58 KB
/
Engine.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
namespace GabeSoft.FOPS.Core
open System
type OperationException (message:string, ?innerException:Exception) =
inherit Exception (
message,
match innerException with | Some ex -> ex | None -> null)
/// Operations engine.
type Engine(server: IOServer, ?log:Log) =
let info, warn, fail =
let logger = match log with
| Some l -> l
| None -> new LogImpl () :> Log
logger.Info, logger.Warn, logger.Fail
let copy src dst = server.Provider.Copy (src, dst)
let link src dst = server.Provider.Link (src, dst)
let yank src = server.Provider.DeleteFile src
let yankd src = server.Provider.DeleteFolder (src, true)
let cinfo src dst = sprintf "copy: %s -> %s (DONE)" src dst |> info
let cwarn src dst reason = sprintf "copy: %s -> %s (%s)" src dst reason |> warn
let linfo src dst = sprintf "link: %s -> %s (DONE)" src dst |> info
let lwarn src dst reason = sprintf "link: %s -> %s (%s)" src dst reason |> warn
let yinfo src = sprintf "delete: %s (DONE)" src |> info
let ywarn src reason = sprintf "delete: %s (%s)" src reason |> warn
let ydinfo src = sprintf "delete-dir: %s (DONE)" src |> info
let ydwarn src reason = sprintf "delete-dir: %s (%s)" src reason |> warn
let yankPattern src =
let spec = {
Pattern = Wildcard.toRegex src
Exclude = []
Recursive = Wildcard.isRecursive src }
let node =
src
|> Wildcard.root
|> server.Node
|> Filter.apply spec
node.AllFiles |> Seq.iter (fun f ->
yank f.Path
yinfo f.Path)
let yankFolder src =
yankd src
match server.Provider.FolderExists src with
| true -> ydwarn src "DONE: some files could not be deleted"
| false -> ydinfo src
let copyFile (copy, info, warn) (src, dst, force) =
let exists = server.Provider.FileExists
let mkdir = server.Provider.CreateFolder
match exists dst, force with
| true, false -> warn src dst "SKIPPED: file already exists"
| e, _ -> dst |> Path.directory |> mkdir
copy src dst
match e with
| false -> info src dst
| true -> warn src dst "DONE: replaced"
let rec copyDeep (copy, info, warn) (fdst, force) (node:IONode) =
let src = node.Path
let dst = fdst src
match node.Type with
| FileNode -> copyFile (copy, info, warn) (src, dst, force)
| FolderNode ->
node.Files
|> Seq.append node.Folders
|> Seq.iter (copyDeep (copy, info, warn) (fdst, force))
| _ -> fail "unknown node type"
let copyFolder (copy, info, warn) (src, dst, force, excludes) =
let excludes = excludes |> List.map Wildcard.toRegex
let dstExists = server.Provider.FolderExists dst
let spec = {
Pattern = (Wildcard.matchAll src)
Exclude = (Wildcard.matchAll dst) :: excludes
Recursive = true }
let node = server.Node src |> Filter.apply spec
let fdst =
let dst = match dstExists with
| true -> Path.combine dst (Path.file src)
| false -> dst
fun path -> Path.combine dst (Path.part src path)
copyDeep (copy, info, warn) (fdst, force) node
let copyPattern (copy, info, warn) (src, dst, force, excludes) =
let excludes = excludes |> List.map Wildcard.toRegex
let spec = {
Pattern = (Wildcard.toRegex src)
Exclude = (Wildcard.matchAll dst) :: excludes
Recursive = Wildcard.isRecursive src }
let node = src |> Wildcard.root |> server.Node
let fdst path = Path.combine dst (Path.file path)
node.AllFiles |> Seq.iter (copyDeep (copy, info, warn) (fdst, force))
let runItem = function
| Copy (f, t, o, e, c) ->
match c with
| FileMode -> copyFile (copy, cinfo, cwarn) (f, t, o)
| FolderMode -> copyFolder (copy, cinfo, cwarn) (f, t, o, e)
| PatternMode -> copyPattern (copy, cinfo, cwarn) (f, t, o, e)
| Link (f, t, o, e, c) ->
match c with
| FileMode -> copyFile (link, linfo, lwarn) (f, t, o)
| FolderMode -> copyFolder (link, linfo, lwarn) (f, t, o, e)
| PatternMode -> copyPattern (link, linfo, lwarn) (f, t, o, e)
| Yank (s, t) ->
match t with
| FileMode -> fail "invalid mode for delete"
| FolderMode -> yankFolder s
| PatternMode -> yankPattern s
let runJob (job:Job) = Seq.iter runItem job.Items
member x.Run job = runJob job
member x.Run jobs = Seq.iter runJob jobs