homura-stopwatch (empty) → 0.1.3

raw patch · 7 files changed

+182/−0 lines, 7 filesdep +basedep +homura-stopwatchdep +hourglasssetup-changed

Dependencies added: base, homura-stopwatch, hourglass, split

Files

ChangeLog.md +3/−0
LICENSE +21/−0
README.md +35/−0
Setup.hs +2/−0
app/Main.hs +6/−0
homura-stopwatch.cabal +54/−0
src/Lib.hs +61/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for homura-stopwatch++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License Copyright (c) 2020 ncaq++Permission is hereby granted, free of+charge, to any person obtaining a copy of this software and associated+documentation files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use, copy, modify, merge,+publish, distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to the+following conditions:++The above copyright notice and this permission notice+(including the next paragraph) shall be included in all copies or substantial+portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF+ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO+EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

+ README.md view

@@ -0,0 +1,35 @@+# homura-stopwatch++input++~~~shell+echo "+10:30 10:40 tvirus+10:40 12:28 icbm+12:28 14:59 gsomia+15:41 15:57 gsomia+15:57 16:35 panzer+16:35 17:17 icbm+17:17 17:28 gsomia+17:28 18:15 icbm+18:15 18:42 gsomia+18:42 19:44 icbm+19:44 20:04 gsomia+20:04 21:10 icbm+22:10 23:27 icbm" | homura-stopwatch+~~~++output++~~~shell+tvirus	0:10+icbm	6:42+gsomia	3:45+panzer	0:38+~~~++区切りは`\n`でも`,`でもOKです.++~~~shell+echo "10:30 10:40 tvirus, 10:40 12:28 icbm, 12:28 14:59 gsomia, 15:41 15:57 gsomia, 15:57 16:35 panzer, 16:35 17:17 icbm, 17:17 17:28 gsomia, 17:28 18:15 icbm, 18:15 18:42 gsomia, 18:42 19:44 icbm, 19:44 20:04 gsomia, 20:04 21:10 icbm, 22:10 23:27 icbm" | homura-stopwatch+~~~

+ Setup.hs view

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

+ app/Main.hs view

@@ -0,0 +1,6 @@+module Main where++import           Lib (appMain)++main :: IO ()+main = appMain

+ homura-stopwatch.cabal view

@@ -0,0 +1,54 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 3be341d8b5700047d9fa3c6406ff3e05ff4e7f275daf4fab10484f878e52000f++name:           homura-stopwatch+version:        0.1.3+description:    Please see the README on GitHub at <https://github.com/ncaq/homura-stopwatch#readme>+homepage:       https://github.com/ncaq/homura-stopwatch#readme+bug-reports:    https://github.com/ncaq/homura-stopwatch/issues+author:         ncaq+maintainer:     ncaq@ncaq.net+copyright:      © ncaq+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/ncaq/homura-stopwatch++library+  exposed-modules:+      Lib+  other-modules:+      Paths_homura_stopwatch+  hs-source-dirs:+      src+  ghc-options: -Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-exported-signatures -Wmissing-home-modules -Wredundant-constraints -Wcompat+  build-depends:+      base >=4.7 && <5+    , hourglass+    , split+  default-language: Haskell2010++executable homura-stopwatch+  main-is: Main.hs+  other-modules:+      Paths_homura_stopwatch+  hs-source-dirs:+      app+  ghc-options: -Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-exported-signatures -Wmissing-home-modules -Wredundant-constraints -Wcompat -O2 -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , homura-stopwatch+    , hourglass+    , split+  default-language: Haskell2010

+ src/Lib.hs view

@@ -0,0 +1,61 @@+{-# LANGUAGE LambdaCase #-}+module Lib ( appMain ) where++import           Data.Hourglass+import           Data.List+import           Data.List.Split+import           Text.Read+import           Time.System++data Work+  = Work+  { workName :: String -- ^ この程度の効率を気にしないプログラムでTextを持ち出すのは面倒になった+  , workTime :: Seconds+  }+  deriving (Eq, Ord, Read, Show)++appMain :: IO ()+appMain = do+  contents <- getContents+  date <- dtDate <$> dateCurrent+  works <- mapM (\case Left msg -> fail msg -- もうちょい綺麗に書けないかな, fromRightは何故かダメでした…+                       Right work -> pure work+                ) $ parseWork date <$> wordsBy (\c -> c == ',' || c == '\n') contents+  putStr $ workgroupPrettyStr $ collectWorkGroup works++parseWork :: Date -> String -> Either String Work+parseWork date str+  = case words str of+      startStr : endStr : tl ->+        let parse source = case splitOn ":" source of+              [hs, ss] -> do+                h <- readMaybe hs+                s <- readMaybe ss+                pure $ DateTime date $ TimeOfDay{todHour = Hours h, todMin = Minutes s, todSec = 0, todNSec = 0}+              _ -> Nothing+            leftParse s =  Left $ "次の時刻表記が認識できませんでした: " <> s+        in case (parse startStr, parse endStr) of+          (Just workStart, Just workEnd) -> Right $ Work{workName = concat tl, workTime = workEnd `timeDiff` workStart}+          (Nothing, Just _) -> leftParse startStr+          (Just _, Nothing) -> leftParse endStr+          (Nothing, Nothing) -> leftParse $ startStr <> " && " <> endStr+      _ -> Left $ "文字列を認識できませんでした: " <> str++collectWorkGroup :: [Work] -> [Work]+collectWorkGroup = foldr addWork []++addWork :: Work -> [Work] -> [Work]+addWork work works = case find (\w -> workName w == workName work) works of+  Nothing -> work : works+  Just progressWork+    -> Work{workName = workName work, workTime = workTime progressWork + workTime work} :+       progressWork `delete` works++workgroupPrettyStr :: [Work] -> String+workgroupPrettyStr works = unlines (workPrettyStr <$> works)++workPrettyStr :: Work -> String+workPrettyStr work+  = case fromSeconds (workTime work) of+      (d, 0) -> workName work <> "\t" <> show (toInteger $ durationHours d) <> ":" <> show (toInteger $ durationMinutes d)+      o -> error $ "出力がヘンになりました: " <> show o