{-# LANGUAGE DeriveDataTypeable #-}
--HaskerDeux
import System.Environment
import System.IO
import System.IO.Error
import System.Process
import Data.List
import Data.List.Split --need to install
import Data.Map
import Control.Monad
import Control.Applicative
import Data.Maybe
import Text.JSON --need to install for JSON
import Text.JSON.Generic --need to install for JSON
import Data.Time
import System.Time
import System.Locale (defaultTimeLocale)
import System.Directory
import Network.URI.Encode --need to install
--Note to self: to run you type `runhaskell haskerdeux.hs test "me" "this" "that"`, etc
dispatch :: String -> (String, [String]) -> IO()
dispatch "todos" = todos
dispatch "new" = new
dispatch "crossoff" = crossoff
dispatch "putoff" = putoff
dispatch "moveto" = moveto
dispatch "delete" = remove
main = do
(date:command:argList) <- getArgs
time <- getClockTime >>= toCalendarTime --https://wiki.haskell.org/Unix_tools/Date
let todays_date = formatCalendarTime defaultTimeLocale "%Y-%m-%d" time
let tomorrows_date = show (addDays 1 $ read todays_date::Data.Time.Day)
let todos_date | date == "today" = todays_date
| date == "tomorrow" = tomorrows_date
| otherwise = date
when ((command `elem` ["todos"] && Data.List.null argList) || (command `elem` ["new", "crossoff", "putoff", "delete"] && length argList == 1) || (command == "moveto" && length argList == 2)) $ do
token <- login
dispatch command (token, todos_date:argList)
readnetrc = do
home <- getHomeDirectory
netrc <- lines Control.Applicative.<$> readFile (home ++ "/.netrc")
let netrc' = dropWhile (not . ("teuxdeux" `isInfixOf`)) netrc
let (username, password) = if "login" `isInfixOf` head netrc'
-- if entry is on one line
then (getcred "login", getcred "password")
-- if entry is on multiple lines
else (last $ words $ netrc' !! 1, last $ words $ netrc' !! 2)
where getcred c = dropWhile (not . (c `isInfixOf`)) (words $ head netrc') !! 1
return (username, password)
curlget (token, date) = do
let curlheader = "X-CSRF-Token: " ++ token
body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "https://teuxdeux.com/api/v1/todos/calendar?begin_date="++date++"&end_date="++date] []
let ok = not ("Invalid CSRF Token" `isInfixOf` body)
if ok
then do
let tds = decodeJSON body :: [Teuxdeux]
let tdsf = Data.List.filter (\td -> current_date td == date && not (done td)) tds
return tdsf
else do
token <- relogin
curlget (token, date)
curlpost (token, [date, key, value, apiurl, okresponse]) number = do
let curlheader = "X-CSRF-Token: " ++ token
--Can be much improved, but will do for now:
json <- if isJust number
then do
tdsf <- curlget (token, date)
let itemid = Main.id $ tdsf!!(read (fromJust number)::Int)
let modjson = "{ \"ids\" : [\""++show itemid++"\"], \""++key++"\" : \""++value++"\"}"
return modjson
else do
--Can't just straight return these strings, need to let them first
let newjson = "{ \"current_date\" : \""++date++"\", \""++key++"\" : \""++value++"\"}"
return newjson
body <- readProcess "curl" ["-s", "-XPOST", apiurl, "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-H", "Content-Type: application/json", "-d", json] []
let ok = not ("Invalid CSRF Token" `isInfixOf` body)
if ok
then
if "done_updated_at" `isInfixOf` body
then putStrLn okresponse
else putStrLn "Uh Oh! Didn't work!"
else do
token <- relogin
curlpost (token, [date, key, value, apiurl, okresponse]) number
curldelete (token, [date, apiurl, okresponse]) number = do
tdsf <- curlget (token, date)
let itemid = Main.id $ tdsf!!(read number::Int)
let curlheader = "X-CSRF-Token: " ++ token
body <- readProcess "curl" ["-s", "-XDELETE", apiurl++show itemid, "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader] []
let ok = not ("Invalid CSRF Token" `isInfixOf` body)
if ok
then
if "done_updated_at" `isInfixOf` body
then putStrLn okresponse
else putStrLn "Uh Oh! Didn't work!"
else do
token <- relogin
curldelete (token, [date, apiurl, okresponse]) number
curlput (token, [date, json, apiurl, okresponse]) number = do
tdsf <- curlget (token, date)
let itemid = Main.id $ tdsf!!(read number::Int)
let curlheader = "X-CSRF-Token: " ++ token
body <- readProcess "curl" ["-s", "-XPUT", apiurl++show itemid, "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-H", "Content-Type: application/json", "-d", json] []
let ok = not ("Invalid CSRF Token" `isInfixOf` body)
if ok
then
if "done_updated_at" `isInfixOf` body
then putStrLn okresponse
else putStrLn "Uh Oh! Didn't work!"
else do
token <- relogin
curlput (token, [date, json, apiurl, okresponse]) number
getauthtoken body = do
let bodylines = lines body
let authline = dropWhile (not . ("authenticity_token" `isInfixOf`)) bodylines
let authwords = words $ head authline
let authtokenword = stripPrefix "value=\"" $ last authwords
let revauthtokenword = reverse $ fromJust authtokenword
let authtoken = reverse $ fromJust $ stripPrefix ">\"" revauthtokenword
return authtoken
login = do
username <- fmap fst readnetrc
password <- fmap snd readnetrc
home <- getHomeDirectory
savedtoken <- doesFileExist (home ++ "/.haskerdeux-token")
if savedtoken
then do
token <- readFile (home ++ "/.haskerdeux-token")
return token
else do
body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "https://teuxdeux.com/login"] []
token <- getauthtoken body
writeFile (home ++ "/.haskerdeux-token") token
let curlheader = "X-CSRF-Token: " ++ token
let curlpostfields = "username=" ++ username ++ "&password=" ++ password ++ "&authenticity_token=" ++ token
body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-d", curlpostfields, "https://teuxdeux.com/login"] []
return token
relogin = do
home <- getHomeDirectory
removeFile (home ++ "/.haskerdeux-token")
token <- login
return token
todos (token, [todos_date]) = do
tdsf <- curlget (token, todos_date)
putStr $ unlines $ zipWith (\n td -> show n ++ " - " ++ td) [0..] $ Data.List.map text tdsf --numbering from LYAH
new (token, [todos_date, todo]) = do
let encodedtodo = Network.URI.Encode.encode todo
curlpost (token, [todos_date, "text", todo, "https://teuxdeux.com/api/v1/todos/", "Added!"]) Nothing
crossoff (token, [todos_date, number]) =
curlput (token, [todos_date, "{ \"done\": true }", "https://teuxdeux.com/api/v1/todos/", "Crossed Off!"]) number
putoff (token, [todos_date, number]) = do
let tomorrows_date = show (addDays 1 $ read todos_date::Data.Time.Day)
curlpost (token, [todos_date, "current_date", tomorrows_date, "https://teuxdeux.com/api/v1/todos/reposition/", "Put Off!"]) (Just number)
moveto (token, [todos_date, number, new_date]) =
--TODO: Need to figure out moving to bottom of a list
curlpost (token, [todos_date, "current_date", new_date, "https://teuxdeux.com/api/v1/todos/reposition", "Moved!"]) (Just number)
remove (token, [todos_date, number]) =
curldelete (token, [todos_date, "https://teuxdeux.com/api/v1/todos/", "Deleted!"]) number
--Thanks to http://www.amateurtopologist.com/blog/2010/11/05/a-haskell-newbies-guide-to-text-json/ and http://hpaste.org/41263/parsing_json_with_textjson
data Teuxdeux = Teuxdeux {
id :: Integer,
current_date :: String,
text :: String,
done :: Bool
} deriving (Eq, Show, Data, Typeable)
--Another data type here probably for lists