summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore1
-rw-r--r--Foundation.hs2
-rw-r--r--Handler/Common.hs3
-rw-r--r--Handler/Common/Types.hs2
-rw-r--r--Handler/List.hs29
-rw-r--r--Import/NoFoundation.hs1
-rw-r--r--Model.hs5
-rw-r--r--Model/Types.hs2
-rw-r--r--Settings.hs9
-rw-r--r--bar.cabal140
-rw-r--r--package.yaml106
-rw-r--r--stack.nix14
-rw-r--r--stack.yaml28
-rw-r--r--templates/list-no-thermoprint.hamlet8
14 files changed, 179 insertions, 171 deletions
diff --git a/.gitignore b/.gitignore
index 5747830..d72cafe 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,4 @@ cabal.sandbox.config
21**/.gup 21**/.gup
22static/webshim/ 22static/webshim/
23static/jquery.js 23static/jquery.js
24bar.cabal
diff --git a/Foundation.hs b/Foundation.hs
index 22e5d49..7c44498 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -39,7 +39,7 @@ data MenuItem = MenuItem
39mkYesodData "App" $(parseRoutesFile "config/routes") 39mkYesodData "App" $(parseRoutesFile "config/routes")
40 40
41-- | A convenient synonym for creating forms. 41-- | A convenient synonym for creating forms.
42type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) 42type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
43 43
44-- Please see the documentation for the Yesod typeclass. There are a number 44-- Please see the documentation for the Yesod typeclass. There are a number
45-- of settings which can be configured by overriding methods here. 45-- of settings which can be configured by overriding methods here.
diff --git a/Handler/Common.hs b/Handler/Common.hs
index 88cbd8d..11a9431 100644
--- a/Handler/Common.hs
+++ b/Handler/Common.hs
@@ -1,4 +1,5 @@
1{-# LANGUAGE ApplicativeDo #-} 1{-# LANGUAGE ApplicativeDo
2 #-}
2 3
3module Handler.Common 4module Handler.Common
4 ( inventoryListing 5 ( inventoryListing
diff --git a/Handler/Common/Types.hs b/Handler/Common/Types.hs
index 9150f16..491468c 100644
--- a/Handler/Common/Types.hs
+++ b/Handler/Common/Types.hs
@@ -1,5 +1,3 @@
1{-# LANGUAGE FunctionalDependencies #-}
2
3module Handler.Common.Types where 1module Handler.Common.Types where
4 2
5import Import 3import Import
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
3module Handler.List where 1module Handler.List where
4 2
5import Import 3import Import
@@ -12,8 +10,18 @@ import qualified Data.Map as Map
12import qualified Data.Text as Text 10import qualified Data.Text as Text
13import qualified Data.Text.Lazy as Lazy.Text 11import qualified Data.Text.Lazy as Lazy.Text
14 12
13#ifdef THERMOPRINT
15import Thermoprint.Client 14import Thermoprint.Client
16 15
16mkPrintout :: Set (WithType Text) -> Printout
17mkPrintout 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
17list :: Handler (Set (WithType Text)) 25list :: Handler (Set (WithType Text))
18list = runDB $ do 26list = 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
37mkPrintout :: Set (WithType Text) -> Printout
38mkPrintout 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
45getListR, postListR :: Handler TypedContent 47getListR, postListR :: Handler TypedContent
46getListR = postListR 48getListR = postListR
47postListR = do 49postListR = 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
105getListR, postListR :: Handler TypedContent
106getListR = postListR
107postListR = do
108 list <- list
109 selectRep $ do
110 provideJson $ typeToJSON "item" <$> Set.toAscList list
111 provideRep $ defaultLayout $(widgetFile "list-no-thermoprint")
112#endif
diff --git a/Import/NoFoundation.hs b/Import/NoFoundation.hs
index 1a5b107..7fe2807 100644
--- a/Import/NoFoundation.hs
+++ b/Import/NoFoundation.hs
@@ -8,7 +8,6 @@ import Model as Import
8import Model.Types as Import 8import Model.Types as Import
9import Settings as Import 9import Settings as Import
10import Settings.StaticFiles as Import 10import Settings.StaticFiles as Import
11import Yesod.Auth as Import
12import Yesod.Core.Types as Import (loggerSet) 11import Yesod.Core.Types as Import (loggerSet)
13import Yesod.Default.Config2 as Import 12import Yesod.Default.Config2 as Import
14import Yesod.EmbeddedStatic as Import 13import Yesod.EmbeddedStatic as Import
diff --git a/Model.hs b/Model.hs
index 6d0fd04..02d3387 100644
--- a/Model.hs
+++ b/Model.hs
@@ -1,6 +1,5 @@
1{-# LANGUAGE FlexibleInstances #-} 1{-# LANGUAGE GeneralizedNewtypeDeriving
2{-# LANGUAGE DeriveFunctor #-} 2 #-}
3{-# LANGUAGE PatternGuards #-}
4 3
5module Model where 4module Model where
6 5
diff --git a/Model/Types.hs b/Model/Types.hs
index 61bebfd..5e2a6ef 100644
--- a/Model/Types.hs
+++ b/Model/Types.hs
@@ -1,5 +1,3 @@
1{-# LANGUAGE DeriveGeneric #-}
2
3module Model.Types 1module Model.Types
4 ( ItemDate(..) 2 ( ItemDate(..)
5 , isNever, isUnknown, isKnown 3 , isNever, isUnknown, isKnown
diff --git a/Settings.hs b/Settings.hs
index 8a98c7a..a79f6f8 100644
--- a/Settings.hs
+++ b/Settings.hs
@@ -1,4 +1,3 @@
1{-# Language CPP #-}
2-- | Settings are centralized, as much as possible, into this file. This 1-- | Settings are centralized, as much as possible, into this file. This
3-- includes database connection settings, static file locations, etc. 2-- includes database connection settings, static file locations, etc.
4-- In addition, you can configure a number of different aspects of Yesod 3-- In addition, you can configure a number of different aspects of Yesod
@@ -19,7 +18,9 @@ import Yesod.Default.Config2 (applyEnvValue, configSettingsYml)
19import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload, 18import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload,
20 widgetFileReload) 19 widgetFileReload)
21 20
21#ifdef THERMOPRINT
22import Thermoprint.Client (BaseUrl(..), parseBaseUrl) 22import Thermoprint.Client (BaseUrl(..), parseBaseUrl)
23#endif
23 24
24#ifdef DEVELOPMENT 25#ifdef DEVELOPMENT
25#define DEV_BOOL True 26#define DEV_BOOL True
@@ -51,13 +52,14 @@ data AppSettings = AppSettings
51 , appReloadTemplates :: Bool 52 , appReloadTemplates :: Bool
52 -- ^ Use the reload version of templates 53 -- ^ Use the reload version of templates
53 54
55#ifdef THERMORPINT
54 , appThermoprintBase :: BaseUrl 56 , appThermoprintBase :: BaseUrl
57#endif
55 } 58 }
56 59
57instance FromJSON AppSettings where 60instance FromJSON AppSettings where
58 parseJSON = withObject "AppSettings" $ \o -> do 61 parseJSON = withObject "AppSettings" $ \o -> do
59 let defaultDev = DEV_BOOL 62 let defaultDev = DEV_BOOL
60 parseUrl' = either (fail . show) return . parseBaseUrl
61 appStaticDir <- o .: "static-dir" 63 appStaticDir <- o .: "static-dir"
62 appDatabaseConf <- o .: "database" 64 appDatabaseConf <- o .: "database"
63 appRoot' <- o .:? "approot" 65 appRoot' <- o .:? "approot"
@@ -73,7 +75,10 @@ instance FromJSON AppSettings where
73 appShouldLogAll <- o .:? "should-log-all" .!= defaultDev 75 appShouldLogAll <- o .:? "should-log-all" .!= defaultDev
74 appReloadTemplates <- o .:? "reload-templates" .!= defaultDev 76 appReloadTemplates <- o .:? "reload-templates" .!= defaultDev
75 77
78#ifdef THERMOPRINT
79 let parseUrl' = either (fail . show) return . parseBaseUrl
76 appThermoprintBase <- parseUrl' =<< o .: "thermoprint-url" 80 appThermoprintBase <- parseUrl' =<< o .: "thermoprint-url"
81#endif
77 82
78 return AppSettings {..} 83 return AppSettings {..}
79 84
diff --git a/bar.cabal b/bar.cabal
deleted file mode 100644
index 7ed983b..0000000
--- a/bar.cabal
+++ /dev/null
@@ -1,140 +0,0 @@
1name: bar
2version: 0.6.6
3cabal-version: >= 1.8
4build-type: Simple
5
6Flag dev
7 Description: Turn on development settings, like auto-reload templates.
8 Default: False
9
10Flag library-only
11 Description: Build for use with "yesod devel"
12 Default: False
13
14library
15 hs-source-dirs: ., app
16 exposed-modules: Application
17 Foundation
18 Import
19 Import.NoFoundation
20 Model
21 Model.Types
22 Settings
23 Settings.StaticFiles
24 Handler.Common
25 Handler.Common.Types
26 Handler.InventoryListing
27 Handler.UpdateItem
28 Handler.OpenItem
29 Handler.LowItem
30 Handler.DeleteItem
31 Handler.Item
32 Handler.ReferenceListing
33 Handler.ReferenceItem
34 Handler.DeleteRefItem
35 Handler.Kinds
36 Handler.Types
37 Handler.List
38 Handler.InventoryList
39
40 if flag(dev) || flag(library-only)
41 cpp-options: -DDEVELOPMENT
42 ghc-options: -Wall -fwarn-tabs -O0
43 else
44 ghc-options: -Wall -fwarn-tabs -O2
45
46 extensions: TemplateHaskell
47 QuasiQuotes
48 OverloadedStrings
49 NoImplicitPrelude
50 MultiParamTypeClasses
51 TypeFamilies
52 GADTs
53 GeneralizedNewtypeDeriving
54 FlexibleContexts
55 FlexibleInstances
56 EmptyDataDecls
57 NoMonomorphismRestriction
58 DeriveDataTypeable
59 ViewPatterns
60 TupleSections
61 RecordWildCards
62 CPP
63
64 build-depends:
65 -- Due to a bug in GHC 8.0.1, we block its usage
66 -- See: https://ghc.haskell.org/trac/ghc/ticket/12130
67 base >= 4.8.2.0 && < 4.9
68 || >= 4.9.1.0 && < 5
69
70 , yesod >= 1.6.0 && < 1.7
71 , yesod-core >= 1.6.2 && < 1.7
72 , yesod-auth >= 1.6.2 && < 1.7
73 , yesod-static >= 1.6.0 && < 1.7
74 , yesod-form >= 1.6.1 && < 1.7
75 , classy-prelude >= 0.10.2
76 , classy-prelude-conduit >= 0.10.2
77 -- version 1.0 had a bug in reexporting Handler, causing trouble
78 , classy-prelude-yesod >= 0.10.2 && < 1.0
79 || >= 1.1
80 , bytestring >= 0.9 && < 0.11
81 , text >= 0.11 && < 2.0
82 , persistent >= 2.8.1 && < 2.9
83 , persistent-postgresql >= 2.8.2 && < 2.9
84 , persistent-template >= 2.0 && < 2.7
85 , template-haskell
86 , shakespeare >= 2.0 && < 2.1
87 , hjsmin >= 0.1 && < 0.3
88 , monad-control >= 0.3 && < 1.1
89 , wai-extra >= 3.0 && < 3.1
90 , yaml >= 0.8 && < 0.9
91 , http-conduit >= 2.3.0 && < 2.4
92 , directory >= 1.1 && < 1.4
93 , warp >= 3.0 && < 3.3
94 , data-default
95 , aeson >= 1.2.4 && < 1.5
96 , conduit >= 1.0 && < 2.0
97 , monad-logger >= 0.3 && < 0.4
98 , fast-logger >= 2.2 && < 2.5
99 , wai-logger >= 2.2 && < 2.4
100 , file-embed
101 , safe
102 , unordered-containers
103 , containers
104 , vector
105 , time
106 , case-insensitive
107 , wai
108 , mtl
109 , lens
110 , thermoprint-client
111 , hashids
112 , systemd
113
114executable bar
115 if flag(library-only)
116 Buildable: False
117
118 main-is: main.hs
119 hs-source-dirs: app
120 build-depends: base, bar
121
122 ghc-options: -threaded -rtsopts -with-rtsopts=-N
123
124 extensions: TemplateHaskell
125 QuasiQuotes
126 OverloadedStrings
127 NoImplicitPrelude
128 MultiParamTypeClasses
129 TypeFamilies
130 GADTs
131 GeneralizedNewtypeDeriving
132 FlexibleContexts
133 FlexibleInstances
134 EmptyDataDecls
135 NoMonomorphismRestriction
136 DeriveDataTypeable
137 ViewPatterns
138 TupleSections
139 RecordWildCards
140 CPP
diff --git a/package.yaml b/package.yaml
new file mode 100644
index 0000000..e7ea47d
--- /dev/null
+++ b/package.yaml
@@ -0,0 +1,106 @@
1name: bar
2version: 0.6.6
3
4flags:
5 dev:
6 description: Turn on development settings
7 default: false
8 manual: false
9 library-only:
10 description: Build for use with "yesod devel"
11 default: false
12 manual: false
13 thermoprint:
14 description: Use thermoprint-client
15 default: false
16 manual: false
17
18when:
19 - condition: flag(dev) || flag(library-only)
20 then:
21 cpp-options: -DDEVELOPMENT
22 ghc-options: -Wall -fwarn-tabs -O0
23 else:
24 ghc-options: -Wall -fwarn-tabs -O2
25 - condition: flag(thermoprint)
26 cpp-options: -DTHERMOPRINT
27 dependencies:
28 - thermoprint-client
29
30default-extensions:
31 - DeriveGeneric
32 - TupleSections
33 - RecordWildCards
34 - DeriveDataTypeable
35 - EmptyDataDecls
36 - FlexibleContexts
37 - FlexibleInstances
38 - TypeFamilies
39 - MultiParamTypeClasses
40 - NoImplicitPrelude
41 - PatternGuards
42 - DeriveFunctor
43 - GADTs
44 - CPP
45 - TemplateHaskell
46 - ViewPatterns
47 - PatternGuards
48 - QuasiQuotes
49 - FunctionalDependencies
50 - OverloadedStrings
51
52other-extensions:
53 - GeneralizedNewtypeDeriving
54 - ApplicativeDo
55 - PackageImports
56
57library:
58 source-dirs: .
59 dependencies:
60 - base
61 - yesod
62 - yesod-core
63 - yesod-static
64 - yesod-form
65 - classy-prelude
66 - classy-prelude-yesod
67 - bytestring
68 - text
69 - persistent
70 - persistent-postgresql
71 - persistent-template
72 - template-haskell
73 - shakespeare
74 - wai-extra
75 - yaml
76 - http-conduit
77 - warp
78 - aeson
79 - conduit
80 - monad-logger
81 - fast-logger
82 - wai-logger
83 - file-embed
84 - unordered-containers
85 - containers
86 - vector
87 - time
88 - wai
89 - mtl
90 - lens
91 - hashids
92 - systemd
93
94executables:
95 bar:
96 when:
97 - condition: flag(library-only)
98 buildable: false
99 main: main.hs
100 source-dirs: app
101 dependencies:
102 - base
103 - bar
104 - foreign-store
105 - warp
106 ghc-options: -threaded -rtsopts -with-rtsopts=-N
diff --git a/stack.nix b/stack.nix
new file mode 100644
index 0000000..98b31c1
--- /dev/null
+++ b/stack.nix
@@ -0,0 +1,14 @@
1{ ghc, nixpkgs ? (import <nixos> {}) }:
2
3let
4 inherit (nixpkgs) haskell pkgs;
5 haskellPackages = if ghc.version == pkgs.haskellPackages.ghc.version then pkgs.haskellPackages else pkgs.haskell.packages."ghc${builtins.replaceStrings ["."] [""] ghc.version}";
6in haskell.lib.buildStackProject {
7 inherit ghc;
8 name = "stackenv";
9 buildInputs = (with pkgs;
10 [ postgresql zlib
11 ]) ++ (with haskellPackages;
12 [ yesod-bin
13 ]);
14}
diff --git a/stack.yaml b/stack.yaml
index dcf0bec..fe07aac 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -15,7 +15,7 @@
15# resolver: 15# resolver:
16# name: custom-snapshot 16# name: custom-snapshot
17# location: "./custom-snapshot.yaml" 17# location: "./custom-snapshot.yaml"
18resolver: ghc-8.2.2 18resolver: lts-11.22
19 19
20# User packages to be built. 20# User packages to be built.
21# Various formats can be used as shown in the example below. 21# Various formats can be used as shown in the example below.
@@ -36,10 +36,21 @@ resolver: ghc-8.2.2
36# non-dependency (i.e. a user package), and its test suites and benchmarks 36# non-dependency (i.e. a user package), and its test suites and benchmarks
37# will not be run. This is useful for tweaking upstream packages. 37# will not be run. This is useful for tweaking upstream packages.
38packages: 38packages:
39- '.' 39 - '.'
40 - location: ../thermoprint/client
41 extra-dep: true
42 - location: ../thermoprint/spec
43 extra-dep: true
44 - location:
45 git: https://github.com/pngwjpgh/encoding.git
46 commit: f07769687b5cab12bbcab55eab51d629d54c2023
47 extra-dep: true
48
40# Dependency packages to be pulled from upstream that are not in the resolver 49# Dependency packages to be pulled from upstream that are not in the resolver
41# (e.g., acme-missiles-0.3) 50# (e.g., acme-missiles-0.3)
42extra-deps: [] 51extra-deps:
52 - systemd-1.1.2
53 - cabal-test-quickcheck-0.1.8.1
43 54
44# Override default flag values for local packages and extra-deps 55# Override default flag values for local packages and extra-deps
45flags: {} 56flags: {}
@@ -48,7 +59,7 @@ flags: {}
48extra-package-dbs: [] 59extra-package-dbs: []
49 60
50# Control whether we use the GHC we find on the path 61# Control whether we use the GHC we find on the path
51system-ghc: true 62# system-ghc: true
52# 63#
53# Require a specific version of stack, using version ranges 64# Require a specific version of stack, using version ranges
54# require-stack-version: -any # Default 65# require-stack-version: -any # Default
@@ -65,9 +76,6 @@ system-ghc: true
65# Allow a newer minor version of GHC than the snapshot specifies 76# Allow a newer minor version of GHC than the snapshot specifies
66# compiler-check: newer-minor 77# compiler-check: newer-minor
67nix: 78nix:
68 enable: false 79 packages: []
69 packages: 80 pure: false
70 - postgresql 81 shell-file: ./stack.nix
71 - zlib
72 - haskellPackages.yesod-bin
73 - haskellPackages.stack
diff --git a/templates/list-no-thermoprint.hamlet b/templates/list-no-thermoprint.hamlet
new file mode 100644
index 0000000..4292dc3
--- /dev/null
+++ b/templates/list-no-thermoprint.hamlet
@@ -0,0 +1,8 @@
1<div .table .main>
2 <div .tr .sepBelow>
3 <div .td>Item
4 <div .td>Type
5 $forall WithType item itemType <- Set.toAscList list
6 <div .tr .color>
7 <div .td .kind>#{item}
8 <div .td .type>#{itemType}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 04:01:25 +0000