From 007c2c303d727727f1755ac7911fe995fad098e0 Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Sun, 29 Mar 2015 14:33:49 +0900
Subject: initial commit: rewriting srem in Haskell

---
 src/Data/Maybe/Read.hs |  8 ++++++++
 src/Main.hs            |  1 +
 src/Types/Reminder.hs  | 40 +++++++++++++++++++++++++++++++++++++
 src/Utility/Emacs.hs   | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 103 insertions(+)
 create mode 100644 src/Data/Maybe/Read.hs
 create mode 100644 src/Main.hs
 create mode 100644 src/Types/Reminder.hs
 create mode 100644 src/Utility/Emacs.hs

(limited to 'src')

diff --git a/src/Data/Maybe/Read.hs b/src/Data/Maybe/Read.hs
new file mode 100644
index 0000000..909dc9c
--- /dev/null
+++ b/src/Data/Maybe/Read.hs
@@ -0,0 +1,8 @@
+module Data.Maybe.Read (readMaybe) where
+
+-- readMaybe function from "Learn You a Haskell"
+
+readMaybe    :: (Read a) => String -> Maybe a
+readMaybe st = case reads st of
+    [(x,"")] -> Just x
+    _        -> Nothing
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..15e8a5a
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1 @@
+import Types.Reminder
diff --git a/src/Types/Reminder.hs b/src/Types/Reminder.hs
new file mode 100644
index 0000000..5a1f7a5
--- /dev/null
+++ b/src/Types/Reminder.hs
@@ -0,0 +1,40 @@
+module Types.Reminder ( Reminder
+                      , makeReminder
+                      , getReminderHour
+                      , getReminderMinute
+                      , getReminderText
+                      ) where
+
+type Hour   = Int
+type Minute = Int
+
+data Reminder = Reminder { getReminderHour :: Hour
+                         , getReminderMinute :: Minute
+                         , getReminderText :: String}
+              deriving (Eq, Ord)
+
+instance Show Reminder where
+    show (Reminder h m s) =
+        (show . to12Hour) h
+        ++ ":" ++ (zeroPadTime . show) m
+        ++ amPm h ++ " " ++ s
+
+makeReminder :: Hour -> Minute -> String -> Maybe Reminder
+makeReminder h m s = if   h `elem` [0..23] && m `elem` [0..59]
+                     then return $ Reminder h m s
+                     else fail "invalid reminder"
+
+zeroPadTime   :: String -> String
+zeroPadTime t = if   length t < 2
+                then '0' : t
+                else t
+
+to12Hour :: Int -> Int
+to12Hour h = if   h > 12
+             then h - 12
+             else h
+
+amPm :: Int -> String
+amPm h = if   h > 12
+         then "pm"
+         else "am"
diff --git a/src/Utility/Emacs.hs b/src/Utility/Emacs.hs
new file mode 100644
index 0000000..27f0830
--- /dev/null
+++ b/src/Utility/Emacs.hs
@@ -0,0 +1,54 @@
+module Utility.Emacs ( getEmacsOutput
+                     , parseEmacsOutput) where
+
+import           Control.Applicative ((<$>))
+import           Control.Monad       (when, foldM)
+import           Data.Maybe.Read
+import           System.Directory    (getHomeDirectory)
+import           System.Process      (readProcess)
+import           Text.Regex.Posix    ((=~))
+import           Types.Reminder
+
+parseEmacsOutput :: String -> [Reminder]
+parseEmacsOutput = foldr step [] . drop 2 . lines
+  where
+    step line rems = maybe rems (++ rems) $ parseLine line
+
+parseLine              :: String -> Maybe [Reminder]
+parseLine line         = do
+    when (not lineMatch) $ fail ""
+    let hStr:mStr:s:[] = drop 1 . concat $ lineMatchStrings
+    h <- readMaybe hStr
+    m <- readMaybe mStr
+    staggeredReminders =<< makeReminder h m s
+  where
+    apptRegexp         = " ([0-9]{1,2}):([0-9][0-9])[-]{0,1}[0-9:]{0,5}[.]* (.*)$"
+    snipRegexp         = "[ ]{2,}:.*:*$"
+
+    lineMatch        = line =~ apptRegexp :: Bool
+    lineMatchStrings = line =~ apptRegexp :: [[String]]
+
+staggeredReminders   :: Reminder -> Maybe [Reminder]
+staggeredReminders r = undefined
+
+-- staggeredReminders :: Int -> Int -> String -> [Reminder]
+-- staggeredReminders hour mins text = foldl' step [] [60, 15, 0]
+--   where step rems diff = let hour'
+--                                | diff > mins = hour - 1
+--                                | otherwise = hour
+--                              -- could do with addition mod 60
+--                              mins'
+--                                | mins >= diff = mins - diff
+--                                | otherwise = 60 + (mins - diff)
+--                          in rems ++ [Reminder hour' mins' text]
+
+getEmacsOutput :: IO String
+getEmacsOutput = do
+    args <- makeEmacsArgs <$> getHomeDirectory
+    readProcess "emacs" args ""
+
+makeEmacsArgs      :: String -> [String]
+makeEmacsArgs home = [ "-batch"
+                     , "-l", home ++ "/.emacs.d/init.el"
+                     , "-eval", "(setq org-agenda-sticky nil)"
+                     , "-eval", "(org-batch-agenda \"D\")" ]
-- 
cgit v1.2.3