Verified Commit 59d2e47c authored by Camil Staps's avatar Camil Staps 🚀

Copy supporting CSS and JS into the generated HTML to create a standalone file

parent a9291252
......@@ -10,6 +10,8 @@ import System.CommandLine
import System.File
import System.FilePath
import System.Options
import System.OS
import System._Pointer
from Text import class Text(concat,join), instance Text String, <+
import qualified Text.HTML
......@@ -47,10 +49,18 @@ Start w
| isError profile
= exit ("Could not parse input: "+++fromError profile) w
# profile = prepare args.min_cumulative_ticks args.exclude (fromOk profile)
# (css,w) = readFile (exec_directory </> "profile.css") w
| isError css
= exit ("Could not open supporting CSS: "+++toString (fromError css)) w
# css = fromOk css
# (js,w) = readFile (exec_directory </> "profile.js") w
| isError js
= exit ("Could not open supporting JavaScript: "+++toString (fromError js)) w
# js = fromOk js
# (ok,f,w) = fopen args.output FWriteText w
| not ok
= exit "Could not open output file" w
# f = f <<< profile
# f = write_profile css js profile f
# (_,w) = fclose f w
= w
where
......@@ -93,15 +103,14 @@ where
# (_,w) = fclose (stderr <<< err <<< '\n') w
= setReturnCode -1 w
instance <<< Profile
where
<<< f p
write_profile :: !String !String !Profile !*File -> *File
write_profile css js p f
# f = f <<< "<!DOCTYPE html>"
<<< "<html lang=\"en\">"
<<< "<head>"
<<< "<title>Profile</title>"
<<< "<meta charset=\"utf-8\">"
<<< "<link rel=\"stylesheet\" type=\"text/css\" href=\"profile.css\">"
<<< "<style type=\"text/css\">" <<< css <<< "</style>"
<<< "</head>"
<<< "<body>"
<<< "<div class=\"header\">"
......@@ -114,7 +123,7 @@ where
<<< "</div>"
# f = write_stack p p.profile f
= f
<<< "<script defer=\"defer\" src=\"profile.js\"></script>"
<<< "<script>" <<< js <<< "</script>"
<<< "</body>"
<<< "</html>"
......@@ -169,3 +178,72 @@ where
}
where
wi = toInt (w * 10000.0)
exec_directory :: String
exec_directory =: takeDirectory (IF_LINUX get_linux (IF_WINDOWS get_windows get_macosx))
where
get_linux
# buf = createArray 8192 '\0'
# n = readlink "/proc/self/exe\0" (get_string_pointer buf) 8192
| n<0 || n>=8192
= abort "exec_directory failed\n"
= buf % (0,n-1)
where
readlink :: !String !Pointer !Int -> Int
readlink _ _ _ = code {
ccall readlink "spI:I"
}
get_windows
# buf = createArray 8192 '\0'
# n = GetModuleFileNameA 0 (get_string_pointer buf) 8192
| n==0
= abort "exec_directory failed"
= buf % (0,n-1)
where
GetModuleFileNameA :: !Int !Pointer !Int -> Int
GetModuleFileNameA _ _ _ = code {
ccall GetModuleFileNameA "IpI:I"
}
get_macosx
# buf = createArray 8192 '\0'
# bufp = get_string_pointer buf
# sz = createArray 1 8192
# n = get_executable_path bufp (get_array_pointer sz)
| n<>0
= abort "exec_directory failed\n"
# buf2 = createArray 8192 '\0'
# buf2p = get_string_pointer buf2
# r = realpath bufp buf2p
| r<>r || buf.[0]=='\0' || buf2.[0]=='\0' /* keep buf and buf2 in memory */
= abort "exec_directory failed\n"
= derefString buf2p
where
get_executable_path :: !Pointer !Pointer -> Int
get_executable_path _ _ = code {
ccall _NSGetExecutablePath "pp:I"
}
realpath :: !Pointer !Pointer -> Pointer
realpath _ _ = code {
ccall realpath "pp:p"
}
get_string_pointer :: !String -> Pointer
get_string_pointer arr = get arr + IF_INT_64_OR_32 16 8
where
get :: !String -> Pointer
get _ = code {
push_a_b 0
pop_a 1
}
get_array_pointer :: !{#Int} -> Pointer
get_array_pointer arr = get arr + IF_INT_64_OR_32 24 12
where
get :: !{#Int} -> Pointer
get _ = code {
push_a_b 0
pop_a 1
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment