-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMain.hs
190 lines (169 loc) · 7.75 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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
56
57
58
59
60
61
62
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
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
187
188
189
190
{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, OverloadedStrings, CPP #-}
module Main where
import Graphics.PDF (
Color, Draw, PDFText, AnyFont, black, strokeColor, fillColor, setFont, textStart, renderMode,
getHeight, leading, Color(Rgb), black, displayText, startNewLine, author, PDFFont(PDFFont),
compressed, stroke, Line(Line), runPdf, addPage, newSection, drawWithPage, TextMode(FillText),
drawText, PDFRect(PDFRect), FontName(Times_Roman), standardDocInfo, PDF
)
import Data.Text (Text, pack, unpack)
import qualified Person
import Person (Person(Person), name)
import Prelude hiding (foldr, length)
import Data.Vector (Vector, foldr, imapM, length)
import qualified Timesheet
import Timesheet (Timesheet(Timesheet))
import OutVoice (OutVoice(OutVoice), rate, client_name, timesheet_file)
import Utils (formatMoney, paginate, escapeSpaces)
import Config (loadConfig, AppConfig(AppConfig, userArgs), timesheets, me, client, font, issueDate, dueDate, invoiceNumber)
import Control.Monad (when)
import Text.Printf (printf)
import System.FilePath ((</>))
kingFisherDaisy :: Color
kingFisherDaisy = Rgb 0.32 0.11 0.52
setColor :: Color -> Draw ()
setColor color = do
strokeColor color
fillColor color
displayLine :: Text -> PDFText ()
displayLine t = do
displayText t
startNewLine
drawLine :: PDFFont -> Text -> Double -> Double -> Draw ()
drawLine theFont@(PDFFont f s) text x y = do
drawText $ do
setFont theFont
textStart x y
leading $ getHeight f s + 3
renderMode FillText
displayText text
drawLines :: PDFFont -> [Text] -> Double -> Double -> Draw [()]
drawLines theFont@(PDFFont f s) lines x y = do
drawText $ do
setFont theFont
textStart x y
leading $ getHeight f s + 3
renderMode FillText
mapM displayLine lines
renderMyInfo :: Person -> AnyFont -> Double -> Double -> Draw [()]
renderMyInfo person timesRoman x y = do
setColor black
let font = PDFFont timesRoman 10
let nameAndNumber = fmap (\f -> f person) [Person.name, Person.telephone]
drawLines font nameAndNumber x y
drawLines font (Person.addressFields person) (x+90) y
renderClientInfo :: Person -> AnyFont -> Double -> Double -> Draw [()]
renderClientInfo client timesRoman x y = do
let font = PDFFont timesRoman 10
setColor kingFisherDaisy
drawLine font "Billed To" x y
setColor black
let fields = Person.name client : Person.addressFields client
drawLines font fields x (y-13)
renderTitledLine :: AnyFont -> Text -> Text -> Double -> Double -> Draw ()
renderTitledLine fontType title line x y = do
let font = PDFFont fontType 10
setColor kingFisherDaisy
drawLine font title x y
setColor black
drawLine font line x (y - 13)
renderAmountDue :: AnyFont -> Text -> Text -> Double -> Double -> Draw ()
renderAmountDue fontType title line x y = do
setColor kingFisherDaisy
drawLine (PDFFont fontType 10) title x y
setColor black
drawLine (PDFFont fontType 19) line x (y - 17)
renderRow :: AnyFont -> Double -> Double -> Int -> Timesheet -> Draw ()
renderRow fontType rate yInit i timesheetItem = do
setColor black
let date = Timesheet.date timesheetItem
y = yInit - (fromIntegral i :: Double) * 65.00
client = Timesheet.client timesheetItem
project = Timesheet.project timesheetItem
description = "(" ++ client ++ " - " ++ project ++ ") - " ++ date
hours = Timesheet.hours timesheetItem
drawLine (PDFFont fontType 10) (pack "Time") 30 y
drawLine (PDFFont fontType 9) (pack description) 30 (y - 12)
drawLine (PDFFont fontType 9) (pack (Timesheet.task timesheetItem ++ " -")) 30 (y - 22)
drawLine (PDFFont fontType 8) (pack (Timesheet.notes timesheetItem)) 30 (y - 34)
drawLine (PDFFont fontType 8) (pack $ "$" ++ formatMoney rate) 400 y
drawLine (PDFFont fontType 8) (pack (show hours)) 460 y
drawLine (PDFFont fontType 8) (pack $ "$" ++ formatMoney (rate * hours)) 520 y
setColor $ Rgb 0.9 0.9 0.9
stroke $ Line 30 (y - 45) 580 (y - 45)
renderFooter :: AnyFont -> Text -> Double -> Draw ()
renderFooter timesRoman amountDue y = do
let leftX = 420
zeroAmount = pack $ formatMoney 0.00
setColor black
drawLine (PDFFont timesRoman 10) (pack "Subtotal") leftX y
drawLine (PDFFont timesRoman 10) amountDue 530 y
drawLine (PDFFont timesRoman 10) (pack "Tax") leftX (y - 16)
drawLine (PDFFont timesRoman 10) zeroAmount 530 (y - 16)
setColor $ Rgb 0.9 0.9 0.9
stroke $ Line 340 (y - 28) 580 (y - 28)
setColor black
drawLine (PDFFont timesRoman 10) (pack "Total") leftX (y - 44)
drawLine (PDFFont timesRoman 10) amountDue 530 (y - 44)
drawLine (PDFFont timesRoman 10) (pack "Amount Paid") leftX (y - 60)
drawLine (PDFFont timesRoman 10) zeroAmount 530 (y - 60)
setColor $ Rgb 0.9 0.9 0.9
stroke $ Line 340 (y - 74) 580 (y - 74)
stroke $ Line 340 (y - 76) 580 (y - 76)
setColor kingFisherDaisy
drawLine (PDFFont timesRoman 12) (pack "Amount Due") leftX (y - 94)
setColor black
drawLine (PDFFont timesRoman 10) amountDue 530 (y - 94)
renderHeader :: AnyFont -> AppConfig -> Text -> Double -> OutVoice -> Draw ()
renderHeader timesRoman config amountDue height userArgs = do
renderMyInfo (me config) timesRoman 400 (height-60)
renderClientInfo (client config) timesRoman 30 (height-200)
renderTitledLine timesRoman "Date of Issue" (pack $ show $ issueDate config) 180 (height-200)
renderTitledLine timesRoman "Due Date" (pack $ show $ dueDate config) 180 (height-240)
renderTitledLine timesRoman "Invoice Number" (pack $ printf "%07d" $ invoiceNumber config) 280 (height-200)
setColor kingFisherDaisy
stroke $ Line 30 (height-280) 580 (height-280)
drawLine (PDFFont timesRoman 9) (pack "Description") 30 (height-300)
drawLine (PDFFont timesRoman 9) (pack "Rate") 400 (height-300)
drawLine (PDFFont timesRoman 9) (pack "Qty") 460 (height-300)
drawLine (PDFFont timesRoman 9) (pack "Line Total") 520 (height-300)
renderAmountDue timesRoman "Amount Due" amountDue 480 (height-200)
renderPage :: AppConfig -> [Vector Timesheet] -> Text -> OutVoice -> Double -> Vector Timesheet -> PDF ()
renderPage config allEntries amountDue userArgs height pageEntries = do
let isFirstPage = pageEntries == head allEntries
isLastPage = pageEntries == last allEntries
rowYInit = if isFirstPage then height - 320 else height - 60
y = rowYInit - (fromIntegral (length pageEntries + 1) :: Double) * 65.00
maxRows = if isFirstPage then 6 else 11
isEnoughSpaceForFooter = length pageEntries < maxRows
fontType = font config
page <- addPage Nothing
drawWithPage page $ do
when isFirstPage $ renderHeader fontType config amountDue height userArgs
imapM (renderRow fontType (rate userArgs) rowYInit) pageEntries
when (isEnoughSpaceForFooter && isLastPage) $ renderFooter fontType amountDue y
when (not isEnoughSpaceForFooter && isLastPage) $ do
page <- addPage Nothing
drawWithPage page $ do
renderFooter fontType amountDue (height - 60)
generatePdf :: AppConfig -> IO ()
generatePdf config = do
let totalHeight = 892
paginatedEntries = paginate (timesheets config)
args = userArgs config
total = foldr (\sheet s -> s + Timesheet.hours sheet) 0 (timesheets config)
amountDue = pack $ "$" ++ formatMoney (total * rate args)
myName = (Person.name . me) config
rect = PDFRect 0 0 612 totalHeight
fileName = unpack myName ++ " Invoice " ++ printf "%07d" (invoiceNumber config) ++ ".pdf"
outFile = "data" </> client_name args </> "invoices" </> fileName
putStrLn "Generating output file:"
putStrLn $ escapeSpaces outFile
runPdf outFile (standardDocInfo { author = myName, compressed = False}) rect $
mapM (renderPage config paginatedEntries amountDue args totalHeight) paginatedEntries
main :: IO ()
main = do
loadedData <- loadConfig
case loadedData of
Left error -> putStrLn error
Right config -> generatePdf config