Merge pull request #25 from BrechtSerckx/datatype-cleanup

Simplify some types

recycle-client/src/Recycle/API.hs

@@ -63,7 +63,7 @@ type RecycleAPI =
              :> QueryParam' '[Required] "houseNumber" HouseNumber
              :> QueryParam' '[Required] "fromDate" Day
              :> QueryParam' '[Required] "untilDate" Day
-             :> UVerb 'GET '[JSON] '[WithStatus 200 (SingObject "items" [CollectionEvent (Union '[FullFraction, Event])]), WithStatus 401 ApiError]
+             :> UVerb 'GET '[JSON] '[WithStatus 200 (SingObject "items" [CollectionEvent]), WithStatus 401 ApiError]
            :<|> "fractions"
              :> Header' '[Required] "X-Consumer" Consumer
              :> Header' '[Required] "Authorization" AccessToken
@@ -74,12 +74,12 @@ type RecycleAPI =
        )
 
 getAccessToken ::
-  HasServantClient m =>
+  (HasServantClient m) =>
   Consumer ->
   AuthSecret ->
   m (NS I '[WithStatus 200 AuthResult, WithStatus 401 ApiError])
 searchZipcodes ::
-  HasServantClient m =>
+  (HasServantClient m) =>
   Consumer ->
   AccessToken ->
   Maybe (SearchQuery Natural) ->
@@ -93,7 +93,7 @@ searchZipcodes ::
          ]
     )
 searchStreets ::
-  HasServantClient m =>
+  (HasServantClient m) =>
   Consumer ->
   AccessToken ->
   Maybe ZipcodeId ->
@@ -108,7 +108,7 @@ searchStreets ::
          ]
     )
 getCollections ::
-  HasServantClient m =>
+  (HasServantClient m) =>
   Consumer ->
   AccessToken ->
   ZipcodeId ->
@@ -123,15 +123,13 @@ getCollections ::
              200
              ( SingObject
                  "items"
-                 [ CollectionEvent
-                     (Union '[FullFraction, Event])
-                 ]
+                 [CollectionEvent]
              ),
            WithStatus 401 ApiError
          ]
     )
 getFractions ::
-  HasServantClient m =>
+  (HasServantClient m) =>
   Consumer ->
   AccessToken ->
   ZipcodeId ->
@@ -148,7 +146,7 @@ getFractions ::
 getAccessToken :<|> searchZipcodes :<|> searchStreets :<|> getCollections :<|> getFractions =
   hoistClient (Proxy @RecycleAPI) runClient (client $ Proxy @RecycleAPI)
 
-class Monad m => HasServantClient m where
+class (Monad m) => HasServantClient m where
   runClient :: ClientM a -> m a
 
 newtype ServantClientT m a = ServantClientT {runServantClientT :: m a}
@@ -173,7 +171,7 @@ instance
       Right a -> pure a
 
 liftApiError ::
-  HasThrow "ApiError" ApiError m =>
+  (HasThrow "ApiError" ApiError m) =>
   NS I '[WithStatus 200 a, WithStatus err ApiError] ->
   m a
 liftApiError = \case

recycle-client/src/Recycle/Class.hs

@@ -118,7 +118,7 @@ class (Monad m) => HasRecycleClient m where
     StreetId ->
     HouseNumber ->
     Range Day ->
