flake.nix

@@ -15,11 +15,17 @@
       let
         pkgs = nixpkgs.legacyPackages.${system};
 
-        overlay = final: prev: { hcat = final.callCabal2nix "hcat" ./. { }; };
+        haskellPackages = pkgs.haskell.packages.ghc924;
 
-        haskellPackages = pkgs.haskell.packages.ghc924.extend overlay;
+        jailbreakUnbreak = pkg:
+          pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
+
+        packageName = "hcat";
       in {
-        packages.default = haskellPackages.hcat;
+        packages.${packageName} =
+          haskellPackages.callCabal2nix packageName self { };
+
+        packages.default = self.packages.${system}.${packageName};
 
         apps = {
           # run with: nix run #.hcat
@@ -56,7 +62,7 @@
         devShells.default = haskellPackages.shellFor {
           inherit (self.checks.${system}.pre-commit-check) shellHook;
 
-          packages = p: [ p.hcat ];
+          packages = _: [ self.packages.${system}.default ];
 
           withHoogle = true;
 

hcat.cabal

@@ -20,7 +20,6 @@ library
       HCat
       HCat.FileInfo
       HCat.Internal
-      HCat.Metrics
       HCat.Screen
       HCat.StatusLine
   other-modules:
@@ -34,7 +33,6 @@ library
   ghc-options: -Wall -fdefer-typed-holes
   build-depends:
       base >=4.13 && <5
-    , containers
     , directory
     , process
     , text
@@ -54,7 +52,6 @@ executable hcat
   ghc-options: -Wall -fdefer-typed-holes
   build-depends:
       base >=4.13 && <5
-    , containers
     , directory
     , hcat
     , time
@@ -76,7 +73,6 @@ test-suite doctest
       doctest:doctest
   build-depends:
       base >=4.13 && <5
-    , containers
     , directory
     , process
     , time
@@ -101,7 +97,6 @@ test-suite spec
   build-depends:
       QuickCheck
     , base >=4.13 && <5
-    , containers
     , directory
     , hcat
     , hspec

package.yaml

@@ -13,7 +13,6 @@ dependencies:
   - base >= 4.13 && < 5
   - time
   - directory
-  - containers
 #  - bytestring
 
 ghc-options:

src/HCat/Metrics.hs

@@ -1,101 +0,0 @@
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE RecordWildCards #-}
-
--- | Define some metrics
-module HCat.Metrics where
-
-import Control.Exception (SomeException, try)
-
-import Data.Time.Clock (diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds)
-
-import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
-import Data.Map.Merge.Strict qualified as Merge
-import Data.Map.Strict (Map, singleton)
-import Data.Map.Strict qualified as Map
-import Data.Monoid
-
-data Metrics = Metrics
-  { metricSuccessCount :: Sum Int
-  , metricFailureCount :: Sum Int
-  , metricCallDuration :: Timings
-  }
-  deriving (Show, Eq)
-
-newtype Timings = Timings {getTimings :: Map String (Sum Int)}
-  deriving (Show) via Map String (Sum Int)
-  deriving (Eq, Ord)
-
-prettyMetrics :: Metrics -> String
-prettyMetrics Metrics{..} =
-  unlines
-    [ "success: " <> prettySuccess
-    , "failure: " <> prettyFailure
-    , "timings: " <> "\n" <> prettyTimings
-    ]
- where
-  prettySuccess = show . getSum $ metricSuccessCount
-  prettyFailure = show . getSum $ metricFailureCount
-  prettyTimings = unlines . fmap (indentation . prettyTiming) $ Map.toList (getTimings metricCallDuration)
-
-  prettyTiming (name, duration) = name <> ": " <> (show . getSum $ duration)
-
-  indentation :: String -> String
-  indentation = (<>) "   "
-
-merge :: (Semigroup v, Ord k) => Map k v -> Map k v -> Map k v
-merge = Merge.merge Merge.preserveMissing Merge.preserveMissing (Merge.zipWithMatched (const (<>)))
-
-instance Semigroup Timings where
-  (Timings lhs) <> (Timings rhs) = Timings $ lhs `merge` rhs
-
-instance Monoid Timings where
-  mempty = Timings mempty
-
-instance Semigroup Metrics where
-  (Metrics a b c) <> (Metrics a' b' c') = Metrics (a <> a') (b <> b') (c <> c')
-
-instance Monoid Metrics where
-  mempty = Metrics mempty mempty mempty
-
-success :: Metrics
-success = Metrics (Sum 1) mempty mempty
-
-failure :: Metrics
-failure = Metrics mempty (Sum 1) mempty
-
-timing :: String -> Int -> Metrics
-timing name duration = Metrics mempty mempty (Timings $ singleton name (Sum duration))
-
-newtype MetricsRef = MetricsRef (IORef Metrics)
-
-newMetrics :: IO MetricsRef
-newMetrics = MetricsRef <$> newIORef mempty
-
-storeMetric :: Metrics -> MetricsRef -> IO ()
-storeMetric m (MetricsRef r) = modifyIORef r (m <>)
-
-countSuccess :: MetricsRef -> IO ()
-countSuccess = storeMetric success
-
-countFailure :: MetricsRef -> IO ()
-countFailure = storeMetric failure
-
-countTiming :: MetricsRef -> String -> Int -> IO ()
-countTiming metrics name duration = storeMetric (timing name duration) metrics
-
-accountFor :: MetricsRef -> String -> IO a -> IO (Either SomeException a)
-accountFor metrics name action = do
-  startTime <- getCurrentTime
-  result <- try action
-  endTime <- getCurrentTime
-  let duration = floor . nominalDiffTimeToSeconds $ diffUTCTime endTime startTime
-  _ <- case result of
-    Left _ -> countFailure metrics
-    Right _ -> countSuccess metrics
-  countTiming metrics name duration
-  pure result
-
-printMetrics :: MetricsRef -> IO ()
-printMetrics (MetricsRef metrics) = do
-  m <- readIORef metrics
-  putStr $ prettyMetrics m