Db layout, persistent-inst. & printer framework

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 @@
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
+{-# LANGUAGE FlexibleInstances          #-}
+
+module Thermoprint.Server.Database.Instances where
+
+import Thermoprint.API (Printout, JobStatus, PrintingError)
+
+import Database.Persist (PersistField(..))
+import Database.Persist.Sql (PersistFieldSql(..))
+import Database.Persist.TH
+
+import Control.Monad ((<=<))
+import Data.Bifunctor
+
+import qualified Data.Aeson as JSON (encode, eitherDecodeStrict')
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LBS (toStrict)
+import qualified Data.Text as T (pack)
+
+import Data.Proxy
+
+-- | Instead of deriving an instance using 'derivePersistField', which would use 'show' and 'read', we write our own by hand in order to use json
+instance PersistField Printout where
+  toPersistValue   = toPersistValue . LBS.toStrict . JSON.encode
+  fromPersistValue = first T.pack . JSON.eitherDecodeStrict' <=< fromPersistValue
+
+instance PersistFieldSql Printout where
+  sqlType _ = sqlType (Proxy :: Proxy ByteString)
+
+derivePersistField "PrintingError"
+derivePersistField "JobStatus"