diff options
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 |
