HaskerDeux

Check-in [6b4d755c96]
Login
Home Timeline Branches Tags Tickets Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:hlint changes

- Duplication between curldelete and curlput still exists, but I think is
legitimate.
- Also, I'm really not sure use of Control.Applicative makes
it any more readable, but I'll go with it.
- Would also be nice if I could get all the isInfixOf the same

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | origin/issue1 | trunk | master
Files: files | file ages | folders
SHA3-256: 6b4d755c96bb515aae4b3f462c6aa73dc7fe6869ce6e187dc2ca043abdc49e53
User & Date: base@atomicules.co.uk 2016-12-04 15:09:43
Context
2016-12-04
15:43
Be consistent with how isInfixOf is used check-in: bec4f0a542 user: base@atomicules.co.uk tags: origin/issue1, trunk, master
15:09
hlint changes

- Duplication between curldelete and curlput still exists, but I think is
legitimate.
- Also, I'm really not sure use of Control.Applicative makes
it any more readable, but I'll go with it.
- Would also be nice if I could get all the isInfixOf the same check-in: 6b4d755c96 user: base@atomicules.co.uk tags: origin/issue1, trunk, master

2016-12-03
00:07
Update README to reflect it works again check-in: 02acc587fc user: base@atomicules.co.uk tags: origin/issue1, trunk, master
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to haskerdeux.hs. 

5
6
7
8
9
10
11

12
13
14
15
16
17
18
..
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

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 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
................................................................................
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)
		then do
			username <- fmap fst readnetrc
			password <- fmap snd readnetrc
			token <- login [username, password]
			dispatch command (token, todays_date:argList)
		else
			return()
			--I can't be bothered to do credentials any other way than .netrc


readnetrc = do
	home <- getHomeDirectory
	netrc <- fmap lines $ readFile (home ++ "/.netrc")
	let netrc' = dropWhile (not . isInfixOf "teuxdeux") 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 . isInfixOf c) (words $ head netrc') !! 1
................................................................................
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!"


curldelete (token, [todays_date, apiurl, okresponse]) number = do
	tdsf <- curlget (token, todays_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] []
    --putStrLn okresponse
	return()
	-- what does the response say?
    -- if respCurlCode resp == CurlOK && respStatus resp == 200
    -- 	then putStrLn okresponse
    -- 	else putStrLn "Uh Oh! Didn't work!"

................................................................................
	tdsf <- curlget (token, todays_date)
	--Need some way to post the body.
	--Need headers for posting json "Content-Type: application/json"
	-- -d ""
	let itemid = Main.id $ tdsf!!(read number::Int)
	--let curlpostfields = return $ CurlPostFields [json] --try json here
	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] []
	--how to check response? For now that will make parsing hard so let it fail
	--just check body contains stuff?
	if isInfixOf "done_updated_at" body
		then putStrLn okresponse
		else putStrLn "Uh Oh! Didn't work!"

getauthtoken body = do
	let bodylines = lines body
	let authline = dropWhile (not . isInfixOf "authenticity_token") bodylines
	let authwords = words $ head authline
................................................................................

login [username, password] = do
	--See if we have a token, then to clear we can just delete the file
	home <- getHomeDirectory
	--handle error
	check <- doesFileExist (home ++ "/.haskerdeux-token")
	if check
		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
			--can probably use one post?
			let curlheader = "X-CSRF-Token: " ++ token
			let curlpostfields = "username=" ++ username ++ "&password=" ++ password ++ "&authenticity_token=" ++ token
................................................................................


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









>







 







|
<
|
|
|
|
<
<
<




|







 







|








|








|







 







|


|







 







|
|
<







 







|








5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
29
30
31
32
33
34
35
36

37
38
39
40



41
42
43
44
45
46
47
48
49
50
51
52
..
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
...
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
...
127
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

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
................................................................................
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
	when ((command == "today" && Data.List.null argList) || (command `elem` ["new", "crossoff", "putoff", "delete"] && length argList == 1) || (command == "moveto" && length argList == 2)) $ do

		username <- fmap fst readnetrc
		password <- fmap snd readnetrc
		token <- login [username, password]
		dispatch command (token, todays_date:argList)





readnetrc = do
	home <- getHomeDirectory
	netrc <- lines Control.Applicative.<$> readFile (home ++ "/.netrc")
	let netrc' = dropWhile (not . isInfixOf "teuxdeux") 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 . isInfixOf c) (words $ head netrc') !! 1
................................................................................
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 "done_updated_at" `isInfixOf` body
		then putStrLn okresponse
		else putStrLn "Uh Oh! Didn't work!"


curldelete (token, [todays_date, apiurl, okresponse]) number = do
	tdsf <- curlget (token, todays_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] []
    --putStrLn okresponse
	return()
	-- what does the response say?
    -- if respCurlCode resp == CurlOK && respStatus resp == 200
    -- 	then putStrLn okresponse
    -- 	else putStrLn "Uh Oh! Didn't work!"

................................................................................
	tdsf <- curlget (token, todays_date)
	--Need some way to post the body.
	--Need headers for posting json "Content-Type: application/json"
	-- -d ""
	let itemid = Main.id $ tdsf!!(read number::Int)
	--let curlpostfields = return $ CurlPostFields [json] --try json here
	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] []
	--how to check response? For now that will make parsing hard so let it fail
	--just check body contains stuff?
	if "done_updated_at" `isInfixOf` body
		then putStrLn okresponse
		else putStrLn "Uh Oh! Didn't work!"

getauthtoken body = do
	let bodylines = lines body
	let authline = dropWhile (not . isInfixOf "authenticity_token") bodylines
	let authwords = words $ head authline
................................................................................

login [username, password] = do
	--See if we have a token, then to clear we can just delete the file
	home <- getHomeDirectory
	--handle error
	check <- doesFileExist (home ++ "/.haskerdeux-token")
	if check
		then
			readFile (home ++ "/.haskerdeux-token")

		else do
			body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "https://teuxdeux.com/login"] []
			token <- getauthtoken body
			writeFile (home ++ "/.haskerdeux-token") token
			--can probably use one post?
			let curlheader = "X-CSRF-Token: " ++ token
			let curlpostfields = "username=" ++ username ++ "&password=" ++ password ++ "&authenticity_token=" ++ token
................................................................................


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]) =
	--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

This page was generated in about 0.011s by Fossil 2.10 [9d9ef82234] 2019-10-04 21:41:13