Sample derived from https://ocharles.org.uk/blog/posts/2014-08-07-postgresql-simple-generic-sop.html

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
-- based on https://ocharles.org.uk/blog/posts/2014-08-07-postgresql-simple-generic-sop.html

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Data.Text
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.FromField
import Database.PostgreSQL.Simple.ToRow
import Database.PostgreSQL.Simple.ToField
import Generics.SOP
import qualified GHC.Generics as GHC

type ISBN = Text

data Book = Book
  { bookTitle :: Text
  , bookAuthor :: Text
  , bookISBN :: ISBN
  , bookPublishYear :: Int
  }
  deriving (GHC.Generic)
instance Generics.SOP.Generic Book


instance FromRow Book where fromRow = gfromRow
instance ToRow   Book where toRow = gtoRow

{-
instance ToRow Book where
  toRow Book{..} =
    [ toField bookTitle
    , toField bookAuthor
    , toField bookISBN
    , toField bookPublishYear
    ]
-}

book' = Book "Conceptual Mathematics" "Lawvere, Schanuel" "978-0-521-71916-2" 2009
-- book = [ "Conceptual Mathematics", "Lawvere, Schanuel", "978-0-521-71916-2", 2009 ]


data HList :: [*] -> * where
  NilH :: HList '[]
  (:*%) :: x -> HList xs -> HList (x ': xs)

{-
book :: HList '[Text, Text, ISBN, Int]
book = ("Conceptual Mathematics"::Text)
    :*% ("Lawvere, Schanuel"::Text)
    :*% ("978-0-521-71916-2"::Text)
    :*% (2009::Int)
    :*% NilH
-}

-- Using actual generics-sop versions
book1 :: NP I '[Text, Text, ISBN, Int]
book1 = (I "Conceptual Mathematics")
    :* (I "Lawvere, Schanuel")
    :* (I "978-0-521-71916-2")
    :* (I (2009::Int))
    :* Nil


fields :: (All FromField xs, SingI xs) => NP RowParser xs
fields = hcpure fromFieldP field
  where fromFieldP = Proxy :: Proxy FromField

gfromRow
  :: (All FromField xs, Code a ~ '[xs], SingI xs, Generic a)
  => RowParser a
gfromRow = to . SOP . Z <$> hsequence (hcpure fromField field)
  where fromField = Proxy :: Proxy FromField


gtoRow :: (Generic a, Code a ~ '[xs], All ToField xs, SingI xs) => a -> [Action]
gtoRow a =
  case from a of
    SOP (Z xs) -> hcollapse (hcliftA p (K . toField . unI) xs)

  where -- toField = Proxy :: Proxy ToField
        p = Proxy :: Proxy ToField

-- ---------------------------------------------------------------------

type Country = Text
data Author = Author
  { authorId :: Int
  , authorName :: Text
  , authorCountry :: Country
  } deriving (GHC.Generic)

instance Generics.SOP.Generic Author
instance FromRow Author where fromRow = gfromRow
instance ToRow Author where toRow = gtoRow