Handling Postgresql array types

This is a question about database query libraries. I am trying to do some analytics on a Postgresql database and up to now have been using Database.HDBC for most of my querying. One of the columns on the database is a two dimensional float8 array. I tried using Database.PostgreSQL.Simple but got stuck on this array as I could not figure out how to extend the built in conversion functions to cater for something like this. So went back to HDBC. But now my queries are starting to get fairly long and I have been looking at libraries like Persistent with Esqualeto, HaskellDB and Groundhog to make my queries a little more composable and type safe. However I have not been able to find any examples of any of these libraries using postgres arrays and given my postgresql-simple experience I worried that I might similarly be unable, because of my low level of haskell ability, to extend the conversion functions. So to my question. Does anyone have experience with one of these libraries in dealing with postgresql arrays and could someone perhaps send me a simple example that I could use as a basis. Failing that, can anyone advise me on which of these libraries have the most haskell newbie (LYAH trained, but still struggling with RWH) friendly approach to writing new conversion functions? Thanks Riaan

I doubt you'd need to extend the built-in conversion functions for postgresql-simple. In particular there is already an instance fo `ToField` for: `ToField a => ToField (Vector a)` meaning there is an instance for the type `Vector (Vector Float)` (because `Float` is also an instance of `ToField`). I believe that should work out of the box for you. I've never tried using two dimensional arrays, but I've used postgresql arrays as Vectors using postgresql-simple a lot, and it works great out of the box. If you're interested in going just a little bit higher level without abandoning postgresql-simple, I'd suggest postgresql-orm (shameless plug), which gives you an very lightweight ORM layer on top of postgresql-simple -- specifically a safe query DSL. -Amit On 12/25/2014 07:36 PM, Riaan wrote:
This is a question about database query libraries. I am trying to do some analytics on a Postgresql database and up to now have been using Database.HDBC for most of my querying.
One of the columns on the database is a two dimensional float8 array. I tried using Database.PostgreSQL.Simple but got stuck on this array as I could not figure out how to extend the built in conversion functions to cater for something like this. So went back to HDBC. But now my queries are starting to get fairly long and I have been looking at libraries like Persistent with Esqualeto, HaskellDB and Groundhog to make my queries a little more composable and type safe.
However I have not been able to find any examples of any of these libraries using postgres arrays and given my postgresql-simple experience I worried that I might similarly be unable, because of my low level of haskell ability, to extend the conversion functions.
So to my question. Does anyone have experience with one of these libraries in dealing with postgresql arrays and could someone perhaps send me a simple example that I could use as a basis. Failing that, can anyone advise me on which of these libraries have the most haskell newbie (LYAH trained, but still struggling with RWH) friendly approach to writing new conversion functions?
Thanks Riaan
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

There is a new player in this field named Hasql, which provides
straightforward mappings to list and vector. On top of that the API is
orders of magnitude lighter and the performance is up to 2 and 7 times
better compared to "postgresql-simple" and "HDBC". See the results of
benchmarks: http://nikita-volkov.github.io/hasql-benchmarks/
Best regards,
Nikita
2014-12-26 9:22 GMT+03:00 Amit Aryeh Levy
I doubt you'd need to extend the built-in conversion functions for postgresql-simple. In particular there is already an instance fo `ToField` for:
`ToField a => ToField (Vector a)`
meaning there is an instance for the type `Vector (Vector Float)` (because `Float` is also an instance of `ToField`). I believe that should work out of the box for you. I've never tried using two dimensional arrays, but I've used postgresql arrays as Vectors using postgresql-simple a lot, and it works great out of the box.
If you're interested in going just a little bit higher level without abandoning postgresql-simple, I'd suggest postgresql-orm (shameless plug), which gives you an very lightweight ORM layer on top of postgresql-simple -- specifically a safe query DSL.
-Amit
On 12/25/2014 07:36 PM, Riaan wrote:
This is a question about database query libraries. I am trying to do some analytics on a Postgresql database and up to now have been using Database.HDBC for most of my querying.
One of the columns on the database is a two dimensional float8 array. I tried using Database.PostgreSQL.Simple but got stuck on this array as I could not figure out how to extend the built in conversion functions to cater for something like this. So went back to HDBC. But now my queries are starting to get fairly long and I have been looking at libraries like Persistent with Esqualeto, HaskellDB and Groundhog to make my queries a little more composable and type safe.
However I have not been able to find any examples of any of these libraries using postgres arrays and given my postgresql-simple experience I worried that I might similarly be unable, because of my low level of haskell ability, to extend the conversion functions.
So to my question. Does anyone have experience with one of these libraries in dealing with postgresql arrays and could someone perhaps send me a simple example that I could use as a basis. Failing that, can anyone advise me on which of these libraries have the most haskell newbie (LYAH trained, but still struggling with RWH) friendly approach to writing new conversion functions?
Thanks Riaan
_______________________________________________ Haskell-Cafe mailing listHaskell-Cafe@haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Fri, Dec 26, 2014 at 02:36:07PM +1100, Riaan wrote:
So went back to HDBC. But now my queries are starting to get fairly long and I have been looking at libraries like Persistent with Esqualeto, HaskellDB and Groundhog to make my queries a little more composable and type safe.
Don't forget to look at Opaleye too :) It doesn't really have much support for arrays at the moment, but if you let me know what you want to do I'm happy to help you.
So to my question. Does anyone have experience with one of these libraries in dealing with postgresql arrays
postgresql-simple has instance (FromField a, Typeable a) => FromField (PGArray a) Does that not do exactly what you want? Tom

