-
Notifications
You must be signed in to change notification settings - Fork 1
/
ScatchWork.fsx
88 lines (65 loc) · 1.97 KB
/
ScatchWork.fsx
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
//ST-01
type TrnsSetIdCode =
| MotorCarrierLoadTender
let pTrnsSetIdCode : Parser<TrnsSetIdCode> = skipString "204" >>. preturn MotorCarrierLoadTender .>> pFSep
//ST-02
type TrnSetCtrlNo =
| TrnSetCtrlNo of string
let pCode : Parser<TrnSetCtrlNo> = anyString 3 |>> TrnSetCtrlNo .>> pRSep
type TransCode =
{ idCode : TrnsSetIdCode
ctrlNo : TrnSetCtrlNo}
let pctrl : Parser<TrnSetCtrlNo> = manyMinMaxSatisfy 4 9 (fun c -> isDigit c || isAsciiLetter c || isAnyOf "~" c) .>> pFSep |>> TrnSetCtrlNo
let pTransCode =
pipe2 pTrnsSetIdCode pCode (fun t c ->
{idCode = t
ctrlNo = c})
type ST = ST of TrnsSetIdCode * TrnSetCtrlNo * TransCode
let pST =
skipString "ST" >>. pFSep >>. pTrnsSetIdCode
>>= fun p ->
pCode
>>= fun q ->
pctrl
>>= fun r ->
pTransCode
>>= fun s ->
preturn (ST(p, q, s))
//N1-01
type EntId =
| BillToParty
let pEntId : Parser<EntId> = skipString "BT" >>. preturn BillToParty .>> pFSep
//N1-02
type Name =
| Name of string
let pName : Parser<Name> = manyMinMaxSatisfy 1 60 (isNoneOf "~") |>> Name .>> pFSep
//N1-03
type IdCodeQual =
| IdCodeQual of string
let pIdCodeQual : Parser<IdCodeQual> = stringReturn "93" IdCodeQual .>> pFSep
//N1-04
type IdCode =
| IdCode of string
let pIdCode : Parser<IdCode> =
manyMinMaxSatisfy 2 80 (isNoneOf "~") |>> IdCode .>> pRSep
type N1 = N1 of EntId * Name * IdCodeQual * IdCode
let pN1 =
skipString "N1" >>. pFSep >>. pEntId
>>= fun a ->
pName
>>= fun b ->
pIdCodeQual
>>= fun c ->
pIdCode
>>= fun d ->
preturn (N1(a, b, c, d))
// builder-name { expression }
let mapOption f opt =
match opt with
| None -> None
| Some x -> Some (f x)
let rec mapList f list =
match list with
| [] -> []
| head :: tail -> (f head) :: (mapList f tail)