sandwatch (empty) → 0.1.1.0

raw patch · 8 files changed

+289/−0 lines, 8 filesdep +aesondep +atomic-writedep +basesetup-changed

Dependencies added: aeson, atomic-write, base, bytestring, criterion-measurement, directory, process, sandwatch, text, time

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• Main.hs +43/−0
• README.md +38/−0
• Setup.hs +2/−0
• sandwatch.cabal +65/−0
• src/MyLib.hs +102/−0
• test/MyLibTest.hs +4/−0

@@ -0,0 +1,5 @@+# Revision history for sandwatch++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2020, Shae Erisson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Shae Erisson nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Criterion.Measurement+import Criterion.Measurement.Types (Measured (..), nfAppIO)+import qualified Data.Text.Lazy as T+import Data.Time (getCurrentTime)+import MyLib+import Numeric+import System.Directory (getCurrentDirectory)+import System.Environment+import System.Process++-- | A sandwich takes five minutes according to my poll: https://twitter.com/shapr/status/1263950892744806402+sandwichSeconds :: Double+sandwichSeconds = 5 * 60++-- | How many words at the beginning of the command line to match?+wordsToMatch :: Int+wordsToMatch = 5++main :: IO ()+main = do+  history <- readSandWatchData+  args <- getArgs+  now <- getCurrentTime+  thiscwd <- getCurrentDirectory+  let thisRun = Run now (T.strip . T.pack $ unwords args) (T.pack thiscwd) 0 0 0 -- could I treat cmdline params as a Set?+  let guess = guessTime wordsToMatch history thisRun+  putStrLn $ "This command will probably take " <> formatFloat (guess / (5 * 60)) <> " sandwiches to complete."+  let bmark = nfAppIO callCommand (unwords args)+  (msr, _) <- measure bmark 1+  let thisRun' =+        thisRun+          { runTime = measTime msr,+            cpuTime = measCpuTime msr,+            cpuCycles = measCycles msr+          }+  writeSandWatchData $ Runs (thisRun' : rs history)+  putStrLn $ "Estimated time was " <> formatFloat (guess / (5 * 60)) <> " sandwiches, actual time was " <> formatFloat (measTime msr / sandwichSeconds) <> " sandwiches."+  where+    formatFloat f = showFFloat (Just 2) f ""

@@ -0,0 +1,38 @@+# sandwatch+Remember how long commands take, tell me if I have enough time to make a sandwich?++This is inspired by [arbtt](https://arbtt.nomeata.de/#what), the shell built-in time, and the rust utility [tally](https://crates.io/crates/tally).++The name was suggested by [qu1j0t3](https://github.com/qu1j0t3/).++# Why?++Rather than telling me how long something has taken, I would like to know roughly how long this task will take, based on historical records.++Sandwatch records the current directory, the command line, and the runtime for a command.++When running a new command that matches the directory and the first two words of the command line, sandwatch reports expected completion time in sandwich units (five minutes?).++# How to use it?++It's a wrapper command. `sandwatch cabal build` or `sandwatch make` or whatever you like. Perhaps one day this will become a shell builtin written in Rust.++# How to install it?++I suggest using [ghcup](https://www.haskell.org/ghcup/) to install the Haskell compiler and then `cabal build` in your clone of this git repo.++# How does it work?++Sandwatch creates a json file holding entries recording the working directory, the command line, and the execution time.++When a command matches in the same directory, execution from previous runs is average together to give you a rough idea as to whether you have time to make a sandwich or not!++# Tell me the root problem?++I don't have insight into the progress of a running program. I wish all programs would dump some number of percent complete events. I could use that to estimate completion time from start time.++# Ideas++* Is there a good way to turn command line arguments into a set? For example, `ls -o -a` is the same as `ls -a -o` but the strings are different. How could they be the same?+* Is there some good way to automatically figure out how much of a command line to compare for equality?+* How could I compare command lines for equality across directories? While `make` does different things in different directories, `apt install` is always the same. How do you decide?

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,65 @@+cabal-version:      >=1.10+category:           Command Line+name:               sandwatch+synopsis:           record historical command runtimes for later prediction+description:        track historical runtimes for this directory and command, predict if there's time for a sandwich on this run+version:            0.1.1.0+license:            BSD3+license-file:       LICENSE+author:             Shae Erisson+maintainer:         shae@scannedinavian.com+build-type:         Simple+extra-source-files:+  CHANGELOG.md+  README.md++library+  exposed-modules:  MyLib+  ghc-options:      -Wall -O2+  build-depends:+      aeson                  >=1.4.7.1 && < 2.2+    , atomic-write >= 0.2.0 && < 0.3+    , base                   >=4.14    && <4.20+    , bytestring >= 0.11 && < 0.12+    , criterion-measurement >= 0.2 && < 0.3+    , directory >= 1.3 && < 1.5+    , process >= 1.6 && < 1.7+    , text >= 2.0 && < 2.1+    , time >= 1.12 && < 1.13++  hs-source-dirs:   src+  default-language: Haskell2010++executable sandwatch+  main-is:          Main.hs+  ghc-options:      -Wall -O2+  build-depends:+      aeson                  >=1.4.7.1 && < 2.2+    , atomic-write >= 0.2.0 && < 0.3+    , base                   >=4.14    && <4.20+    , bytestring >= 0.11 && < 0.12+    , criterion-measurement >= 0.2 && < 0.3+    , directory >= 1.3 && < 1.5+    , process >= 1.6 && < 1.7+    , sandwatch+    , text >= 2.0 && < 2.1+    , time >= 1.12 && < 1.13++  default-language: Haskell2010++test-suite sandwatch-test+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          MyLibTest.hs+  ghc-options:      -Wall -O2+  build-depends:+      aeson                  >=1.4.7.1 && < 2.2+    , atomic-write >= 0.2.0 && < 0.3+    , base                   >=4.14    && <4.20+    , bytestring >= 0.11 && < 0.12+    , criterion-measurement >= 0.2 && < 0.3+    , directory >= 1.3 && < 1.5+    , process >= 1.6 && < 1.7+    , text >= 2.0 && < 2.1+    , time >= 1.12 && < 1.13

