practice-room (empty) → 0.0.0

raw patch · 8 files changed

+244/−0 lines, 8 filesdep +basedep +bytestringdep +data-defaultsetup-changed

Dependencies added: base, bytestring, data-default, directory, json, mps

Files

• LICENSE +31/−0
• Nemesis +34/−0
• Setup.lhs +4/−0
• changelog.md +0/−0
• known-issues.md +0/−0
• practice-room.cabal +27/−0
• src/Main.hs +112/−0
• src/PracticeRoom/Type.hs +36/−0

@@ -0,0 +1,31 @@+Copyright (c) <YEAR>, <OWNER>++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 <ORGANIZATION> 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,34 @@+nemesis = do+  +  clean+    [ "**/*.hi"+    , "**/*.o"+    , "manifest"+    ]+  +  +  desc "run"+  task "run" - do+    sh "runghc -isrc src/Main.hs"+  +  desc "ghci"+  task "i" - do+    sh "ghci -isrc src/Main.hs"+  +  desc "compile"+  task "c" - do+    sh "ghc --make -isrc src/Main.hs -o bin/practice-room"+  +  desc "prepare cabal dist"+  task "dist" - do+    sh "cabal clean"+    sh "cabal configure"+    sh "cabal sdist"++  desc "put all .hs files in manifest"+  task "manifest" - do+    sh "find . | grep 'hs$' > manifest"++  desc "show sloc"+  task "stat" - do+    sh "cloc -match-f=hs$ --quiet src"

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,27 @@+Name:                 practice-room+Version:              0.0.0+Build-type:           Simple+Synopsis:             Watch the practice time for whatever practice you are trying to make, e.g. a piano?+Description:          ++License:              BSD3+License-file:         LICENSE+Author:               Jinjing Wang+Maintainer:           Jinjing Wang+Build-Depends:        base+Cabal-version:        >= 1.2+category:             +homepage:             +data-files:           changelog.md, known-issues.md, Nemesis++Executable            practice-room+  ghc-options:        -Wall -threaded+  build-depends:      base >= 4 && < 5+                    , mps >= 2010.1.26+                    , bytestring+                    , directory+                    , data-default+                    , json+  hs-source-dirs:     src/+  other-modules:      PracticeRoom.Type+  main-is:            Main.hs

@@ -0,0 +1,112 @@+module Main where++import MPS.Env hiding (log)+import MPS.Extra (now, t2i)+import Prelude ()++import Data.Default+import Text.JSON.Generic++import PracticeRoom.Type+import System.Directory+import Control.Monad hiding (join)+import System.Environment+import Data.Maybe (isJust, isNothing)+import Text.Printf++import qualified Data.ByteString.Lazy.Char8 as B++++{-++usage:  practice-room start+        practice-room stop+        practice-room reset+          +-}++log :: String -> IO ()+log = putStrLn++config_file :: String+config_file = ".practice.json"++write_config :: Practice -> IO ()+write_config x = B.writeFile config_file - B.pack - x.encodeJSON++main :: IO ()+main = do+  exist <- doesFileExist config_file+  when (not exist) - do+    write_config def+  +  saved_config <- B.readFile config_file ^ B.unpack ^ decodeJSON+  +  return (saved_config :: Practice)+  +  args <- getArgs+  +  let+      dispatch [] = show_stats+      dispatch (x:_)+        | x.is "start" = start_practice+        | x.is "stop"  = stop_practice+        | x.is "reset" = reset_practice+        | otherwise    = show_help+      +      +      show_stats = do+        let total_time = saved_config.intervals.map (\x -> x.end_time + (-x.start_time)).sum+        +            hours = total_time `div` 3600+            minites = ( total_time `mod` 3600 ) `div` 60+            seconds = total_time `mod` 60+                +        log - printf "Practiced: %d hours, %d minites and %d seconds" hours minites seconds+        -- log - printf "Practiced: %d hours and %d minites" hours minites+        +        +        when ( saved_config.started.isJust ) - do+          log "Still practicing..."++      start_practice =+        if saved_config.started.isJust+          then+            log "already started"+          else do+            timestamp <- now ^ t2i+            write_config saved_config {started = Just timestamp}+            log "started"+        +      stop_practice = +        case saved_config.started of+          Nothing -> +            log "already stopped"+          Just saved_start_time -> do+            timestamp <- now ^ t2i+            let intervals' = saved_config.intervals+                new_interval = def { start_time = saved_start_time, end_time = timestamp }+            write_config saved_config { started = Nothing, intervals = new_interval : intervals' }+            log "stopped"+      +      reset_practice = do+        write_config def+        log "resetted"+      +      show_help = log help+        +  dispatch args++++help :: String+help = unlines - ++  [ "usage:  practice-room start"+  , "        practice-room stop "+  , "        practice-room reset"+  , "        practice-room      "+  , "                           "+  ]+

@@ -0,0 +1,36 @@+{-# LANGUAGE DeriveDataTypeable #-}++module PracticeRoom.Type where+++import Text.JSON.Generic+import Data.Default+++data PracticeInterval = PracticeInterval+  {+    start_time :: Integer+  , end_time :: Integer+  }+  deriving (Data, Typeable, Eq, Show)++instance Default PracticeInterval where+  def = PracticeInterval+    {+      start_time = def+    , end_time = def+    }++data Practice = Practice+  {+    intervals :: [PracticeInterval]+  , started :: Maybe Integer+  }+  deriving (Data, Typeable, Eq, Show)++instance Default Practice where+  def = Practice+    {+      intervals = def+    , started = def+    }