On Fri, Dec 26, 2014 at 10:52:46AM +0000, Tom Ellis wrote:
On Fri, Dec 26, 2014 at 02:36:07PM +1100, Riaan wrote:
So went back to HDBC. But now my queries are starting to get fairly long and I have been looking at libraries like Persistent with Esqualeto, HaskellDB and Groundhog to make my queries a little more composable and type safe.
Don't forget to look at Opaleye too :) It doesn't really have much support for arrays at the moment, but if you let me know what you want to do I'm happy to help you.
So to my question. Does anyone have experience with one of these libraries in dealing with postgresql arrays
postgresql-simple has
instance (FromField a, Typeable a) => FromField (PGArray a)
Does that not do exactly what you want?
import Database.PostgreSQL.Simple (query_, ConnectInfo(..), connect, Only) import Database.PostgreSQL.Simple.Types (PGArray) import Data.String (fromString) connectInfo :: ConnectInfo connectInfo = ConnectInfo { connectHost = "localhost" , connectPort = 25433 , connectUser = "tom" , connectPassword = "tom" , connectDatabase = "opaleye_test" } arrayQuery :: String arrayQuery = "select '{{1,2}, {3,4}}' :: integer[][]" main :: IO () main = do conn <- connect connectInfo results <- query_ conn (fromString arrayQuery) :: IO [Only (PGArray (PGArray Int))] print results -- Output -- -- ghci> main -- [Only {fromOnly = PGArray {fromPGArray = [PGArray {fromPGArray = [1,2]},PGArray {fromPGArray = [3,4]}]}}]

Groundhog has support for PostgreSQL arrays and almost all operations on them. Check out the docs at http://hackage.haskell.org/package/groundhog-postgresql/docs/Database-Ground... Here is a tutorial for the library https://www.fpcomplete.com/user/lykahb/groundhog The array code looks like main = withPostgresqlConn connectionString . runDbConn $ do key <- insert $ MyData $ Array [1, 2, 3] results <- select $ arrayLength MyField 1 <. (5 :: Int) -- length of array dimension 1 is less than 5 liftIO $ print results On Fri, Dec 26, 2014 at 6:02 AM, Tom Ellis < tom-lists-haskell-cafe-2013@jaguarpaw.co.uk> wrote:
On Fri, Dec 26, 2014 at 02:36:07PM +1100, Riaan wrote:
So went back to HDBC. But now my queries are starting to get fairly long and I have been looking at libraries like Persistent with Esqualeto, HaskellDB and Groundhog to make my queries a little more composable and type safe.
Don't forget to look at Opaleye too :) It doesn't really have much support for arrays at the moment, but if you let me know what you want to do I'm happy to help you.
So to my question. Does anyone have experience with one of these
On Fri, Dec 26, 2014 at 10:52:46AM +0000, Tom Ellis wrote: libraries
in dealing with postgresql arrays
postgresql-simple has
instance (FromField a, Typeable a) => FromField (PGArray a)
Does that not do exactly what you want?
import Database.PostgreSQL.Simple (query_, ConnectInfo(..), connect, Only) import Database.PostgreSQL.Simple.Types (PGArray)
import Data.String (fromString)
connectInfo :: ConnectInfo connectInfo = ConnectInfo { connectHost = "localhost" , connectPort = 25433 , connectUser = "tom" , connectPassword = "tom" , connectDatabase = "opaleye_test" }
arrayQuery :: String arrayQuery = "select '{{1,2}, {3,4}}' :: integer[][]"
main :: IO () main = do conn <- connect connectInfo results <- query_ conn (fromString arrayQuery) :: IO [Only (PGArray (PGArray Int))] print results
-- Output -- -- ghci> main -- [Only {fromOnly = PGArray {fromPGArray = [PGArray {fromPGArray = [1,2]},PGArray {fromPGArray = [3,4]}]}}] _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Regards, Boris

