diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2018-09-15 15:20:50 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2018-09-15 15:20:50 +0200 |
commit | b8821e100e0d8b02cde5392a2bb7d5f71428de87 (patch) | |
tree | b6375df34485b19845709020781411b45b490e12 /Handler/List.hs | |
parent | 42cd5f4a218be39b90a37d94eb5cdb6570ad2ab2 (diff) | |
download | bar-b8821e100e0d8b02cde5392a2bb7d5f71428de87.tar bar-b8821e100e0d8b02cde5392a2bb7d5f71428de87.tar.gz bar-b8821e100e0d8b02cde5392a2bb7d5f71428de87.tar.bz2 bar-b8821e100e0d8b02cde5392a2bb7d5f71428de87.tar.xz bar-b8821e100e0d8b02cde5392a2bb7d5f71428de87.zip |
Disable thermoprint via flag
Diffstat (limited to 'Handler/List.hs')
-rw-r--r-- | Handler/List.hs | 29 |
1 files changed, 20 insertions, 9 deletions
diff --git a/Handler/List.hs b/Handler/List.hs index 522f6f5..a2194ba 100644 --- a/Handler/List.hs +++ b/Handler/List.hs | |||
@@ -1,5 +1,3 @@ | |||
1 | {-# LANGUAGE PatternGuards #-} | ||
2 | |||
3 | module Handler.List where | 1 | module Handler.List where |
4 | 2 | ||
5 | import Import | 3 | import Import |
@@ -12,8 +10,18 @@ import qualified Data.Map as Map | |||
12 | import qualified Data.Text as Text | 10 | import qualified Data.Text as Text |
13 | import qualified Data.Text.Lazy as Lazy.Text | 11 | import qualified Data.Text.Lazy as Lazy.Text |
14 | 12 | ||
13 | #ifdef THERMOPRINT | ||
15 | import Thermoprint.Client | 14 | import Thermoprint.Client |
16 | 15 | ||
16 | mkPrintout :: Set (WithType Text) -> Printout | ||
17 | mkPrintout list = Printout ps | ||
18 | where | ||
19 | ps = Map.foldMapWithKey (fmap (pure . Paragraph . pure . Cooked) . toLines) $ group list | ||
20 | group = Map.fromListWith (<>) . fmap (\(kind `WithType` t) -> (t, Set.singleton kind)) . Set.toAscList | ||
21 | toLines t (Set.toAscList -> kinds) = either id Line . text . Lazy.Text.fromStrict . Text.unlines $ | ||
22 | pure t ++ map (" - " <>) kinds | ||
23 | #endif | ||
24 | |||
17 | list :: Handler (Set (WithType Text)) | 25 | list :: Handler (Set (WithType Text)) |
18 | list = runDB $ do | 26 | list = runDB $ do |
19 | today <- liftIO $ utctDay <$> getCurrentTime | 27 | today <- liftIO $ utctDay <$> getCurrentTime |
@@ -34,14 +42,8 @@ list = runDB $ do | |||
34 | 42 | ||
35 | return $ Set.map (fmap referenceKind) references' | 43 | return $ Set.map (fmap referenceKind) references' |
36 | 44 | ||
37 | mkPrintout :: Set (WithType Text) -> Printout | ||
38 | mkPrintout list = Printout ps | ||
39 | where | ||
40 | ps = Map.foldMapWithKey (fmap (pure . Paragraph . pure . Cooked) . toLines) $ group list | ||
41 | group = Map.fromListWith (<>) . fmap (\(kind `WithType` t) -> (t, Set.singleton kind)) . Set.toAscList | ||
42 | toLines t (Set.toAscList -> kinds) = either id Line . text . Lazy.Text.fromStrict . Text.unlines $ | ||
43 | pure t ++ map (" - " <>) kinds | ||
44 | 45 | ||
46 | #ifdef THERMOPRINT | ||
45 | getListR, postListR :: Handler TypedContent | 47 | getListR, postListR :: Handler TypedContent |
46 | getListR = postListR | 48 | getListR = postListR |
47 | postListR = do | 49 | postListR = do |
@@ -99,3 +101,12 @@ postListR = do | |||
99 | selectRep $ do | 101 | selectRep $ do |
100 | provideJson $ typeToJSON "item" <$> Set.toAscList list | 102 | provideJson $ typeToJSON "item" <$> Set.toAscList list |
101 | provideRep $ defaultLayout $(widgetFile "list") | 103 | provideRep $ defaultLayout $(widgetFile "list") |
104 | #else | ||
105 | getListR, postListR :: Handler TypedContent | ||
106 | getListR = postListR | ||
107 | postListR = do | ||
108 | list <- list | ||
109 | selectRep $ do | ||
110 | provideJson $ typeToJSON "item" <$> Set.toAscList list | ||
111 | provideRep $ defaultLayout $(widgetFile "list-no-thermoprint") | ||
112 | #endif | ||