summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Handler/Common.hs7
-rw-r--r--Handler/InventoryListing.hs4
-rw-r--r--bar.cabal1
-rw-r--r--bar.nix18
-rw-r--r--templates/default-layout.cassius10
-rw-r--r--templates/inventoryListing.hamlet4
6 files changed, 32 insertions, 12 deletions
diff --git a/Handler/Common.hs b/Handler/Common.hs
index a1ae34b..aacab92 100644
--- a/Handler/Common.hs
+++ b/Handler/Common.hs
@@ -11,6 +11,7 @@ module Handler.Common
11 , FormState(..) 11 , FormState(..)
12 , HasFormState(..) 12 , HasFormState(..)
13 , stockSort, referenceSort 13 , stockSort, referenceSort
14 , humanId
14 ) where 15 ) where
15 16
16import Import 17import Import
@@ -28,6 +29,12 @@ import Handler.Common.Types
28 29
29import Text.Julius (RawJS(..)) 30import Text.Julius (RawJS(..))
30 31
32import qualified Codec.Crockford as Crockford (encode)
33import Database.Persist.Sql (fromSqlKey)
34
35humanId :: ItemId -> String
36humanId = Crockford.encode . fromSqlKey
37
31dayFormat :: Day -> String 38dayFormat :: Day -> String
32dayFormat = formatTime defaultTimeLocale "%e. %b %y" 39dayFormat = formatTime defaultTimeLocale "%e. %b %y"
33 40
diff --git a/Handler/InventoryListing.hs b/Handler/InventoryListing.hs
index c2ec5d1..d5252a1 100644
--- a/Handler/InventoryListing.hs
+++ b/Handler/InventoryListing.hs
@@ -11,8 +11,8 @@ postInventoryListingR = do
11 case insertResult of 11 case insertResult of
12 FormSuccess (Item{..} `WithType` t) -> runDB $ do 12 FormSuccess (Item{..} `WithType` t) -> runDB $ do
13 upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] 13 upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ]
14 insert Item{..} 14 newItem <- insert Item{..}
15 return () 15 addMessage "insertSuccess" [hamlet|Inserted new item as #{humanId newItem}|]
16 FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors 16 FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
17 _ -> return () 17 _ -> return ()
18 18
diff --git a/bar.cabal b/bar.cabal
index 5003000..c99c80a 100644
--- a/bar.cabal
+++ b/bar.cabal
@@ -105,6 +105,7 @@ library
105 , mtl 105 , mtl
106 , lens 106 , lens
107 , thermoprint-client 107 , thermoprint-client
108 , crockford
108 109
109executable bar 110executable bar
110 if flag(library-only) 111 if flag(library-only)
diff --git a/bar.nix b/bar.nix
index 714ee94..00c2a5e 100644
--- a/bar.nix
+++ b/bar.nix
@@ -1,12 +1,12 @@
1{ mkDerivation, aeson, base, bytestring, case-insensitive 1{ mkDerivation, aeson, base, bytestring, case-insensitive
2, classy-prelude, classy-prelude-conduit, classy-prelude-yesod 2, classy-prelude, classy-prelude-conduit, classy-prelude-yesod
3, conduit, containers, data-default, directory, fast-logger 3, conduit, containers, crockford, data-default, directory
4, file-embed, hjsmin, http-conduit, lens, monad-control 4, fast-logger, file-embed, hjsmin, http-conduit, lens
5, monad-logger, mtl, persistent, persistent-postgresql 5, monad-control, monad-logger, mtl, persistent
6, persistent-template, safe, shakespeare, stdenv, template-haskell 6, persistent-postgresql, persistent-template, safe, shakespeare
7, text, thermoprint-client, time, unordered-containers, vector, wai 7, stdenv, template-haskell, text, thermoprint-client, time
8, wai-extra, wai-logger, warp, yaml, yesod, yesod-auth, yesod-core 8, unordered-containers, vector, wai, wai-extra, wai-logger, warp
9, yesod-form, yesod-static 9, yaml, yesod, yesod-auth, yesod-core, yesod-form, yesod-static
10}: 10}:
11mkDerivation { 11mkDerivation {
12 pname = "bar"; 12 pname = "bar";
@@ -17,8 +17,8 @@ mkDerivation {
17 libraryHaskellDepends = [ 17 libraryHaskellDepends = [
18 aeson base bytestring case-insensitive classy-prelude 18 aeson base bytestring case-insensitive classy-prelude
19 classy-prelude-conduit classy-prelude-yesod conduit containers 19 classy-prelude-conduit classy-prelude-yesod conduit containers
20 data-default directory fast-logger file-embed hjsmin http-conduit 20 crockford data-default directory fast-logger file-embed hjsmin
21 lens monad-control monad-logger mtl persistent 21 http-conduit lens monad-control monad-logger mtl persistent
22 persistent-postgresql persistent-template safe shakespeare 22 persistent-postgresql persistent-template safe shakespeare
23 template-haskell text thermoprint-client time unordered-containers 23 template-haskell text thermoprint-client time unordered-containers
24 vector wai wai-extra wai-logger warp yaml yesod yesod-auth 24 vector wai wai-extra wai-logger warp yaml yesod yesod-auth
diff --git a/templates/default-layout.cassius b/templates/default-layout.cassius
index bd76a01..61a4046 100644
--- a/templates/default-layout.cassius
+++ b/templates/default-layout.cassius
@@ -31,6 +31,12 @@
31 text-align: center 31 text-align: center
32 padding: 0.25em 32 padding: 0.25em
33 color: #aaa 33 color: #aaa
34.itemId
35 display: table-cell
36 text-align: left
37 padding: 0.25em
38 color: #aaa
39 font-family: monospace
34.table .table .td, .table .table .tc, .table .table .th, .table .table .kind 40.table .table .td, .table .table .tc, .table .table .th, .table .table .kind
35 padding: 0 41 padding: 0
36table table td, table table th 42table table td, table table th
@@ -43,7 +49,7 @@ table table td, table table th
43 font-weight: bold 49 font-weight: bold
44 .formError 50 .formError
45 color: #800 51 color: #800
46 .printSuccess 52 .printSuccess, .insertSuccess
47 color: #080 53 color: #080
48button 54button
49 width: 6em 55 width: 6em
@@ -94,3 +100,5 @@ label.checkbox
94 vertical-align: middle 100 vertical-align: middle
95 span 101 span
96 vertical-align: middle 102 vertical-align: middle
103.itemH
104 display: table-cell \ No newline at end of file
diff --git a/templates/inventoryListing.hamlet b/templates/inventoryListing.hamlet
index 3be43db..f0ff1e4 100644
--- a/templates/inventoryListing.hamlet
+++ b/templates/inventoryListing.hamlet
@@ -1,5 +1,6 @@
1<div .table> 1<div .table>
2 <div .tr .sepBelow> 2 <div .tr .sepBelow>
3 <div .itemH>
3 <div .th>Item 4 <div .th>Item
4 <div .th>Type 5 <div .th>Type
5 <div .th>Bought 6 <div .th>Bought
@@ -9,6 +10,7 @@
9 $if isJust (preview insertForm =<< formState) 10 $if isJust (preview insertForm =<< formState)
10 $with Just InsertForm{..} <- formState 11 $with Just InsertForm{..} <- formState
11 <form .tr .sepBelow action=@{InventoryListingR} method=post enctype=#{fsInsertEncoding}> 12 <form .tr .sepBelow action=@{InventoryListingR} method=post enctype=#{fsInsertEncoding}>
13 <div .td>
12 ^{fsInsertForm} 14 ^{fsInsertForm}
13 <div .td> 15 <div .td>
14 <button type=submit> 16 <button type=submit>
@@ -17,12 +19,14 @@
17 $if Just itemId == (preview updateId =<< formState) 19 $if Just itemId == (preview updateId =<< formState)
18 $with Just UpdateForm{..} <- formState 20 $with Just UpdateForm{..} <- formState
19 <form .tr .color action=@{UpdateItemR fsUpdateId}##{toPathPiece fsUpdateId} method=post enctype=#{fsUpdateEncoding} ##{toPathPiece fsUpdateId}> 21 <form .tr .color action=@{UpdateItemR fsUpdateId}##{toPathPiece fsUpdateId} method=post enctype=#{fsUpdateEncoding} ##{toPathPiece fsUpdateId}>
22 <div .itemId>#{humanId itemId}
20 ^{fsUpdateForm} 23 ^{fsUpdateForm}
21 <div .td> 24 <div .td>
22 <button type=submit> 25 <button type=submit>
23 Save Changes 26 Save Changes
24 $else 27 $else
25 <div .tr .color ##{toPathPiece itemId}> 28 <div .tr .color ##{toPathPiece itemId}>
29 <div .itemId>#{humanId itemId}
26 <div .kind>#{itemKind} 30 <div .kind>#{itemKind}
27 <div .type>#{itemType} 31 <div .type>#{itemType}
28 <div .td .day> 32 <div .td .day>