refactor(model): move JSONB instance to proper module

load/Load.hs

@@ -96,7 +96,7 @@ sampleIntegral = sampleN scaleIntegral
 instance PathPiece DiffTime where
   toPathPiece = (toPathPiece :: Pico -> Text) . MkFixed . diffTimeToPicoseconds
   fromPathPiece t = fromPathPiece t <&> \(MkFixed ps :: Pico) -> picosecondsToDiffTime ps
-  
+
 
 data LoadSimulation
   = LoadSheetDownload
@@ -214,13 +214,13 @@ runSimulation sim = do
   delays <- replicateM (fromIntegral p) $ do
     d <- view $ _2 . _simDelay
     sampleNDiffTime d
-   
+
   forConcurrently_ ([1..p] `zip` sort delays) $ \(n, d') -> do
     begin <- liftIO getCurrentTime
 
     dur <- view $ _2 . _simDuration
     tDuration <- sampleNDiffTime dur
-    
+
     let MkFixed us = realToFrac d' :: Micro
     threadDelay $ fromInteger us
     start <- liftIO getCurrentTime
@@ -268,7 +268,7 @@ runSimulation' LoadSheetSubmission = do
   -- Just formData <- return . getFormData FIDsubmission $ resp ^. responseBody
   -- Just addButtonData <- return . flip (runFormScraper FIDsubmission) (resp ^. responseBody) $ do
   --   let btnSel = "button" Scalpel.@: [Scalpel.hasClass "btn-mass-input-add"]
-    
+
   --   name <- Scalpel.attr "name" btnSel
   --   value <- Scalpel.attr "value" btnSel
   --   guard $ value == "add__0__0"
@@ -305,7 +305,7 @@ runSimulation' LoadSheetSubmission = do
   procEnd <- join $ asks runtime
 
   print ("proc", procEnd - procStart)
-  
+
   resp3 <- liftIO . httpRetry $ Session.post session (uriToString id formURI mempty) subData
   void . evaluate $! resp3
   where
@@ -328,11 +328,11 @@ runSimulation' LoadSheetSubmission = do
                        -> m ()
             logRetry shouldRetry err status = liftIO . putStrLn . pack $ Retry.defaultLogMsg shouldRetry err status
 
-    
+
 -- runSimulation' other = terror $ "Not implemented: " <> tshow other
 
 runFormScraper :: FormIdentifier -> Scalpel.Scraper Lazy.ByteString a -> Lazy.ByteString -> Maybe a
-runFormScraper fid innerS = fmap join . flip Scalpel.scrapeStringLike $ 
+runFormScraper fid innerS = fmap join . flip Scalpel.scrapeStringLike $
   fmap listToMaybe . Scalpel.chroots "form" $ do
     fid' <- Scalpel.attr "value" $ "input" Scalpel.@: ["name" Scalpel.@= "form-identifier"]
     guard $ fid' == encodeUtf8 (fromStrict $ toPathPiece fid)
@@ -341,11 +341,11 @@ runFormScraper fid innerS = fmap join . flip Scalpel.scrapeStringLike $
 
 getFormData :: FormIdentifier -> Lazy.ByteString -> Maybe [FormParam]
 getFormData = flip runFormScraper $
-  Scalpel.chroots ("input") $ do
+  Scalpel.chroots "input" $ do
     name <- Scalpel.attr "name" Scalpel.anySelector
     value <- Scalpel.attr "value" Scalpel.anySelector <|> pure ""
     return $ toStrict name := value
-      
+
 
 newLoadSession :: ReaderT SimulationContext IO Session
 newLoadSession = do
@@ -354,7 +354,7 @@ newLoadSession = do
   let withToken = case loadToken of
         Nothing -> id
         Just (Jwt bs) -> (:) (hAuthorization, "Bearer " <> bs) . filter ((/= hAuthorization) . fst)
-      
+
 
   liftIO . Session.newSessionControl (Just mempty) $ tlsManagerSettings
     { managerModifyRequest = \req -> return $ req { requestHeaders = withToken $ requestHeaders req }

src/Import/NoModel.hs

@@ -192,7 +192,6 @@ import Network.Mail.Mime.Instances as Import
 import Yesod.Core.Instances as Import ()
 import Data.Aeson.Types.Instances as Import ()
 import Database.Esqueleto.Instances as Import ()
-import Database.Esqueleto.PostgreSQL.JSON as Import (JSONB(..), unJSONB)
 import Numeric.Natural.Instances as Import ()
 import Text.Blaze.Instances as Import ()
 import Jose.Jwt.Instances as Import ()
@@ -272,8 +271,3 @@ import Control.Monad.Trans.RWS (RWST)
 type MForm m = RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m
 
 type WeekDay = DayOfWeek
-
--- TODO: maybe move elsewhere
-deriving newtype instance NFData    a => NFData    (JSONB a)
-deriving newtype instance Semigroup a => Semigroup (JSONB a)
-deriving newtype instance Monoid    a => Monoid    (JSONB a)

src/Model/Types/Common.hs

@@ -1,7 +1,9 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 {-|
 Module: Model.Types.Common
 Description: Common types used by most @Model.Types.*@-Modules
@@ -10,12 +12,13 @@ Types used by multiple other @Model.Types.*@-Modules
 -}
 module Model.Types.Common
   ( module Model.Types.Common
+  , module JSON
   ) where
 
 import Import.NoModel
 
 import qualified Yesod.Auth.Util.PasswordStore as PWStore
-
+import Database.Esqueleto.PostgreSQL.JSON as JSON (JSONB(..), JSONAccessor(..), unJSONB)
 
 type Count  = Sum Integer
 type Points = Centi
@@ -68,3 +71,7 @@ type SessionFileReference = Digest SHA3_256
 
 type QualificationName       = CI Text
 type QualificationShorthand  = CI Text
+
+deriving newtype instance NFData    a => NFData    (JSONB a)
+deriving newtype instance Semigroup a => Semigroup (JSONB a)
+deriving newtype instance Monoid    a => Monoid    (JSONB a)

src/Model/Types/DateTime.hs

@@ -29,6 +29,7 @@ import Data.Time.Calendar.WeekDate
 -- import qualified Text.ParserCombinators.Parsec.Number as ParseNum (nat)
 
 import Database.Persist.Sql
+import Database.Esqueleto.PostgreSQL.JSON (JSONB(..))
 
 import Web.HttpApiData