aboutsummaryrefslogtreecommitdiff
path: root/server/src/Thermoprint/Server/Database/Instances.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Thermoprint/Server/Database/Instances.hs')
-rw-r--r--server/src/Thermoprint/Server/Database/Instances.hs33
1 files changed, 33 insertions, 0 deletions
diff --git a/server/src/Thermoprint/Server/Database/Instances.hs b/server/src/Thermoprint/Server/Database/Instances.hs
new file mode 100644
index 0000000..f5c22fd
--- /dev/null
+++ b/server/src/Thermoprint/Server/Database/Instances.hs
@@ -0,0 +1,33 @@
1{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4
5module Thermoprint.Server.Database.Instances where
6
7import Thermoprint.API (Printout, JobStatus, PrintingError)
8
9import Database.Persist (PersistField(..))
10import Database.Persist.Sql (PersistFieldSql(..))
11import Database.Persist.TH
12
13import Control.Monad ((<=<))
14import Data.Bifunctor
15
16import qualified Data.Aeson as JSON (encode, eitherDecodeStrict')
17
18import Data.ByteString (ByteString)
19import qualified Data.ByteString.Lazy as LBS (toStrict)
20import qualified Data.Text as T (pack)
21
22import Data.Proxy
23
24-- | Instead of deriving an instance using 'derivePersistField', which would use 'show' and 'read', we write our own by hand in order to use json
25instance PersistField Printout where
26 toPersistValue = toPersistValue . LBS.toStrict . JSON.encode
27 fromPersistValue = first T.pack . JSON.eitherDecodeStrict' <=< fromPersistValue
28
29instance PersistFieldSql Printout where
30 sqlType _ = sqlType (Proxy :: Proxy ByteString)
31
32derivePersistField "PrintingError"
33derivePersistField "JobStatus"