-    m [CollectionEvent (Union '[FullFraction, Event])]
+    m [CollectionEvent]
   getFractions ::
     ZipcodeId ->
     StreetId ->

recycle-client/src/Recycle/Types.hs

@@ -17,22 +17,22 @@ module Recycle.Types
     FractionId (..),
     Fraction (..),
     FullFraction (..),
+    FractionCollection (..),
     Event (..),
+    InnerEvent (..),
     partitionCollectionEvents,
     DateRange (..),
   )
 where
 
+import Control.Applicative ((<|>))
 import Data.Aeson
   ( FromJSON (..),
     ToJSON (..),
-    (.:),
-    (.=),
   )
 import qualified Data.Aeson.Types as Aeson
 import Data.Foldable
 import Data.Map.Strict (Map)
-import Data.SOP
 import Data.String (IsString)
 import Data.Text (Text)
 import Data.Time (Day, UTCTime)
@@ -85,7 +85,7 @@ data Range a = Range
 data Logo = Logo
   { regular :: Map Text Text,
     reversed :: Map Text Text,
-    name :: Map Text Text,
+    name :: Translated Text,
     id :: Text
   }
   deriving stock (Generic, Show, Eq)
@@ -94,7 +94,7 @@ data Logo = Logo
 data FullLogo = FullLogo
   { regular :: Map Text Text,
     reversed :: Map Text Text,
-    name :: Map Text Text,
+    name :: Translated Text,
     id :: Text,
     createdAt :: UTCTime,
     updatedAt :: UTCTime
@@ -109,53 +109,35 @@ newtype RGB = RGB Text deriving newtype (Show, FromJSON, ToJSON, Eq)
 newtype CollectionEventId = CollectionEventId {unCollectionEventId :: Text}
   deriving newtype (Show, FromJSON, ToJSON, Eq, IsString)
 
-data CollectionEvent a = CollectionEvent
-  { id :: CollectionEventId,
-    timestamp :: UTCTime,
-    content :: a
-  }
-  deriving stock (Generic, Show, Eq)
+data CollectionEvent
+  = CEFractionCollection FractionCollection
+  | CEEvent Event
+  deriving stock (Show, Eq)
+
+instance FromJSON CollectionEvent where
+  parseJSON v =
+    (CEFractionCollection <$> parseJSON v)
+      <|> (CEEvent <$> parseJSON v)
 
-instance FromJSON (CollectionEvent (Union '[FullFraction, Event])) where
-  parseJSON = Aeson.withObject "CollectionEvent" $ \o -> do
-    id <- o .: "id"
-    timestamp <- o .: "timestamp"
-    content <-
-      (o .: "type" :: Aeson.Parser Text) >>= \case
-        "collection" -> Z . I <$> o .: "fraction"
-        "event" -> S . Z . I <$> o .: "event"
-        _ -> fail "unknown type"
-    pure CollectionEvent {..}
-
-instance ToJSON (CollectionEvent (Union '[FullFraction, Event])) where
-  toJSON CollectionEvent {..} =
-    Aeson.object $
-      ["id" .= id, "timestamp" .= timestamp]
-        <> case content of
-          Z (I f) -> [("type", "collection"), "fraction" .= f]
-          S (Z (I e)) -> [("type", "collection"), "event" .= e]
-          S (S x) -> case x of {}
+instance ToJSON CollectionEvent where
+  toJSON = \case
+    CEFractionCollection fc -> Aeson.toJSON fc
+    CEEvent e -> Aeson.toJSON e
 
 newtype FractionId = FractionId Text
   deriving newtype (Show, Eq, IsString, FromJSON, ToJSON, FromHttpApiData)
 
 partitionCollectionEvents ::
-  [CollectionEvent (Union '[FullFraction, Event])] ->
-  ([CollectionEvent FullFraction], [CollectionEvent Event])
-partitionCollectionEvents ces =
-  let go ::
-        ([CollectionEvent FullFraction], [CollectionEvent Event]) ->
-        CollectionEvent (Union '[FullFraction, Event]) ->
-        ([CollectionEvent FullFraction], [CollectionEvent Event])
-      go (fs, es) ce = case ce.content of
-        Z (I f) -> (ce {content = f} : fs, es)
-        S (Z (I e)) -> (fs, ce {content = e} : es)
-        S (S x) -> case x of {}
-   in foldl' go ([], []) ces
+  [CollectionEvent] ->
+  ([FractionCollection], [Event])
+partitionCollectionEvents =
+  flip foldl' ([], []) $ \(fcs, es) -> \case
+    CEFractionCollection fc -> (fc : fcs, es)
+    CEEvent e -> (fcs, e : es)
 
 data Fraction = Fraction
   { id :: FractionId,
-    name :: Map LangCode Text,
+    name :: Translated Text,
     logo :: Logo,
     color :: RGB,
     variations :: [Aeson.Value]
@@ -168,7 +150,7 @@ data FullFraction = FullFraction
     national :: Bool,
     nationalRef :: Maybe Text,
     datatankRef :: Maybe Text,
-    name :: Map LangCode Text,
+    name :: Translated Text,
     logo :: FullLogo,
     color :: RGB,
     variations :: (),
@@ -179,13 +161,29 @@ data FullFraction = FullFraction
   deriving stock (Generic, Show, Eq)
   deriving anyclass (FromJSON, ToJSON)
 
+data FractionCollection = FractionCollection
+  { id :: CollectionEventId,
+    timestamp :: UTCTime,
+    fraction :: FullFraction
+  }
+  deriving stock (Generic, Show, Eq)
+  deriving anyclass (FromJSON, ToJSON)
+
 -- * Event
 
 data Event = Event
-  { title :: Map LangCode Text,
-    introduction :: Map LangCode Text,
-    description :: Map LangCode Text,
-    externalLink :: Map LangCode Text
+  { id :: CollectionEventId,
+    timestamp :: UTCTime,
+    event :: InnerEvent
+  }
+  deriving stock (Generic, Show, Eq)
+  deriving anyclass (FromJSON, ToJSON)
+
+data InnerEvent = InnerEvent
+  { title :: Translated Text,
+    introduction :: Translated Text,
+    description :: Translated Text,
+    externalLink :: Translated Text
   }
   deriving stock (Generic, Show, Eq)
   deriving anyclass (FromJSON, ToJSON)

recycle-client/src/Recycle/Types/Geo.hs

@@ -16,12 +16,12 @@ import Data.Aeson
   ( FromJSON,
     ToJSON,
   )
-import Data.Map.Strict (Map)
 import Data.String (IsString)
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import GHC.Generics (Generic)
 import GHC.Natural (Natural)
+import Recycle.Utils (Translated)
 import Web.HttpApiData
   ( FromHttpApiData,
     ToHttpApiData,
@@ -38,7 +38,7 @@ data City = City
     name :: Text,
     createdAt :: UTCTime,
     updatedAt :: UTCTime,
-    names :: Map Text Text
+    names :: Translated Text
   }
   deriving stock (Generic, Show, Eq)
   deriving anyclass (FromJSON, ToJSON)
@@ -54,7 +54,7 @@ data Zipcode = Zipcode
     createdAt :: UTCTime,
     updatedAt :: UTCTime,
     id :: ZipcodeId,
-    names :: [Map Text Text]
+    names :: [Translated Text]
   }
   deriving stock (Show, Generic, Eq)
   deriving anyclass (FromJSON, ToJSON)
@@ -65,7 +65,7 @@ data FullZipcode = FullZipcode
     createdAt :: UTCTime,
     updatedAt :: UTCTime,
     id :: ZipcodeId,
-    names :: [Map Text Text],
+    names :: [Translated Text],
     available :: Bool
   }
   deriving stock (Generic, Show, Eq)
@@ -81,7 +81,7 @@ data Street = Street
     city :: [City],
     createdAt :: UTCTime,
     updatedAt :: UTCTime,
-    names :: Map Text Text,
+    names :: Translated Text,
     name :: Text,
     deleted :: Bool,
     zipcode :: [Zipcode]

recycle-client/src/Recycle/Utils.hs

@@ -4,13 +4,15 @@ module Recycle.Utils
   ( LowerCase,
     Union,
     headMay,
+    Translated (..),
     module Data.SOP,
   )
 where
 
 import qualified Data.Char as Char
 import Data.SOP
 import qualified Deriving.Aeson as Aeson
+import GHC.Generics (Generic)
 import Servant.API (Union)
 
 data LowerCase
@@ -22,3 +24,12 @@ headMay :: [a] -> Maybe a
 headMay = \case
   [] -> Nothing
   x : _ -> Just x
+
+data Translated a = Translated
+  { nl :: a,
+    fr :: a,
+    en :: a,
+    de :: a
+  }
+  deriving stock (Generic, Show, Eq)
+  deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)