git.iko.soy/obelisk
on master help sign in
Use quasiquotes for ob profile command
f14f290Matthew Bauer
lib/command/src/Obelisk/Command/Run.hs+32−23
compare with master
unifiedsplit
@@ -4,6 +4,7 @@
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE TupleSections #-}
6{-# LANGUAGE TupleSections #-}
7+{-# LANGUAGE QuasiQuotes #-}
7module Obelisk.Command.Run where
8module Obelisk.Command.Run where
8
9
9import Control.Arrow ((&&&))
10import Control.Arrow ((&&&))
@@ -22,6 +23,7 @@ import Data.Map (Map)
22import qualified Data.Map as Map
23import qualified Data.Map as Map
23import Data.Maybe
24import Data.Maybe
24import qualified Data.Set as Set
25import qualified Data.Set as Set
26+import Data.String.Here (hereLit)
25import Data.Text (Text)
27import Data.Text (Text)
26import qualified Data.Text as T
28import qualified Data.Text as T
27import Data.Traversable (for)
29import Data.Traversable (for)
@@ -73,12 +75,6 @@ data CabalPackageInfo = CabalPackageInfo
73preprocessorIdentifier :: String
75preprocessorIdentifier :: String
74preprocessorIdentifier = "__preprocessor-apply-packages"
76preprocessorIdentifier = "__preprocessor-apply-packages"
75
77
76−-- | Imports needed to use Obelisk.Run
77−obRunImports :: [String]
78−obRunImports = [ "import qualified Obelisk.Run"
79− , "import qualified Frontend"
80− , "import qualified Backend" ]
81−
82profile
78profile
83 :: MonadObelisk m
79 :: MonadObelisk m
84 => FilePath
80 => FilePath
@@ -89,21 +85,32 @@ profile profileBaseName = withProjectRoot "." $ \root -> do
89 let -- Sane flags to enable by default, enable time profiling +
85 let -- Sane flags to enable by default, enable time profiling +
90 -- closure heap profiling.
86 -- closure heap profiling.
91 rtsFlags = [ "+RTS", "-p", "-po" <> profileBaseName, "-hc", "-RTS" ]
87 rtsFlags = [ "+RTS", "-p", "-po" <> profileBaseName, "-hc", "-RTS" ]
92− nixBuildExpr = unlines $
88+ nixBuildExpr = [hereLit|
93− [ "(with (import ./. {});"
89+with (import ./. {});
94− , "let"
90+let
95− , " exeSource = obelisk.nixpkgs.writeText \"ob-run\" ''"
91+ exeSource = obelisk.nixpkgs.writeText "ob-run" ''
96− , "module Main where"
92+module Main where
93+
97− , "import Control.Exception"
94+import Control.Exception
98− , "import Reflex.Profiled"
95+import Reflex.Profiled
99− , "import System.Environment" ]
96+import System.Environment
100− <> obRunImports <>
97+
98+import qualified Obelisk.Run
99+import qualified Frontend
100+import qualified Backend
101+
101− [ "main :: IO ()"
102+main :: IO ()
103+main = do
104+ args <- getArgs
105+ let port = read $ args !! 0
106+ assets = args !! 1
107+ profileFile = (args !! 2) <> ".rprof"
102− , "main = getArgs >>= \\args -> (Obelisk.Run.run (read (args !! 0)) (Obelisk.Run.runServeAsset (args !! 1)) Backend.backend Frontend.frontend) `finally` writeProfilingData \"" <> profileBaseName <> ".rprof\""
108+ Obelisk.Run.run port (Obelisk.Run.runServeAsset assets) Backend.backend Frontend.frontend `finally` writeProfilingData profileFile
103− , " '';"
109+ '';
104− , "in obelisk.nixpkgs.runCommand \"ob-run\" {"
110+in obelisk.nixpkgs.runCommand "ob-run" {
105− , " buildInputs = [ (profiled.ghc.ghcWithPackages (p: [ p.backend p.frontend])) ];"
111+ buildInputs = [ (profiled.ghc.ghcWithPackages (p: [ p.backend p.frontend])) ];
106− , "} \"ghc -x hs -prof -fno-prof-auto ${exeSource} -o $out\")" ]
112+} "ghc -x hs -prof -fno-prof-auto ${exeSource} -o $out"
113+|]
107 exePath <- nixCmd $ NixCmd_Build $ def
114 exePath <- nixCmd $ NixCmd_Build $ def
108 & nixBuildConfig_outLink .~ OutLink_None
115 & nixBuildConfig_outLink .~ OutLink_None
109 & nixCmdConfig_target .~ Target
116 & nixCmdConfig_target .~ Target
@@ -113,7 +120,7 @@ profile profileBaseName = withProjectRoot "." $ \root -> do
113 assets <- findProjectAssets root
120 assets <- findProjectAssets root
114 putLog Debug $ "Assets impurely loaded from: " <> assets
121 putLog Debug $ "Assets impurely loaded from: " <> assets
115 freePort <- getFreePort
122 freePort <- getFreePort
116− (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc exePath ([show freePort, T.unpack assets] <> rtsFlags)
123+ (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc exePath ([show freePort, T.unpack assets, profileBaseName] <> rtsFlags)
117 _ <- liftIO $ waitForProcess ph
124 _ <- liftIO $ waitForProcess ph
118 pure ()
125 pure ()
119
126
@@ -318,7 +325,9 @@ withGhciScript packageInfos pathBase f = do
318 [ ":set -F -pgmF " <> selfExe <> " -optF " <> preprocessorIdentifier <> " " <> unwords (map (("-optF " <>) . makeRelative pathBase . _cabalPackageInfo_packageFile) packageInfos)
325 [ ":set -F -pgmF " <> selfExe <> " -optF " <> preprocessorIdentifier <> " " <> unwords (map (("-optF " <>) . makeRelative pathBase . _cabalPackageInfo_packageFile) packageInfos)
319 , ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)
326 , ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)
320 , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
327 , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
321− ] <> obRunImports
328+ , "import qualified Obelisk.Run"
329+ , "import qualified Frontend"
330+ , "import qualified Backend" ]
322 withSystemTempDirectory "ob-ghci" $ \fp -> do
331 withSystemTempDirectory "ob-ghci" $ \fp -> do
323 let dotGhciPath = fp </> ".ghci"
332 let dotGhciPath = fp </> ".ghci"
324 liftIO $ writeFile dotGhciPath dotGhci
333 liftIO $ writeFile dotGhciPath dotGhci