Replace some TemplateHaskell with Aeson Generics

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 {

qbar/src/QBar/ControlSocket.hs

 {-# 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

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