Optimize initialization time

5 files changed, 30 insertions, 24 deletions

diff --git a/chelleport.cabal b/chelleport.cabal
index 1397a33..ceeb2af 100644
--- a/chelleport.cabal
+++ b/chelleport.cabal
@@ -9,11 +9,6 @@ build-type:      Simple
 synopsis:        Mouse control
 description:     Mouse control
 
-Flag release
-  Description: Release build options
-  Manual: True
-  Default: False
-
 common common-config
   default-extensions:
     ExplicitForAll
@@ -32,6 +27,7 @@ common common-config
   build-depends:
     base,
     text,
+    time,
     mtl == 2.3.1,
     sdl2 == 2.5.5.0,
     containers
@@ -41,9 +37,7 @@ common warnings
     -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns
     -Wunused-foralls -Wextra -Wno-unused-do-bind -Wname-shadowing
     -fwarn-tabs -fprint-explicit-foralls -fprint-explicit-kinds
-  extra-libraries: Xtst
-  if flag(release)
-    ghc-options: -O2 -Werror
+  extra-libraries: Xtst X11
 
 executable chelleport
   import: common-config, warnings
diff --git a/flake.nix b/flake.nix
index 4ede626..c28bd0e 100644
--- a/flake.nix
+++ b/flake.nix
@@ -25,6 +25,7 @@
           otherFiles = [
             { source = ./static; target = "static"; }
           ];
+          configurationFlags = [ "--ghc-options=-O2" ];
         in {
           haskellProjects.default = {
             inherit projectRoot;
@@ -32,20 +33,21 @@
             packages = {};
             settings = {
               chelleport = {
+                check = true;
                 deadCodeElimination = true;
                 staticLibraries = true;
-                # extraBuildFlags = ["+release"];
                 strip = true;
-                custom = drv: drv.overrideAttrs(old: {
-                  preBuild = ''
-                    ${toString (map (f: ''cp -r ${f.source} ${f.target};'') otherFiles)}
-                  '';
-                });
+                custom = drv:
+                  (pkgs.haskell.lib.compose.appendConfigureFlags configurationFlags drv).overrideAttrs (old: {
+                    preBuild = ''
+                      ${toString (map (f: ''cp -r ${f.source} ${f.target};'') otherFiles)}
+                    '';
+                  })
+                ;
               };
             };
 
             devShell = {
-              # tools = hp: { fourmolu = hp.fourmolu; ghcid = null; };
               hlsCheck.enable = false;
             };
 
diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs
index 382f61e..8f8a19d 100644
--- a/src/Chelleport/AppShell.hs
+++ b/src/Chelleport/AppShell.hs
@@ -24,6 +24,7 @@ instance (MonadIO m) => MonadAppShell (AppM m) where
     SDL.destroyRenderer $ ctxRenderer ctx
     SDL.destroyWindow $ ctxWindow ctx
     releaseMouseButton
+    SDL.quit
     liftIO $ do
       X11.closeDisplay $ ctxX11Display ctx
       exitSuccess
diff --git a/src/Chelleport/Context.hs b/src/Chelleport/Context.hs
index 15c0b6a..3c2c850 100644
--- a/src/Chelleport/Context.hs
+++ b/src/Chelleport/Context.hs
@@ -3,6 +3,8 @@ module Chelleport.Context (initializeContext) where
 import Chelleport.Types
 import Data.ByteString (ByteString)
 import Data.FileEmbed (embedFileRelative)
+-- import Data.Time.Clock.System
+-- import qualified Debug.Trace as Debug
 import Foreign.C (CFloat)
 import qualified Graphics.X11 as X11
 import SDL (($=))
@@ -15,10 +17,18 @@ windowOpacity = 0.5
 fontSize :: Int
 fontSize = 24
 
+-- benchmark :: String -> IO a -> IO a
+-- benchmark msg m = do
+--   start <- systemNanoseconds <$> getSystemTime
+--   result <- m
+--   end <- systemNanoseconds <$> getSystemTime
+--   Debug.traceM $ msg ++ ": " ++ show (end - start)
+--   pure result
+
 initializeContext :: IO DrawContext
 initializeContext = do
   -- Initialize SDL
-  SDL.initializeAll
+  SDL.initialize [SDL.InitVideo, SDL.InitEvents]
   TTF.initialize
 
   window <- initializeWindow
@@ -60,6 +70,4 @@ initializeWindow = do
             SDL.windowInitialSize = SDL.V2 0 0,
             SDL.windowBorder = False
           }
-  window <- SDL.createWindow "Chelleport" windowCfg
-  SDL.showWindow window
-  pure window
+  SDL.createWindow "Chelleport" windowCfg
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index 4007bdc..069e49c 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -22,7 +22,7 @@ render state = do
     when visible $ do
       renderTargetPoints state (rowIndex, colIndex)
 
-renderKeySequence ::(MonadDraw m) => KeySequence -> Cell -> (CInt, CInt) -> m Bool
+renderKeySequence :: (MonadDraw m) => KeySequence -> Cell -> (CInt, CInt) -> m Bool
 renderKeySequence keySequence cell (px, py) = do
   let (matched, remaining)
         | keySequence `isPrefixOf` cell = splitAt (length keySequence) cell
@@ -33,9 +33,10 @@ renderKeySequence keySequence cell (px, py) = do
         | isNotEmpty matched = Just colorHighlight
         | otherwise = Nothing
 
-  previousTextWidth <- if isNotEmpty matched
-    then fst <$> drawText (px, py) colorLightGray (Text.pack matched)
-    else pure 0
+  previousTextWidth <-
+    if isNotEmpty matched
+      then fst <$> drawText (px, py) colorLightGray (Text.pack matched)
+      else pure 0
 
   when (isNotEmpty remaining) $ case textColor of
     Just color -> do
@@ -67,7 +68,7 @@ renderGridLines state = do
   drawHorizontalLine (rows * hcell `div` 2)
   drawVerticalLine (columns * wcell `div` 2)
 
-renderTargetPoints :: (MonadDraw m) =>State -> (CInt, CInt) -> m ()
+renderTargetPoints :: (MonadDraw m) => State -> (CInt, CInt) -> m ()
 renderTargetPoints state (row, col) = do
   (wcell, hcell) <- cellSize state
   let (x, y) = (col * wcell + wcell `div` 2, row * hcell + hcell `div` 2)