htodo (empty) → 0.0.1

raw patch · 5 files changed

+175/−0 lines, 5 filesdep +HDBCdep +HDBC-sqlite3dep +basesetup-changed

Dependencies added: HDBC, HDBC-sqlite3, base

Files

• .travis.yml +1/−0
• LICENSE +31/−0
• Main.hs +100/−0
• Setup.lhs +7/−0
• htodo.cabal +36/−0

@@ -0,0 +1,1 @@+language: haskell

@@ -0,0 +1,31 @@+Copyright 2013 Yoichi Hirai+Copyright 2011 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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,100 @@+import System.IO (hPutStr, stderr, hFlush, stdout)+import System.Environment (getArgs, getEnv)+import Database.HDBC+import Database.HDBC.Sqlite3++main :: IO ()+main = getArgs >>= parse++parse :: [String] -> IO ()+parse ["add"] = with_db add+parse ["dump"] = with_db dump+parse [] = with_db pick+parse _ = urge_to_add++pick :: Connection -> IO ()+pick conn = do+  result <- quickQuery' conn "SELECT * FROM htodo WHERE waiting IS NULL LIMIT 1" []+  case result of+      [] -> urge_to_add+      [r] -> focus conn r+      _ -> undefined+++focus :: IConnection t => t -> [SqlValue] -> IO ()+focus conn [i,name,SqlNull] = do+  putStrLn $ fromSql name+  putStrLn "  d: done"+  putStrLn "  n: never doing"+  putStrLn "  w: waiting for another task"+  putStr "> "+  hFlush stdout+  command <- getLine+  case command of+    "d" -> remove i conn+    "n" -> remove i conn+    "w" -> add_wait i conn+    _   -> error "command not understood"+focus _ _ = error "should not happen"++remove :: IConnection conn => SqlValue -> conn -> IO ()+remove i conn = do+  _ <- run conn "UPDATE htodo SET waiting = NULL WHERE waiting = ?" [i]+  _ <- run conn "DELETE FROM htodo WHERE id = ?" [i]+  commit conn+  return ()++add_wait :: IConnection conn => SqlValue -> conn -> IO ()+add_wait i conn = do+  dump conn+  putStrLn "after which task?"+  putStr "> "+  hFlush stdout+  number <- getLine+  count <- quickQuery' conn "SELECT * FROM htodo WHERE id = ?" [toSql number]+  if ((count == []) || (toSql number == i)) then+     error "invalid task number specified"+     else do+       _ <- run conn "UPDATE htodo SET waiting = ? WHERE id = ?" [toSql number, i]+       commit conn++dump :: IConnection conn => conn -> IO ()+dump conn = do+  result <- quickQuery' conn "SELECT * FROM htodo ORDER BY id" []+  pp result+    where+      pp [] = return ()+      pp ([i,n,_]:tl) = do+        putStrLn $ fromSql i ++ ": " ++ fromSql n+        pp tl+      pp _ = error "should not happen"++add :: Connection -> IO ()+add conn = do+  putStr "a task to: "+  hFlush stdout+  task <- getLine+  _ <- run conn "INSERT INTO htodo (name, waiting) VALUES (?, ?)" [toSql task, SqlNull]+  commit conn+  return ()++db :: IO String+db = do+  home <- getEnv "HOME"+  return $ home ++ "/.htodo.db"++with_db :: (Connection -> IO ()) -> IO ()+with_db f = do+  conn <- db >>= connectSqlite3+  _ <- run conn schema []+  f conn+  disconnect conn++schema :: String+schema = "CREATE TABLE IF NOT EXISTS htodo (id INTEGER PRIMARY KEY, name TEXT, waiting INTEGER)"++urge_to_add :: IO ()+urge_to_add = do+  hPutStr stderr "usage\n"+  hPutStr stderr "htodo add: add a task\n"+  hPutStr stderr "htodo:     pick a task\n"

@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -0,0 +1,36 @@+name:          htodo+category:      Other+version:       0.0.1+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Yoichi Hirai+maintainer:    Yoichi Hirai <i@yoichihirai.com>+homepage:      http://github.com/pirapira/htodo+bug-reports:   http://github.com/pirapira/htodo/issues+copyright:     Copyright (C) 2013 Yoichi Hirai+synopsis:      A todo application.+description:   A todo application.+build-type:    Simple++extra-source-files: .travis.yml++source-repository head+  type: git+  location: git://github.com/pirapira/htodo.git++flag safe+  manual: True+  default: False++executable htodo+  build-depends:+    base       >= 3 && < 5,+    HDBC-sqlite3 >= 2.3.3.0,+    HDBC >= 2.3.1.2++  main-is:     Main.hs+  ghc-options: -Wall++  if flag(safe)+    cpp-options: -DSAFE