diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2017-03-16 01:19:07 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2017-03-16 01:19:07 +0100 |
commit | 3bfe0bdcb79b398a387e202c5150b5e6fd230d3a (patch) | |
tree | 8384b49048e84969a3a3440ed309b9c6e6b779de /Model.hs | |
parent | 3ed9ec8ca70afb556f75d4e087043f4c67f50974 (diff) | |
download | bar-3bfe0bdcb79b398a387e202c5150b5e6fd230d3a.tar bar-3bfe0bdcb79b398a387e202c5150b5e6fd230d3a.tar.gz bar-3bfe0bdcb79b398a387e202c5150b5e6fd230d3a.tar.bz2 bar-3bfe0bdcb79b398a387e202c5150b5e6fd230d3a.tar.xz bar-3bfe0bdcb79b398a387e202c5150b5e6fd230d3a.zip |
More complicated date handling
Diffstat (limited to 'Model.hs')
-rw-r--r-- | Model.hs | 33 |
1 files changed, 16 insertions, 17 deletions
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE FlexibleInstances #-} | 1 | {-# LANGUAGE FlexibleInstances #-} |
2 | {-# LANGUAGE DeriveFunctor #-} | ||
2 | 3 | ||
3 | module Model where | 4 | module Model where |
4 | 5 | ||
@@ -18,6 +19,8 @@ import qualified Data.HashMap.Lazy as HashMap | |||
18 | import Data.Aeson | 19 | import Data.Aeson |
19 | import Data.Aeson.Types (Parser, Value(..)) | 20 | import Data.Aeson.Types (Parser, Value(..)) |
20 | 21 | ||
22 | import 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 | |||
68 | instance Ord Item where | 71 | instance 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 | |||
82 | instance ToJSON Item where | 80 | instance 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 | ||
89 | instance FromJSON Item where | 88 | instance 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 | ||
99 | instance ToJSON (Entity Item) where | 98 | instance ToJSON (Entity Item) where |
@@ -122,9 +121,9 @@ normalizeKind = Text.strip . Text.toCaseFold | |||
122 | 121 | ||
123 | data ItemDiff = DiffKind Text | 122 | data 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 | ||
129 | newtype ItemDiffs = ItemDiffs [ItemDiff] | 128 | newtype 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 | ||
151 | data WithType a = WithType { typedVal :: a, valType :: Text } | 150 | data WithType a = WithType { typedVal :: a, valType :: Text } |
152 | deriving (Eq, Ord, Show) | 151 | deriving (Eq, Ord, Show, Functor) |
153 | 152 | ||
154 | typeToJSON :: ToJSON a | 153 | typeToJSON :: ToJSON a |
155 | => Text -- ^ Key for value, if needed | 154 | => Text -- ^ Key for value, if needed |