@@ -4,6 +4,7 @@
44{-# LANGUAGE OverloadedStrings #-}
55{-# LANGUAGE ScopedTypeVariables #-}
66{-# LANGUAGE TupleSections #-}
7+{-# LANGUAGE QuasiQuotes #-}
78module Obelisk.Command.Run where
89
910import Control.Arrow ((&&&))
@@ -22,6 +23,7 @@ import Data.Map (Map)
2223import qualified Data.Map as Map
2324import Data.Maybe
2425import qualified Data.Set as Set
26+import Data.String.Here (hereLit)
2527import Data.Text (Text)
2628import qualified Data.Text as T
2729import Data.Traversable (for)
@@ -73,12 +75,6 @@ data CabalPackageInfo = CabalPackageInfo
7375preprocessorIdentifier :: String
7476preprocessorIdentifier = "__preprocessor-apply-packages"
7577
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−
8278profile
8379 :: MonadObelisk m
8480 => FilePath
@@ -89,21 +85,32 @@ profile profileBaseName = withProjectRoot "." $ \root -> do
8985 let -- Sane flags to enable by default, enable time profiling +
9086 -- closure heap profiling.
9187 rtsFlags = [ "+RTS", "-p", "-po" <> profileBaseName, "-hc", "-RTS" ]
92− nixBuildExpr = unlines $
93− [ "(with (import ./. {});"
94− , "let"
95− , " exeSource = obelisk.nixpkgs.writeText \"ob-run\" ''"
96− , "module Main where"
97− , "import Control.Exception"
98− , "import Reflex.Profiled"
99− , "import System.Environment" ]
100− <> obRunImports <>
101− [ "main :: IO ()"
102− , "main = getArgs >>= \\args -> (Obelisk.Run.run (read (args !! 0)) (Obelisk.Run.runServeAsset (args !! 1)) Backend.backend Frontend.frontend) `finally` writeProfilingData \"" <> profileBaseName <> ".rprof\""
103− , " '';"
104− , "in obelisk.nixpkgs.runCommand \"ob-run\" {"
105− , " buildInputs = [ (profiled.ghc.ghcWithPackages (p: [ p.backend p.frontend])) ];"
106− , "} \"ghc -x hs -prof -fno-prof-auto ${exeSource} -o $out\")" ]
88+ nixBuildExpr = [hereLit|
89+with (import ./. {});
90+let
91+ exeSource = obelisk.nixpkgs.writeText "ob-run" ''
92+module Main where
93+
94+import Control.Exception
95+import Reflex.Profiled
96+import System.Environment
97+
98+import qualified Obelisk.Run
99+import qualified Frontend
100+import qualified Backend
101+
102+main :: IO ()
103+main = do
104+ args <- getArgs
105+ let port = read $ args !! 0
106+ assets = args !! 1
107+ profileFile = (args !! 2) <> ".rprof"
108+ Obelisk.Run.run port (Obelisk.Run.runServeAsset assets) Backend.backend Frontend.frontend `finally` writeProfilingData profileFile
109+ '';
110+in obelisk.nixpkgs.runCommand "ob-run" {
111+ buildInputs = [ (profiled.ghc.ghcWithPackages (p: [ p.backend p.frontend])) ];
112+} "ghc -x hs -prof -fno-prof-auto ${exeSource} -o $out"
113+|]
107114 exePath <- nixCmd $ NixCmd_Build $ def
108115 & nixBuildConfig_outLink .~ OutLink_None
109116 & nixCmdConfig_target .~ Target
@@ -113,7 +120,7 @@ profile profileBaseName = withProjectRoot "." $ \root -> do
113120 assets <- findProjectAssets root
114121 putLog Debug $ "Assets impurely loaded from: " <> assets
115122 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)
117124 _ <- liftIO $ waitForProcess ph
118125 pure ()
119126
@@ -318,7 +325,9 @@ withGhciScript packageInfos pathBase f = do
318325 [ ":set -F -pgmF " <> selfExe <> " -optF " <> preprocessorIdentifier <> " " <> unwords (map (("-optF " <>) . makeRelative pathBase . _cabalPackageInfo_packageFile) packageInfos)
319326 , ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)
320327 , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
321− ] <> obRunImports
328+ , "import qualified Obelisk.Run"
329+ , "import qualified Frontend"
330+ , "import qualified Backend" ]
322331 withSystemTempDirectory "ob-ghci" $ \fp -> do
323332 let dotGhciPath = fp </> ".ghci"
324333 liftIO $ writeFile dotGhciPath dotGhci