Thank you for pointing me in the right way. This does almost what I want. However I want to end up with a [[Double]] rather than (PGArray (PGArray Double)). I know I can do the conversion using fromPGArray but I was hoping to use the fromRow instances to remove some of the boilerplate. So I have: data IIM = IIM {key :: String ,itype :: String ,idet :: Maybe String ,imat :: (PGArray (PGArray Double))} deriving (Read, Show, Eq) instance FromRow IIM where fromRow = IIM <$> field <*> field <*> field <*> field Which works fine, but I would actually like my data IIM to be: data IIM = IIM {key :: String ,itype :: String ,idet :: Maybe String ,imat :: [[Double]]} deriving (Read, Show, Eq) But I can't figure out how to get a fromRow instance for that, otherwise I need to return SQL results in a (,,,,) and then create the IIM from that which seems a lot of extra typing. PS. I started looking into Opaleye as a possible DSL and would appreciate any help you can give me in figuring out how to represent arrays in that. I am assuming I need to do something with queryRunnerColumn but I was not able to understand the example. On Friday, December 26, 2014 10:02:21 PM UTC+11, Tom Ellis wrote:
On Fri, Dec 26, 2014 at 02:36:07PM +1100, Riaan wrote:
So went back to HDBC. But now my queries are starting to get fairly long and I have been looking at libraries like Persistent with Esqualeto, HaskellDB and Groundhog to make my queries a little more composable and type safe.
Don't forget to look at Opaleye too :) It doesn't really have much support for arrays at the moment, but if you let me know what you want to do I'm happy to help you.
So to my question. Does anyone have experience with one of these
On Fri, Dec 26, 2014 at 10:52:46AM +0000, Tom Ellis wrote: libraries
in dealing with postgresql arrays
postgresql-simple has
instance (FromField a, Typeable a) => FromField (PGArray a)
Does that not do exactly what you want?
import Database.PostgreSQL.Simple (query_, ConnectInfo(..), connect, Only) import Database.PostgreSQL.Simple.Types (PGArray)
import Data.String (fromString)
connectInfo :: ConnectInfo connectInfo = ConnectInfo { connectHost = "localhost" , connectPort = 25433 , connectUser = "tom" , connectPassword = "tom" , connectDatabase = "opaleye_test" }
arrayQuery :: String arrayQuery = "select '{{1,2}, {3,4}}' :: integer[][]"
main :: IO () main = do conn <- connect connectInfo results <- query_ conn (fromString arrayQuery) :: IO [Only (PGArray (PGArray Int))] print results
-- Output -- -- ghci> main -- [Only {fromOnly = PGArray {fromPGArray = [PGArray {fromPGArray = [1,2]},PGArray {fromPGArray = [3,4]}]}}] _______________________________________________ Haskell-Cafe mailing list Haskel...@haskell.org javascript: http://www.haskell.org/mailman/listinfo/haskell-cafe

On Fri, Dec 26, 2014 at 09:31:02PM -0800, info@rotnetix.com wrote:
I would actually like my data IIM to be:
data IIM = IIM {key :: String ,itype :: String ,idet :: Maybe String ,imat :: [[Double]]} deriving (Read, Show, Eq)
But I can't figure out how to get a fromRow instance for that
instance FromRow IIM where fromRow = IIM <$> field <*> field <*> field <*> fmap (T.fromPGArray . fmap T.fromPGArray) field
PS. I started looking into Opaleye as a possible DSL and would appreciate any help you can give me in figuring out how to represent arrays in that. I am assuming I need to do something with queryRunnerColumn but I was not able to understand the example.
This is indeed somewhat fiddly to do because it requires fiddling with the implementation of postgresql-simple instances. Unfortunately that library does not provide us with enough primitives to do this directly. I will work on this. Tom

