Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Comment: | Add back in "new" todo functionality.
Now, finally, has the same functionality it did four years ago! But is a messy piece of crap. In fact it's pretty horrible, but it works Things of note: - Remembered why I needed Just/Maybe on the curlpost |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | origin/issue1 | trunk | master |
Files: | files | file ages | folders |
SHA3-256: |
5927c4835de5cacd9801024ee9abdc0b |
User & Date: | base@atomicules.co.uk 2016-12-02 23:28:23 |
2016-12-03
| ||
00:07 | Update README to reflect it works again check-in: 02acc587fc user: base@atomicules.co.uk tags: master, origin/issue1, trunk | |
2016-12-02
| ||
23:28 |
Add back in "new" todo functionality.
Now, finally, has the same functionality it did four years ago! But is a messy piece of crap. In fact it's pretty horrible, but it works Things of note: - Remembered why I needed Just/Maybe on the curlpost | |
2016-11-27
| ||
21:43 |
Enable putoff and moveto commands
This is an utter mess and soooooo unhaskelly, but nearly back to the I'm most miserable about the passing of args to curlpost. Ideally I'd The other thing I need to do is to do is make it so the resposition Maybe one day I can make this better. check-in: 57b994daa8 user: base@atomicules.co.uk tags: master, origin/issue1, trunk | |
Changes to haskerdeux.hs.
︙ | ︙ | |||
12 13 14 15 16 17 18 | 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 | < < | < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | 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 "today" = today dispatch "new" = new dispatch "crossoff" = crossoff dispatch "putoff" = putoff dispatch "moveto" = moveto dispatch "delete" = remove main = do time <- getClockTime >>= toCalendarTime --https://wiki.haskell.org/Unix_tools/Date let todays_date = formatCalendarTime defaultTimeLocale "%Y-%m-%d" time (command:argList) <- getArgs if (command == "today" && Data.List.null argList) || (command `elem` ["new", "crossoff", "putoff", "delete"] && length argList == 1) || (command == "moveto" && length argList == 2) |
︙ | ︙ | |||
66 67 68 69 70 71 72 | --body <- curlGetString "https://teuxdeux.com/api/list.json" opts1 let tds = decodeJSON body :: [Teuxdeux] let tdsf = Data.List.filter (\td -> current_date td == todays_date && not (done td)) tds return tdsf curlpost (token, [todays_date, key, value, apiurl, okresponse]) number = do | < < > > > > | > > > > > | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | --body <- curlGetString "https://teuxdeux.com/api/list.json" opts1 let tds = decodeJSON body :: [Teuxdeux] let tdsf = Data.List.filter (\td -> current_date td == todays_date && not (done td)) tds return tdsf curlpost (token, [todays_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, todays_date) let itemid = Main.id $ tdsf!!(read (fromJust number)::Int) let modjson = "{ \"ids\" : [\""++(show itemid)++"\"], \""++key++"\" : \""++value++"\"}" return modjson else do --Can just straight return these strings, need to let them first let newjson = "{ \"current_date\" : \""++todays_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] [] --just check body contains stuff? --putStrLn body if isInfixOf "done_updated_at" body then putStrLn okresponse else putStrLn "Uh Oh! Didn't work!" |
︙ | ︙ | |||
145 146 147 148 149 150 151 | today (token, [todays_date]) = do tdsf <- curlget (token, todays_date) putStr $ unlines $ zipWith (\n td -> show n ++ " - " ++ td) [0..] $ Data.List.map text tdsf --numbering from LYAH | | > | | | | | < < | | | | 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 | today (token, [todays_date]) = do tdsf <- curlget (token, todays_date) putStr $ unlines $ zipWith (\n td -> show n ++ " - " ++ td) [0..] $ Data.List.map text tdsf --numbering from LYAH new (token, [todays_date, todo]) = do --Need to figure out min to post, start_date or current_date let encodedtodo = Network.URI.Encode.encode todo curlpost (token, [todays_date, "text", todo, "https://teuxdeux.com/api/v1/todos/", "Added!"]) Nothing crossoff (token, [todays_date, number]) = curlput (token, [todays_date, "{ \"done\": true }", "https://teuxdeux.com/api/v1/todos/", "Crossed Off!"]) number putoff (token, [todays_date, number]) = do let tomorrows_date = show (addDays 1 $ read todays_date::Data.Time.Day) curlpost (token, [todays_date, "current_date", tomorrows_date, "https://teuxdeux.com/api/v1/todos/reposition/", "Put Off!"]) (Just number) moveto (token, [todays_date, number, new_date]) = do --TODO: Need to figure out moving to bottom of a list curlpost (token, [todays_date, "current_date", new_date, "https://teuxdeux.com/api/v1/todos/reposition", "Moved!"]) (Just number) remove (token, [todays_date, number]) = curldelete (token, [todays_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) |