summaryrefslogtreecommitdiff
path: root/Model.hs
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2017-03-16 13:18:34 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2017-03-16 13:18:34 +0100
commit57d594818c14652681dce54d324b6b76941b2f4e (patch)
treef3e1e02e2fa41ff0d87eace034d6c883668841c5 /Model.hs
parent3d828feba67f21ae62d1e6eb598a22ffaebf1174 (diff)
parent3bfe0bdcb79b398a387e202c5150b5e6fd230d3a (diff)
downloadbar-57d594818c14652681dce54d324b6b76941b2f4e.tar
bar-57d594818c14652681dce54d324b6b76941b2f4e.tar.gz
bar-57d594818c14652681dce54d324b6b76941b2f4e.tar.bz2
bar-57d594818c14652681dce54d324b6b76941b2f4e.tar.xz
bar-57d594818c14652681dce54d324b6b76941b2f4e.zip
Merge branch 'feat/openYes'
Diffstat (limited to 'Model.hs')
-rw-r--r--Model.hs33
1 files changed, 16 insertions, 17 deletions
diff --git a/Model.hs b/Model.hs
index 90f5904..8778111 100644
--- a/Model.hs
+++ b/Model.hs
@@ -1,4 +1,5 @@
1{-# LANGUAGE FlexibleInstances #-} 1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE DeriveFunctor #-}
2 3
3module Model where 4module Model where
4 5
@@ -18,6 +19,8 @@ import qualified Data.HashMap.Lazy as HashMap
18import Data.Aeson 19import Data.Aeson
19import Data.Aeson.Types (Parser, Value(..)) 20import Data.Aeson.Types (Parser, Value(..))
20 21
22import Model.Types
23
21-- You can define all of your database entities in the entities file. 24-- You can define all of your database entities in the entities file.
22-- You can find more information on persistent and how to declare entities 25-- You can find more information on persistent and how to declare entities
23-- at: 26-- at:
@@ -68,32 +71,28 @@ withTypes vals = do
68instance Ord Item where 71instance Ord Item where
69 x `compare` y = mconcat cmprs 72 x `compare` y = mconcat cmprs
70 where 73 where
71 cmprs = [ itemOpened x `compareM` itemOpened y 74 cmprs = [ itemOpened x `compare` itemOpened y
72 , itemExpires x `compareM` itemExpires y 75 , itemExpires x `compare` itemExpires y
73 , itemKind x `compare` itemKind y 76 , itemKind x `compare` itemKind y
74 , itemBought x `compare` itemBought y 77 , itemBought x `compare` itemBought y
75 ] 78 ]
76 79
77 compareM (Just _) Nothing = LT
78 compareM Nothing (Just _) = GT
79 compareM (Just a) (Just b) = compare a b
80 compareM _ _ = EQ
81
82instance ToJSON Item where 80instance ToJSON Item where
83 toJSON Item{..} = object $ 81 toJSON Item{..} = object $
84 [ "kind" .= itemKind 82 [ "kind" .= itemKind
85 ] ++ maybe [] (\x -> ["bought" .= x]) itemBought 83 , "bought" .= itemBought
86 ++ maybe [] (\x -> ["expires" .= x]) itemExpires 84 , "expires" .= itemExpires
87 ++ maybe [] (\x -> ["opened" .= x]) itemOpened 85 , "opened" .= itemOpened
86 ]
88 87
89instance FromJSON Item where 88instance FromJSON Item where
90 parseJSON = withObject "Item" $ \obj -> do 89 parseJSON = withObject "Item" $ \obj -> do
91 itemKind <- obj .: "kind" 90 itemKind <- obj .: "kind"
92 let 91 let
93 itemNormKind = normalizeKind itemKind 92 itemNormKind = normalizeKind itemKind
94 itemBought <- obj .:? "bought" 93 itemBought <- maybe DateUnknown DateKnown <$> obj .:? "bought"
95 itemExpires <- obj .:? "expires" 94 itemExpires <- maybe DateNever DateKnown <$> obj .:? "expires"
96 itemOpened <- obj .:? "opened" 95 itemOpened <- obj .: "opened"
97 return Item{..} 96 return Item{..}
98 97
99instance ToJSON (Entity Item) where 98instance ToJSON (Entity Item) where
@@ -122,9 +121,9 @@ normalizeKind = Text.strip . Text.toCaseFold
122 121
123data ItemDiff = DiffKind Text 122data ItemDiff = DiffKind Text
124 | DiffType Text 123 | DiffType Text
125 | DiffBought (Maybe Day) 124 | DiffBought ItemDate
126 | DiffExpires (Maybe Day) 125 | DiffExpires ItemDate
127 | DiffOpened (Maybe Day) 126 | DiffOpened ItemDate
128 127
129newtype ItemDiffs = ItemDiffs [ItemDiff] 128newtype ItemDiffs = ItemDiffs [ItemDiff]
130 129
@@ -149,7 +148,7 @@ toUpdate (ItemDiffs ds) = mconcat $ do
149 DiffOpened d -> (, []) [ ItemOpened =. d ] 148 DiffOpened d -> (, []) [ ItemOpened =. d ]
150 149
151data WithType a = WithType { typedVal :: a, valType :: Text } 150data WithType a = WithType { typedVal :: a, valType :: Text }
152 deriving (Eq, Ord, Show) 151 deriving (Eq, Ord, Show, Functor)
153 152
154typeToJSON :: ToJSON a 153typeToJSON :: ToJSON a
155 => Text -- ^ Key for value, if needed 154 => Text -- ^ Key for value, if needed