On Sat, Dec 27, 2014 at 11:23:36AM +0000, Tom Ellis wrote:
PS. I started looking into Opaleye as a possible DSL and would appreciate any help you can give me in figuring out how to represent arrays in that. I am assuming I need to do something with queryRunnerColumn but I was not able to understand the example.
This is indeed somewhat fiddly to do because it requires fiddling with the implementation of postgresql-simple instances. Unfortunately that library does not provide us with enough primitives to do this directly.
OK, I just pushed a patch to GitHub https://github.com/tomjaguarpaw/haskell-opaleye Now you can do the below. You can't actually do anything with your arrays yet except just read them from tables and return them from `runQuery` but let me know what functionality you want and I will endevour to support it. import Database.PostgreSQL.Simple (execute_, ConnectInfo(..), connect) import Data.String (fromString) import Opaleye connectInfo :: ConnectInfo connectInfo = ConnectInfo { connectHost = "localhost" , connectPort = 25433 , connectUser = "tom" , connectPassword = "tom" , connectDatabase = "opaleye_test" } table :: Table (Column (PGArray (PGArray PGInt4))) (Column (PGArray (PGArray PGInt4))) table = Table "arraytable" (required "colname") query :: Query (Column (PGArray (PGArray PGInt4))) query = queryTable table main :: IO () main = do conn <- connect connectInfo let q = execute_ conn . fromString q "DROP TABLE IF EXISTS arraytable" q "CREATE TABLE arraytable (colname integer[][])" q "INSERT INTO arraytable VALUES ('{{1,2}, {3,4}}'), ('{{5,6}, {7,8}}')" results' <- runQuery conn query :: IO [[[Int]]] print results' -- ghci> main -- [[[1,2],[3,4]],[[5,6],[7,8]]]

Thank you very much, that works great. My Haskell, poor as it is, is still a lot better than may SQL so I am doing most of my array operations in Haskell. The only functionality I currently use is array_length, slices (as in SELECT colname [1:2][1:1]) and WHERE colname = '{}'. The other issue I had is once the array select is working is how to select a column with a special name... For some reason out DB designer decided that one of the columns should be named "column". Which is a pain anyway but in normal SQL you can deal with that by selecting it fully qualified as in arrayTable.column but if I try that in opaleye, like: table = Table "arraytable" (required "arraytable.column") the query complains: *** Exception: SqlError {sqlState = "42601", sqlExecStatus = FatalError, sqlErrorMsg = "syntax error at or near \".\"", sqlErrorDetail = "", sqlErrorHint = ""} Finally I am curious as to how easy it will be for me to create a different mapping for PGArray, so that instead of (PGArray (PGArray PGFloat8)) -> [[Double]] I can do (PGArray (PGArray Float8)) -> Matrix Double. It is not a big deal to do the conversion later but if the library allows that kind of thing to be easily done it can make the code more readable. Thanks again for the great support. On Saturday, December 27, 2014 11:09:57 PM UTC+11, Tom Ellis wrote:
PS. I started looking into Opaleye as a possible DSL and would appreciate any help you can give me in figuring out how to represent arrays in
I am assuming I need to do something with queryRunnerColumn but I was not able to understand the example.
This is indeed somewhat fiddly to do because it requires fiddling with
implementation of postgresql-simple instances. Unfortunately that
On Sat, Dec 27, 2014 at 11:23:36AM +0000, Tom Ellis wrote: that. the library
does not provide us with enough primitives to do this directly.
OK, I just pushed a patch to GitHub
https://github.com/tomjaguarpaw/haskell-opaleye
Now you can do the below. You can't actually do anything with your arrays yet except just read them from tables and return them from `runQuery` but let me know what functionality you want and I will endevour to support it.
import Database.PostgreSQL.Simple (execute_, ConnectInfo(..), connect) import Data.String (fromString) import Opaleye
connectInfo :: ConnectInfo connectInfo = ConnectInfo { connectHost = "localhost" , connectPort = 25433 , connectUser = "tom" , connectPassword = "tom" , connectDatabase = "opaleye_test" }
table :: Table (Column (PGArray (PGArray PGInt4))) (Column (PGArray (PGArray PGInt4))) table = Table "arraytable" (required "colname")
query :: Query (Column (PGArray (PGArray PGInt4))) query = queryTable table
main :: IO () main = do conn <- connect connectInfo
let q = execute_ conn . fromString
q "DROP TABLE IF EXISTS arraytable" q "CREATE TABLE arraytable (colname integer[][])" q "INSERT INTO arraytable VALUES ('{{1,2}, {3,4}}'), ('{{5,6}, {7,8}}')"
results' <- runQuery conn query :: IO [[[Int]]] print results'
-- ghci> main -- [[[1,2],[3,4]],[[5,6],[7,8]]] _______________________________________________ Haskell-Cafe mailing list Haskel...@haskell.org javascript: http://www.haskell.org/mailman/listinfo/haskell-cafe

