blob: cfd3f7c726358edcc85306bf96252f33718a770a (
plain)
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
|
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedLists #-}
module Handler.List where
import Import
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy.Text
import Database.Persist.Sql (Single(..), rawSql)
import Thermoprint.Client
list :: Handler (Set Text)
list = do
(map unSingle -> kinds) <- runDB $ rawSql "select reference.kind from reference where not exists (select * from item where COALESCE(item.expires >= CURRENT_DATE, TRUE) and (item.norm_kind = reference.norm_kind)) " []
return $ Set.fromList kinds
mkPrintout :: Set Text -> Printout
mkPrintout list = Printout
[ Paragraph
[Cooked . either id Line . text . Lazy.Text.fromStrict . Text.unlines . map (" - " <>) $ Set.toAscList list
]
]
getListR, postListR :: Handler TypedContent
getListR = postListR
postListR = do
Client{..} <- mkClient' . appThermoprintBase . appSettings <$> getYesod
let
formatPrinter (pId@(PrinterId num), pStatus) =
("Printer #" <> tshow num <> " – " <> tshow pStatus, pId)
printers' <- map formatPrinter . Map.toAscList <$> printers
list <- list
((printResult, printView), printEnc) <- runFormPost . renderDivsNoLabels $ do
pId <- case printers' of
[(_, pId)] -> pure pId
_ -> areq (selectFieldList printers') "Printer" . listToMaybe $ map snd printers'
pure pId
case printResult of
FormSuccess pId -> do
(JobId jId) <- jobCreate (Just pId) $ mkPrintout list
addMessage "printSuccess" . toHtml $ "List is printing as job #" <> tshow jId
FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
_ -> return ()
selectRep $ do
provideJson list
provideRep . defaultLayout $
[whamlet|
<div .table .main>
<div .tr .sepBelow>
<div .th>Item
$forall item <- Set.toAscList list
<div .tr .color>
<div .kind>#{item}
<form .tr .sepAbove method=post action=@{ListR} enctype=#{printEnc}>
<div .td>
^{printView}
<button type=submit :Set.null list:disabled>
Print
|]
|