@@ -0,0 +1,102 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module MyLib where++import Data.Aeson+import Data.Aeson.Text+import qualified Data.ByteString as BS+import Data.Either+import Data.Int (Int64)+import qualified Data.Text.Lazy as T+import Data.Time+import GHC.Generics+import System.AtomicWrite.Writer.LazyText+import System.Directory (+    XdgDirectory (XdgData),+    createDirectoryIfMissing,+    doesFileExist,+    getXdgDirectory,+ )++someFunc :: IO ()+someFunc = putStrLn "someFunc"++-- datatype+data Run = Run+    { tstamp :: !UTCTime -- when was this run?+    , cmdline :: !T.Text -- what was the command?+    , cwd :: !T.Text+    , runTime :: !Double -- seconds of wall clock time+    , cpuTime :: !Double -- cpu seconds+    , cpuCycles :: !Int64 -- cpu cycles from rdtsc instruction+    }+    deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)++-- ugh, I wish there was an easier way, but whatever+data Runs = Runs+    { rs :: ![Run]+    }+    deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)++-- read and write data+readSandWatchData :: IO Runs+readSandWatchData = do+    sandWatchDataFile <- getSandWatchFilePath+    dataExists <- doesFileExist sandWatchDataFile+    if not dataExists+        then pure $ Runs []+        else do+            contents <- BS.readFile sandWatchDataFile+            pure $ fromRight (Runs []) (eitherDecodeStrict contents) -- failed to parse json? you get an empty history!++writeSandWatchData :: Runs -> IO ()+writeSandWatchData rs' = do+    sandWatchDataFile <- getSandWatchFilePath+    atomicWriteFile sandWatchDataFile (encodeToLazyText rs')++getSandWatchFilePath :: IO FilePath+getSandWatchFilePath = do+    sandWatchDir <- getXdgDirectory XdgData "sandwatch"+    createDirectoryIfMissing True sandWatchDir -- is this a bad place to do this?+    pure $ sandWatchDir <> "/runs"++-- analyze++{-+prefix match for estimate?+1. filter on cwd,+2. prefix match up to the first space+3. average the past matching runtimes+4. divide by five minutes+5. write out number of sandwiches estimated before running the command+-}+-- need to strip /home/shae/ and /Users/shae/ and whatever shows up on Windows?+-- whatever, do the thing and come back and clean up+filterByCWD :: Runs -> T.Text -> Runs+filterByCWD runs thiscwd = Runs $ filter (\r -> T.strip thiscwd == cwd r) (rs runs)++filterByFirstWord :: Runs -> T.Text -> Runs+filterByFirstWord runs thiscmdline = Runs $ filter (\r -> fstWord thiscmdline == fstWord (cmdline r)) (rs runs)+  where+    fstWord = fst . T.breakOn " "++-- "cabal build" for example+filterByFirstNWords :: Runs -> Int -> T.Text -> Runs+filterByFirstNWords runs n thiscmdline = Runs $ filter (\r -> fstWords n thiscmdline == fstWords n (cmdline r)) (rs runs)+  where+    fstWords n' c = take n' $ T.splitOn " " c++-- | expects historical runs, number of words to match, a Run that has cmdline and cwd populated+guessTime :: Int -> Runs -> Run -> Double+guessTime n pastruns thisrun = avgWallSeconds+  where+    runsInThisDir = filterByCWD pastruns (cwd thisrun)+    runsMatchingNWords = filterByFirstNWords runsInThisDir n (cmdline thisrun)+    wallTimes = runTime <$> rs runsMatchingNWords+    avgWallSeconds = sum wallTimes / fromIntegral (length wallTimes)++-- cycles = cpuCycles <$> (rs runsMatchingNWords)+-- avgCycles = sum cycles /+-- would need to promote this Int64 to Integer for the math to work out?

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."