On Sat, Dec 27, 2014 at 05:56:28PM -0800, info@rotnetix.com wrote:
The other issue I had is once the array select is working is how to select a column with a special name... For some reason out DB designer decided that one of the columns should be named "column". Which is a pain anyway but in normal SQL you can deal with that by selecting it fully qualified as in arrayTable.column but if I try that in opaleye, like:
table = Table "arraytable" (required "arraytable.column")
the query complains: *** Exception: SqlError {sqlState = "42601", sqlExecStatus = FatalError, sqlErrorMsg = "syntax error at or near \".\"", sqlErrorDetail = "", sqlErrorHint = ""}
This is now fixed in master https://github.com/tomjaguarpaw/haskell-opaleye/commit/3d9946f3f9ea912aa320e... `required "column"` will work (not `required "arraytable.column"`) I fixed it by wrapping column names in double quotes, not by qualifying the names. You yourself may find the former nicer when you write raw SQL. As an aside, using column names that are keywords or not alphanumeric seems to me to be playing with bees (like playing with fire, but more annoying than dangerous). Tom

Thank you, it works now. I know that it is not advisable to use column names like this, sadly by the time I got involved the DB schema was fixed. On Monday, December 29, 2014 12:39:27 AM UTC+11, Tom Ellis wrote:
On Sat, Dec 27, 2014 at 05:56:28PM -0800, in...@rotnetix.com javascript: wrote:
The other issue I had is once the array select is working is how to select a column with a special name... For some reason out DB designer decided that one of the columns should be named "column". Which is a pain anyway but in normal SQL you can deal with that by selecting it fully qualified as in arrayTable.column but if I try that in opaleye, like:
table = Table "arraytable" (required "arraytable.column")
the query complains: *** Exception: SqlError {sqlState = "42601", sqlExecStatus = FatalError, sqlErrorMsg = "syntax error at or near \".\"", sqlErrorDetail = "", sqlErrorHint = ""}
This is now fixed in master
https://github.com/tomjaguarpaw/haskell-opaleye/commit/3d9946f3f9ea912aa320e...
`required "column"` will work (not `required "arraytable.column"`)
I fixed it by wrapping column names in double quotes, not by qualifying the names. You yourself may find the former nicer when you write raw SQL.
As an aside, using column names that are keywords or not alphanumeric seems to me to be playing with bees (like playing with fire, but more annoying than dangerous).
Tom _______________________________________________ Haskell-Cafe mailing list Haskel...@haskell.org javascript: http://www.haskell.org/mailman/listinfo/haskell-cafe

I am curious as to how easy it will be for me to create a different mapping for PGArray, so that instead of (PGArray (PGArray PGFloat8)) -> [[Double]] I can do (PGArray (PGArray Float8)) -> Matrix Double. It is not a big deal to do the conversion later but if the library allows that kind of thing to be easily done it can make the code more readable. If opaleye is not really intended to do or if it is quite hard just let me know. On Monday, December 29, 2014 1:57:49 PM UTC+11, in...@rotnetix.com wrote:
Thank you, it works now. I know that it is not advisable to use column names like this, sadly by the time I got involved the DB schema was fixed.
On Monday, December 29, 2014 12:39:27 AM UTC+11, Tom Ellis wrote:
On Sat, Dec 27, 2014 at 05:56:28PM -0800, in...@rotnetix.com wrote:
The other issue I had is once the array select is working is how to select a column with a special name... For some reason out DB designer decided that one of the columns should be named "column". Which is a pain anyway but in normal SQL you can deal with that by selecting it fully qualified as in arrayTable.column but if I try that in opaleye, like:
table = Table "arraytable" (required "arraytable.column")
the query complains: *** Exception: SqlError {sqlState = "42601", sqlExecStatus = FatalError, sqlErrorMsg = "syntax error at or near \".\"", sqlErrorDetail = "", sqlErrorHint = ""}
This is now fixed in master
https://github.com/tomjaguarpaw/haskell-opaleye/commit/3d9946f3f9ea912aa320e...
`required "column"` will work (not `required "arraytable.column"`)
I fixed it by wrapping column names in double quotes, not by qualifying the names. You yourself may find the former nicer when you write raw SQL.
As an aside, using column names that are keywords or not alphanumeric seems to me to be playing with bees (like playing with fire, but more annoying than dangerous).
Tom _______________________________________________ Haskell-Cafe mailing list Haskel...@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Sun, Dec 28, 2014 at 06:59:26PM -0800, info@rotnetix.com wrote:
I am curious as to how easy it will be for me to create a different mapping for PGArray, so that instead of (PGArray (PGArray PGFloat8)) -> [[Double]] I can do (PGArray (PGArray Float8)) -> Matrix Double. It is not a big deal to do the conversion later but if the library allows that kind of thing to be easily done it can make the code more readable.
Sure, you could do it by adding a QueryRunnerDefault instance or just a QueryRunner instance for a compound type like the FromRow instance for IIM. Tom

