From 4f97166dae36ef9d3921581a65b8ff541deee23d Mon Sep 17 00:00:00 2001
From: "J. Konrad Tegtmeier-Rottach" <jktr@0x16.de>
Date: Wed, 3 May 2023 00:15:42 +0200
Subject: [PATCH] Replace some TemplateHaskell with Aeson Generics

---
 qbar/src/QBar/BlockOutput.hs   | 27 +++++++++++++----------
 qbar/src/QBar/ControlSocket.hs | 40 ++++++++++++++++++++++++----------
 qbar/src/QBar/Core.hs          |  8 ++++---
 3 files changed, 50 insertions(+), 25 deletions(-)

diff --git a/qbar/src/QBar/BlockOutput.hs b/qbar/src/QBar/BlockOutput.hs
index 551a2e6..6f28926 100644
--- a/qbar/src/QBar/BlockOutput.hs
+++ b/qbar/src/QBar/BlockOutput.hs
@@ -44,9 +44,9 @@ import QBar.Prelude
 
 import Control.Lens
 import Data.Aeson
-import Data.Aeson.TH
 import Data.Int (Int64)
 import qualified Data.Text.Lazy as T
+import GHC.Generics
 
 
 data BlockOutput = BlockOutput {
@@ -55,11 +55,10 @@ data BlockOutput = BlockOutput {
     _blockName :: Maybe T.Text,
     _invalid :: Bool
   }
-  deriving (Eq, Show)
-
+  deriving (Eq, Show, Generic)
 
 newtype BlockText = BlockText [BlockTextSegment]
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
 instance Semigroup BlockText where
   (BlockText a) <> (BlockText b) = BlockText (a <> b)
 instance Monoid BlockText where
@@ -75,18 +74,24 @@ data BlockTextSegment = BlockTextSegment {
     color :: Maybe Color,
     backgroundColor :: Maybe Color
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
 
 data Importance = NormalImportant Float | WarnImportant Float | ErrorImportant Float | CriticalImportant Float
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
 
+instance FromJSON BlockOutput
+instance ToJSON BlockOutput
 
-$(deriveJSON defaultOptions ''BlockOutput)
-makeLenses ''BlockOutput
-$(deriveJSON defaultOptions ''Importance)
-$(deriveJSON defaultOptions ''BlockTextSegment)
-$(deriveJSON defaultOptions ''BlockText)
+instance FromJSON BlockText
+instance ToJSON BlockText
+
+instance FromJSON BlockTextSegment
+instance ToJSON BlockTextSegment
 
+instance FromJSON Importance
+instance ToJSON Importance
+
+makeLenses ''BlockOutput
 
 mkBlockOutput :: BlockText -> BlockOutput
 mkBlockOutput text = BlockOutput {
diff --git a/qbar/src/QBar/ControlSocket.hs b/qbar/src/QBar/ControlSocket.hs
index ce2665f..9899235 100644
--- a/qbar/src/QBar/ControlSocket.hs
+++ b/qbar/src/QBar/ControlSocket.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module QBar.ControlSocket (
@@ -25,13 +24,13 @@ import Control.Concurrent (forkFinally)
 import Control.Concurrent.Async
 import Control.Exception (SomeException, IOException, handle, onException)
 import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson.TH
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BSC
 import Data.Text.Lazy (pack)
 import Data.Time.Clock (getCurrentTime, addUTCTime)
 import qualified Data.Text.Lazy as T
 import qualified Data.Text.Lazy.IO as T
+import GHC.Generics
 import Network.Socket
 import Pipes
 import Pipes.Concurrent as PC (Output, spawn, spawn', unbounded, newest, toOutput, fromInput, send, atomically)
@@ -145,13 +144,19 @@ decodeStreamSafe MainOptions{verbose} inputStream = decodeStream inputStream >->
             Right v -> yield v >> failOnDecodingError'
 
 
-data StreamType = BlockStreamType BlockStream | MirrorStreamType MirrorStream
+data StreamType
+  = BlockStreamType BlockStream
+  | MirrorStreamType MirrorStream
+  deriving Generic
+
 mapStreamType :: StreamType -> (forall a. IsStream a => a -> b) -> b
 mapStreamType (BlockStreamType a) f = f a
 mapStreamType (MirrorStreamType a) f = f a
 
 
 data BlockStream = BlockStream
+  deriving Generic
+
 instance IsStream BlockStream where
   type Up BlockStream = [BlockOutput]
   type Down BlockStream = BlockEvent
@@ -191,6 +196,8 @@ instance IsStream BlockStream where
 
 
 data MirrorStream = MirrorStream
+  deriving Generic
+
 instance IsStream MirrorStream where
   type Up MirrorStream = BlockEvent
   type Down MirrorStream = [BlockOutput]
@@ -206,12 +213,13 @@ instance IsStream MirrorStream where
 
 
 data Request = Command Command | StartStream StreamType
+  deriving Generic
 
 data Command = SetTheme T.Text | CheckServer
-  deriving Show
+  deriving (Show, Generic)
 
 data CommandResult = Success | Error Text
-  deriving Show
+  deriving (Show, Generic)
 
 
 ipcSocketAddress :: MainOptions -> IO FilePath
@@ -400,10 +408,20 @@ listenUnixSocket options@MainOptions{verbose} bar commandHandler = do
     errorResponse :: Text -> Producer ByteString IO ()
     errorResponse message = encode $ Error message
 
+instance FromJSON BlockStream
+instance ToJSON BlockStream
+
+instance FromJSON Command
+instance ToJSON Command
+
+instance FromJSON CommandResult
+instance ToJSON CommandResult
+
+instance FromJSON MirrorStream
+instance ToJSON MirrorStream
+
+instance FromJSON Request
+instance ToJSON Request
 
-$(deriveJSON defaultOptions ''Request)
-$(deriveJSON defaultOptions ''Command)
-$(deriveJSON defaultOptions ''CommandResult)
-$(deriveJSON defaultOptions ''StreamType)
-$(deriveJSON defaultOptions ''BlockStream)
-$(deriveJSON defaultOptions ''MirrorStream)
+instance FromJSON StreamType
+instance ToJSON StreamType
diff --git a/qbar/src/QBar/Core.hs b/qbar/src/QBar/Core.hs
index ef9ad38..92f7b67 100644
--- a/qbar/src/QBar/Core.hs
+++ b/qbar/src/QBar/Core.hs
@@ -54,10 +54,11 @@ import Control.Lens
 import Control.Monad.Reader (ReaderT, runReaderT, ask)
 import Control.Monad.State (StateT)
 import Control.Monad.Writer (WriterT)
-import Data.Aeson.TH
+import Data.Aeson
 import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text.Lazy as T
+import GHC.Generics
 import Pipes
 import Pipes.Concurrent
 import Pipes.Safe (SafeT, runSafeT)
@@ -72,9 +73,10 @@ data MainOptions = MainOptions {
 data BlockEvent = Click {
   name :: T.Text,
   button :: Int
-} deriving (Eq, Show)
-$(deriveJSON defaultOptions ''BlockEvent)
+} deriving (Eq, Show, Generic)
 
+instance FromJSON BlockEvent
+instance ToJSON BlockEvent
 
 data ExitBlock = ExitBlock
 
-- 
GitLab