129 lines
5.4 KiB
Standard ML
129 lines
5.4 KiB
Standard ML
val Validate = fn jsonstring =>
|
|
let
|
|
val Valid = fn jsonstring =>
|
|
let
|
|
val json = String.translate (fn #"\"" => "\\\""|n=>str n ) jsonstring ;
|
|
val textlength = (String.size json ) + 50 ;
|
|
val app = " jq -c '.' "
|
|
val fname = "/tmp/jsonval" ^ (String.extract (Time.toString (Posix.ProcEnv.time()),7,NONE) );
|
|
val shellCommand = "echo \"" ^ json ^ "\" | " ^ app
|
|
val me = ( Posix.FileSys.mkfifo (fname, Posix.FileSys.S.flags [ Posix.FileSys.S.irusr,Posix.FileSys.S.iwusr ] ) ;
|
|
Posix.Process.fork () ) ;
|
|
in
|
|
if (Option.isSome me) then
|
|
let
|
|
val fin =TextIO.openIn fname
|
|
in
|
|
( Posix.Process.sleep (Time.fromReal 0.1) ;
|
|
TextIO.inputN (fin,textlength) before
|
|
(TextIO.closeIn fin ; OS.FileSys.remove fname)
|
|
)
|
|
end
|
|
else
|
|
( OS.Process.system ( shellCommand ^ " > " ^fname ^ " 2>&1 ") ; (* remove fmt and validate *)
|
|
"done\n" before OS.Process.exit OS.Process.success )
|
|
end
|
|
val result = Valid jsonstring
|
|
in
|
|
if String.isPrefix "{" result then result else "JSON error\n"
|
|
end;
|
|
|
|
|
|
|
|
datatype ('a,'b) element = elem of 'a * 'b | markerb of int ; (* < internal structure v *)
|
|
datatype 'a content = value of 'a | block of ('a,'a content) element list | arr of 'a content list |marker of int ;
|
|
|
|
exception Dtype of string ;
|
|
val unarr = fn arr lst => lst | _ => (raise Dtype "unarr" ; []) ;
|
|
val unblock = fn block lst => lst | _ => (raise Dtype "unblock" ; []) ;
|
|
|
|
|
|
(* --- example loop to apply a function 'dothis', which returns type jvals, to the structure ---- *)
|
|
|
|
datatype jvals = St of string | It of IntInf.int | Rl of real | Bl of bool ; (* returned type by 'dothis' *)
|
|
|
|
val rec gothruAndDo = fn dothis => fn storedObject =>
|
|
let
|
|
val walk = fn elem ( n, value v) => elem (dothis n , value (dothis v) )
|
|
| elem ( n, block v) => elem (dothis n , block ( (gothruAndDo dothis) (rev (tl (rev v)))) )
|
|
| elem ( n, arr v) => elem (dothis n , arr ( List.map (block o (gothruAndDo dothis) o unblock) (rev (tl (rev v))) ) )
|
|
| _ => elem (St "", value (It (IntInf.fromInt ~1)))
|
|
in
|
|
List.map walk storedObject
|
|
end;
|
|
|
|
(* ------------------------------------ end of loop example ------------------------------------ *)
|
|
|
|
|
|
local
|
|
|
|
exception Dtype of string ;
|
|
val markbToInt = fn markerb NrChars => NrChars | _ => (raise Dtype "markerb!" ; ~1) ;
|
|
val markToInt = fn marker NrChars => NrChars | _ => (raise Dtype "marker!" ; ~1) ;
|
|
|
|
|
|
fun readarr rtag rc = fn #"]"::S => [ marker (List.length S) ] (* process array *)
|
|
| S => let val tmp = (rtag rc ("",S)) in (block tmp) ::
|
|
( readarr rtag rc ( List.drop (S,(List.length S) - markbToInt ( hd (rev tmp))) )) end ;
|
|
|
|
|
|
|
|
val rec readNaVa = fn rc : string * char list -> string content * char list => fn
|
|
("",[]) => []
|
|
| (sr,[]) => [ elem (sr, value "") ]
|
|
| (sr,#":":: #"["::S) =>
|
|
let val tmp = arr (readarr readNaVa rc S) in (* field is array *)
|
|
( elem (sr, tmp )) :: (readNaVa rc ("" , List.drop (S,(List.length S) - (markToInt (hd (rev(unarr tmp)))) ) ))
|
|
end
|
|
| (sr, #":":: #"{"::S) =>
|
|
let val tmp = readNaVa rc ("",S ) in (* field is object *)
|
|
( elem (sr, block tmp)) :: (readNaVa rc ("" , List.drop (S,(List.length S) -(markbToInt ( hd (rev tmp)))) ))
|
|
end
|
|
| (sr,#"}":: #","::S) => [ markerb (List.length S) ]
|
|
| (sr,#"}"::S) => [ markerb (List.length S) ]
|
|
| (sr,#":"::S) =>
|
|
let val tmp = rc ("",S) in (* field is basic *)
|
|
elem ( sr, #1 tmp) :: (readNaVa rc ("", #2 tmp ) )
|
|
end
|
|
| (sr,#","::S) => readNaVa rc (sr , S)
|
|
| (sr,#"{"::a::S) => readNaVa rc (sr^(str a) , S)
|
|
| (sr,a::S) => readNaVa rc (sr^(str a) , S) ; (* name field *)
|
|
|
|
val rec readcontent = fn
|
|
(sc,a::[]) => (value ( sc^(str a) ),[])
|
|
| (sc,#","::t) => (value sc , t)
|
|
| (sc, #"}"::t) => (value sc , #"}"::t)
|
|
| (sc, #"]"::t) => (value sc , #"]"::t)
|
|
| (sc, a::t) => readcontent( ( sc^(str a) ),t) ;
|
|
|
|
|
|
val putall = fn input =>
|
|
let
|
|
val rec put = fn
|
|
[] => ""
|
|
| (elem h)::t => (#1 h) ^ ":" ^ ( ( fn value x=> x
|
|
| block x => "{" ^ (put x )
|
|
| arr x => "[" ^ String.concat (( List.map (fn x=> "{"^( (put o unblock) x)^"," ) (rev (tl (rev x))))) ^ "]" ) (#2 h))
|
|
^ ","
|
|
^ (put t)
|
|
| (markerb h)::t => "}"
|
|
in
|
|
"{" ^ (put input)
|
|
end;
|
|
|
|
val commas = fn tok => fn S =>
|
|
( Substring.concatWith (str tok)
|
|
( List.map (Substring.dropr (fn x=> x= #"," ))
|
|
(Substring.tokens (fn x=> x= tok ) (Substring.full S) )) ) ^ (if tok = #"}" then str tok else "" )
|
|
|
|
|
|
in
|
|
|
|
val storeJsString = fn input =>
|
|
readNaVa readcontent ("" , String.explode ( Validate input ) )
|
|
|
|
val writeJS = fn storedStruct =>
|
|
( ( ( commas #"}" ) o ( commas #"]" ) o putall ) storedStruct )
|
|
|
|
end ;
|