Would you be willing to send me an example of how I would do that please? Thanks Riaan On Tuesday, December 30, 2014 9:01:19 PM UTC+11, Tom Ellis wrote:
On Sun, Dec 28, 2014 at 06:59:26PM -0800, in...@rotnetix.com javascript: wrote:
I am curious as to how easy it will be for me to create a different mapping for PGArray, so that instead of (PGArray (PGArray PGFloat8)) -> [[Double]] I can do (PGArray (PGArray Float8)) -> Matrix Double. It is not a big deal to do the conversion later but if the library allows that kind of thing to be easily done it can make the code more readable.
Sure, you could do it by adding a QueryRunnerDefault instance or just a QueryRunner instance for a compound type like the FromRow instance for IIM.
Tom _______________________________________________ Haskell-Cafe mailing list Haskel...@haskell.org javascript: http://www.haskell.org/mailman/listinfo/haskell-cafe

This will create an orphan instance but there's not much that can be done about that short of wrapping Matrix in a newtype. {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} import Opaleye import Data.Profunctor (rmap) import Data.Profunctor.Product.Default (Default, def) import Data.Matrix (Matrix) -- You have to fill this in yourself matrixFromList :: [[Double]] -> Matrix Double matrixFromList = undefined instance Default QueryRunner (Column (PGArray (PGArray PGFloat8))) (Matrix Double) where def = rmap matrixFromList def On Tue, Dec 30, 2014 at 05:01:06PM -0800, info@rotnetix.com wrote:
Would you be willing to send me an example of how I would do that please?
Thanks Riaan
On Tuesday, December 30, 2014 9:01:19 PM UTC+11, Tom Ellis wrote:
On Sun, Dec 28, 2014 at 06:59:26PM -0800, in...@rotnetix.com javascript: wrote:
I am curious as to how easy it will be for me to create a different mapping for PGArray, so that instead of (PGArray (PGArray PGFloat8)) -> [[Double]] I can do (PGArray (PGArray Float8)) -> Matrix Double. It is not a big deal to do the conversion later but if the library allows that kind of thing to be easily done it can make the code more readable.
Sure, you could do it by adding a QueryRunnerDefault instance or just a QueryRunner instance for a compound type like the FromRow instance for IIM.
Tom _______________________________________________ Haskell-Cafe mailing list Haskel...@haskell.org javascript: http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Thank you, that works. I started down this road but I only got to: instance FromRow IIM where fromRow = IIM <$> field <*> field <*> field <*> T.fromPGArray (fmap T.fromPGArray field) Which I expected to work based on the fact that this is what I need to convert (PGArray (PGArray Double)) to [[Double]]. Why is there an additional fmap needed? On Saturday, December 27, 2014 10:23:47 PM UTC+11, Tom Ellis wrote:
On Fri, Dec 26, 2014 at 09:31:02PM -0800, in...@rotnetix.com javascript: wrote:
I would actually like my data IIM to be:
data IIM = IIM {key :: String ,itype :: String ,idet :: Maybe String ,imat :: [[Double]]} deriving (Read, Show, Eq)
But I can't figure out how to get a fromRow instance for that
instance FromRow IIM where fromRow = IIM <$> field <*> field <*> field <*> fmap (T.fromPGArray . fmap T.fromPGArray) field
PS. I started looking into Opaleye as a possible DSL and would appreciate any help you can give me in figuring out how to represent arrays in that. I am assuming I need to do something with queryRunnerColumn but I was not able to understand the example.
This is indeed somewhat fiddly to do because it requires fiddling with the implementation of postgresql-simple instances. Unfortunately that library does not provide us with enough primitives to do this directly.
I will work on this.
Tom
_______________________________________________ Haskell-Cafe mailing list Haskel...@haskell.org javascript: http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (6)
-
Amit Aryeh Levy
-
Boris Lykah
-
info@rotnetix.com
-
Nikita Volkov
-
Riaan
-
Tom Ellis