Contact/support | Changelog
Edit - Annotate - Report/Delete

TestsUnpacked.hs

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Tests where

import Database.Persist
import Database.Persist.TH

import ADB

data Person
    = Person {personName :: String,
              personAge :: Int,
              personColor :: Maybe String}
    deriving (Show, Read, Eq)
type PersonId = Key Person
instance PersistEntity Person where
    newtype instance Key Person
        = PersonId GHC.Int.Int64
        deriving (Show,
                  Read,
                  Num,
                  Integral,
                  Enum,
                  Eq,
                  Ord,
                  Real,
                  PersistField,
                  Web.Routes.Quasi.Classes.SinglePiece)
    data instance Filter Person
        = PersonNameEq String |
          PersonNameNe String |
          PersonAgeLt Int |
          PersonAgeEq Int |
          PersonColorEq Maybe String |
          PersonColorNe Maybe String
        deriving (Show, Read, Eq)
    data instance Update Person
        = PersonName String | PersonAge Int | PersonAgeAdd Int
        deriving (Show, Read, Eq)
    data instance Order Person
        = PersonNameDesc | PersonAgeAsc | PersonAgeDesc
        deriving (Show, Read, Eq)
    data instance Unique Person
        = PersonNameKey String deriving (Show, Read, Eq)
    { entityDef _ = Database.Persist.Base.EntityDef
                      "Person"
                      []
                      [("name", "String", ["Update", "Eq", "Ne", "Desc"]),
                       ("age", "Int", 
                        ["Update", "Asc", "Desc", "Lt", "some ignored -- attribute", "Eq",
                         "Add"]),
                       ("color", "String", ["Maybe", "Eq", "Ne"])]
                      [("PersonNameKey", ["name"])]
                      ["Show", "Read", "Eq"]
      toPersistFields Person x[a2u2] x[a2u3] x[a2u4]
                        = [Database.Persist.Base.SomePersistField x[a2u2],
                           Database.Persist.Base.SomePersistField x[a2u3],
                           Database.Persist.Base.SomePersistField x[a2u4]]
      fromPersistValues [x[a2u5], x[a2u6], x[a2u7]]
                          = (((Right Person
                             `Database.Persist.TH.apE`
                               fromPersistValue x[a2u5])
                            `Database.Persist.TH.apE`
                              fromPersistValue x[a2u6])
                           `Database.Persist.TH.apE`
                             fromPersistValue x[a2u7])
      fromPersistValues _ = Left "Invalid fromPersistValues input"
      halfDefined = Person undefined undefined undefined
      toPersistKey = fromIntegral
      fromPersistKey = fromIntegral
      showPersistKey = show
      persistOrderToFieldName PersonNameDesc {} = "name"
      persistOrderToFieldName PersonAgeAsc {} = "age"
      persistOrderToFieldName PersonAgeDesc {} = "age"
      persistOrderToOrder PersonNameDesc {} = Database.Persist.Base.Desc
      persistOrderToOrder PersonAgeAsc {} = Database.Persist.Base.Asc
      persistOrderToOrder PersonAgeDesc {} = Database.Persist.Base.Desc
      persistUpdateToFieldName PersonName {} = "name"
      persistUpdateToFieldName PersonAge {} = "age"
      persistUpdateToFieldName PersonAgeAdd {} = "age"
      persistUpdateToValue PersonName x = toPersistValue x
      persistUpdateToValue PersonAge x = toPersistValue x
      persistUpdateToValue PersonAgeAdd x = toPersistValue x
      persistUpdateToUpdate PersonName {} = Database.Persist.Base.Update
      persistUpdateToUpdate PersonAge {} = Database.Persist.Base.Update
      persistUpdateToUpdate PersonAgeAdd {} = Database.Persist.Base.Add
      persistFilterToFieldName PersonNameEq {} = "name"
      persistFilterToFieldName PersonNameNe {} = "name"
      persistFilterToFieldName PersonAgeLt {} = "age"
      persistFilterToFieldName PersonAgeEq {} = "age"
      persistFilterToFieldName PersonColorEq {} = "color"
      persistFilterToFieldName PersonColorNe {} = "color"
      persistFilterToValue PersonNameEq x[a2uc]
                             = (Left . toPersistValue) x[a2uc]
      persistFilterToValue PersonNameNe x[a2ud]
                             = (Left . toPersistValue) x[a2ud]
      persistFilterToValue PersonAgeLt x[a2ue]
                             = (Left . toPersistValue) x[a2ue]
      persistFilterToValue PersonAgeEq x[a2uf]
                             = (Left . toPersistValue) x[a2uf]
      persistFilterToValue PersonColorEq x[a2ug]
                             = (Left . toPersistValue) x[a2ug]
      persistFilterToValue PersonColorNe x[a2uh]
                             = (Left . toPersistValue) x[a2uh]
      persistUniqueToFieldNames PersonNameKey {} = ["name"]
      persistUniqueToValues PersonNameKey x[a2u8]
                              = [toPersistValue x[a2u8]]
      persistUniqueKeys Person _name[a2u9] _age[a2ua] _color[a2ub]
                          = [PersonNameKey _name[a2u9]]
      persistFilterToFilter PersonNameEq {} = Database.Persist.Base.Eq
      persistFilterToFilter PersonNameNe {} = Database.Persist.Base.Ne
      persistFilterToFilter PersonAgeLt {} = Database.Persist.Base.Lt
      persistFilterToFilter PersonAgeEq {} = Database.Persist.Base.Eq
      persistFilterToFilter PersonColorEq {} = Database.Persist.Base.Eq
      persistFilterToFilter PersonColorNe {} = Database.Persist.Base.Ne }
data Pet
    = Pet {petOwner :: PersonId, petName :: String, petType :: PetType}
    deriving (Show, Read, Eq)
type PetId = Key Pet
instance PersistEntity Pet where
    newtype instance Key Pet
        = PetId GHC.Int.Int64
        deriving (Show,
                  Read,
                  Num,
                  Integral,
                  Enum,
                  Eq,
                  Ord,
                  Real,
                  PersistField,
                  Web.Routes.Quasi.Classes.SinglePiece)
    data instance Filter Pet
        = PetOwnerEq PersonId deriving (Show, Read, Eq)
    data instance Update Pet =
    data instance Order Pet =
    data instance Unique Pet =
    { entityDef _ = Database.Persist.Base.EntityDef
                      "Pet"
                      []
                      [("owner", "PersonId", ["Eq"]), ("name", "String", []),
                       ("type", "PetType", [])]
                      []
                      ["Show", "Read", "Eq"]
      toPersistFields Pet x[a2ui] x[a2uj] x[a2uk]
                        = [Database.Persist.Base.SomePersistField x[a2ui],
                           Database.Persist.Base.SomePersistField x[a2uj],
                           Database.Persist.Base.SomePersistField x[a2uk]]
      fromPersistValues [x[a2ul], x[a2um], x[a2un]]
                          = (((Right Pet `Database.Persist.TH.apE` fromPersistValue x[a2ul])
                            `Database.Persist.TH.apE`
                              fromPersistValue x[a2um])
                           `Database.Persist.TH.apE`
                             fromPersistValue x[a2un])
      fromPersistValues _ = Left "Invalid fromPersistValues input"
      halfDefined = Pet undefined undefined undefined
      toPersistKey = fromIntegral
      fromPersistKey = fromIntegral
      showPersistKey = show
      persistOrderToFieldName _ = error
                                    "Degenerate case, should never happen"
      persistOrderToOrder _ = error
                                "Degenerate case, should never happen"
      persistUpdateToFieldName _ = error
                                     "Degenerate case, should never happen"
      persistUpdateToValue _ = error
                                 "Degenerate case, should never happen"
      persistUpdateToUpdate _ = error
                                  "Degenerate case, should never happen"
      persistFilterToFieldName PetOwnerEq {} = "owner"
      persistFilterToValue PetOwnerEq x[a2ur]
                             = (Left . toPersistValue) x[a2ur]
      persistUniqueToFieldNames _ = error
                                      "Degenerate case, should never happen"
      persistUniqueToValues _ = error
                                  "Degenerate case, should never happen"
      persistUniqueKeys Pet _owner[a2uo] _name[a2up] _type[a2uq] = []
      persistFilterToFilter PetOwnerEq {} = Database.Persist.Base.Eq }

data PetType = Cat | Dog
    deriving (Show, Read, Eq)
instance PersistField PetType where
        { sqlType _ = Database.Persist.Base.SqlString
          toPersistValue = (Database.Persist.Base.PersistString . show)
          fromPersistValue = \ dt[a3pQ] v[a3pR]
                                 -> case fromPersistValue v[a3pR] of {
                                      Left e[a3pS] -> Left e[a3pS]
                                      Right s'[a3pT]
                                        -> case reads s'[a3pT] of {
                                             (x[a3pU], _) GHC.Types.: _ -> Right x[a3pU]
                                             GHC.Types.[]
                                               -> (Left
                                                 $ ("Invalid "
                                                  ++
                                                    (dt[a3pQ] ++ (": " ++ s'[a3pT])))) } }
                               "PetType" }
Diff original - Edit - Annotate - Report/Delete

Tests.hs (annotation)

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

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Tests where

import Database.Persist
import Database.Persist.TH

import ADB

mkPersist [$persist|
  Person
    name String Update Eq Ne Desc
    age Int Update "Asc" Desc Lt "some ignored -- attribute" Eq Add
    color String Maybe Eq Ne -- this is a comment sql=foobarbaz
    PersonNameKey name -- this is a comment sql=foobarbaz
  Pet
    owner PersonId Eq
    name String
    type PetType
|]

data PetType = Cat | Dog
    deriving (Show, Read, Eq)
derivePersistField "PetType"
Diff original / prev - Edit - Annotate - Report/Delete

shortened failing code

1
2
3
4
5
6
7
8
9
10

{-# LANGUAGE TypeFamilies #-}
module Tests where

class PersistEntity val where
    data Key val

data Person = Person
type PersonId = Key Person
instance PersistEntity Person where
    newtype instance Key Person = PersonId Int
Diff original / prev - Edit - Annotate - Report/Delete

apE not in scope?

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE EmptyDataDecls #-}
module Tests where

import Database.Persist
import Database.Persist.Base
import Database.Persist.TH
import GHC.Int
import Web.Routes.Quasi.Classes

import ADB

data Person
    = Person {personName :: String,
              personAge :: Int,
              personColor :: Maybe String}
    deriving (Show, Read, Eq)
type PersonId = Key Person
instance PersistEntity Person where
    newtype Key Person
        = PersonId GHC.Int.Int64
        deriving (Show,
                  Read,
                  Num,
                  Integral,
                  Enum,
                  Eq,
                  Ord,
                  Real,
                  PersistField,
                  Web.Routes.Quasi.Classes.SinglePiece)
    data Filter Person
        = PersonNameEq String |
          PersonNameNe String |
          PersonAgeLt Int |
          PersonAgeEq Int |
          PersonColorEq (Maybe String) |
          PersonColorNe (Maybe String)
        deriving (Show, Read, Eq)
    data Update Person
        = PersonName String | PersonAge Int | PersonAgeAdd Int
        deriving (Show, Read, Eq)
    data Order Person
        = PersonNameDesc | PersonAgeAsc | PersonAgeDesc
        deriving (Show, Read, Eq)
    data Unique Person
        = PersonNameKey String deriving (Show, Read, Eq)
    entityDef _ = Database.Persist.Base.EntityDef
                      "Person"
                      []
                      [("name", "String", ["Update", "Eq", "Ne", "Desc"]),
                       ("age", "Int", 
                        ["Update", "Asc", "Desc", "Lt", "some ignored -- attribute", "Eq",
                         "Add"]),
                       ("color", "String", ["Maybe", "Eq", "Ne"])]
                      [("PersonNameKey", ["name"])]
                      ["Show", "Read", "Eq"]
    toPersistFields (Person x_a2u2_ x_a2u3_ x_a2u4_)
                        = [Database.Persist.Base.SomePersistField x_a2u2_,
                           Database.Persist.Base.SomePersistField x_a2u3_,
                           Database.Persist.Base.SomePersistField x_a2u4_]
    fromPersistValues [x_a2u5_, x_a2u6_, x_a2u7_]
                          = (((Right Person
                             `apE`
                               fromPersistValue x_a2u5_)
                            `apE`
                              fromPersistValue x_a2u6_)
                           `apE`
                             fromPersistValue x_a2u7_)
    fromPersistValues _ = Left "Invalid fromPersistValues input"
    halfDefined = Person undefined undefined undefined
    toPersistKey = fromIntegral
    fromPersistKey = fromIntegral
    showPersistKey = show
    persistOrderToFieldName PersonNameDesc {} = "name"
    persistOrderToFieldName PersonAgeAsc {} = "age"
    persistOrderToFieldName PersonAgeDesc {} = "age"
    persistOrderToOrder PersonNameDesc {} = Database.Persist.Base.Desc
    persistOrderToOrder PersonAgeAsc {} = Database.Persist.Base.Asc
    persistOrderToOrder PersonAgeDesc {} = Database.Persist.Base.Desc
    persistUpdateToFieldName PersonName {} = "name"
    persistUpdateToFieldName PersonAge {} = "age"
    persistUpdateToFieldName PersonAgeAdd {} = "age"
    persistUpdateToValue (PersonName x) = toPersistValue x
    persistUpdateToValue (PersonAge x) = toPersistValue x
    persistUpdateToValue (PersonAgeAdd x) = toPersistValue x
    persistUpdateToUpdate (PersonName {}) = Database.Persist.Base.Update
    persistUpdateToUpdate (PersonAge {}) = Database.Persist.Base.Update
    persistUpdateToUpdate (PersonAgeAdd {}) = Database.Persist.Base.Add
    persistFilterToFieldName (PersonNameEq {}) = "name"
    persistFilterToFieldName (PersonNameNe {}) = "name"
    persistFilterToFieldName (PersonAgeLt {}) = "age"
    persistFilterToFieldName (PersonAgeEq {}) = "age"
    persistFilterToFieldName (PersonColorEq {}) = "color"
    persistFilterToFieldName (PersonColorNe {}) = "color"
    persistFilterToValue (PersonNameEq x_a2uc_)
                             = (Left . toPersistValue) x_a2uc_
    persistFilterToValue (PersonNameNe x_a2ud_)
                             = (Left . toPersistValue) x_a2ud_
    persistFilterToValue (PersonAgeLt x_a2ue_)
                             = (Left . toPersistValue) x_a2ue_
    persistFilterToValue (PersonAgeEq x_a2uf_)
                             = (Left . toPersistValue) x_a2uf_
    persistFilterToValue (PersonColorEq x_a2ug_)
                             = (Left . toPersistValue) x_a2ug_
    persistFilterToValue (PersonColorNe x_a2uh_)
                             = (Left . toPersistValue) x_a2uh_
    persistUniqueToFieldNames (PersonNameKey {}) = ["name"]
    persistUniqueToValues (PersonNameKey x_a2u8_)
                              = [toPersistValue x_a2u8_]
    persistUniqueKeys (Person _name_a2u9_ _age_a2ua_ _color_a2ub_)
                          = [PersonNameKey _name_a2u9_]
    persistFilterToFilter (PersonNameEq {}) = Database.Persist.Base.Eq
    persistFilterToFilter (PersonNameNe {}) = Database.Persist.Base.Ne
    persistFilterToFilter (PersonAgeLt {}) = Database.Persist.Base.Lt
    persistFilterToFilter (PersonAgeEq {}) = Database.Persist.Base.Eq
    persistFilterToFilter (PersonColorEq {}) = Database.Persist.Base.Eq
    persistFilterToFilter (PersonColorNe {}) = Database.Persist.Base.Ne
data Pet
    = Pet {petOwner :: PersonId, petName :: String, petType :: PetType}
    deriving (Show, Read, Eq)
type PetId = Key Pet
instance PersistEntity Pet where
    newtype Key Pet
        = PetId GHC.Int.Int64
        deriving (Show,
                  Read,
                  Num,
                  Integral,
                  Enum,
                  Eq,
                  Ord,
                  Real,
                  PersistField,
                  Web.Routes.Quasi.Classes.SinglePiece)
    data Filter Pet
        = PetOwnerEq PersonId deriving (Show, Read, Eq)
    data Update Pet
    data Order Pet
    data Unique Pet
    entityDef _ = Database.Persist.Base.EntityDef
                      "Pet"
                      []
                      [("owner", "PersonId", ["Eq"]), ("name", "String", []),
                       ("type", "PetType", [])]
                      []
                      ["Show", "Read", "Eq"]
    toPersistFields (Pet x_a2ui_ x_a2uj_ x_a2uk_)
                        = [Database.Persist.Base.SomePersistField x_a2ui_,
                           Database.Persist.Base.SomePersistField x_a2uj_,
                           Database.Persist.Base.SomePersistField x_a2uk_]
    fromPersistValues [x_a2ul_, x_a2um_, x_a2un_]
                          = (((Right Pet `apE` fromPersistValue x_a2ul_)
                            `apE`
                              fromPersistValue x_a2um_)
                           `apE`
                             fromPersistValue x_a2un_)
    fromPersistValues _ = Left "Invalid fromPersistValues input"
    halfDefined = Pet undefined undefined undefined
    toPersistKey = fromIntegral
    fromPersistKey = fromIntegral
    showPersistKey = show
    persistOrderToFieldName _ = error
                                    "Degenerate case, should never happen"
    persistOrderToOrder _ = error
                                "Degenerate case, should never happen"
    persistUpdateToFieldName _ = error
                                     "Degenerate case, should never happen"
    persistUpdateToValue _ = error
                                 "Degenerate case, should never happen"
    persistUpdateToUpdate _ = error
                                  "Degenerate case, should never happen"
    persistFilterToFieldName PetOwnerEq {} = "owner"
    persistFilterToValue (PetOwnerEq x_a2ur_)
                             = (Left . toPersistValue) x_a2ur_
    persistUniqueToFieldNames _ = error
                                      "Degenerate case, should never happen"
    persistUniqueToValues _ = error
                                  "Degenerate case, should never happen"
    persistUniqueKeys (Pet _owner_a2uo_ _name_a2up_ _type_a2uq_) = []
    persistFilterToFilter (PetOwnerEq {}) = Database.Persist.Base.Eq

data PetType = Cat | Dog
    deriving (Show, Read, Eq)
derivePersistField "PetType"

apE :: Either x (y -> z) -> Either x y -> Either x z
apE (Left x) _ = Left x
apE _ (Left x) = Left x
apE (Right f) (Right y) = Right $ f y

{-

TestsUnpacked.hs:67:29: Not in scope: `apE'

TestsUnpacked.hs:69:28: Not in scope: `apE'

TestsUnpacked.hs:71:27: Not in scope: `apE'

TestsUnpacked.hs:156:41: Not in scope: `apE'

TestsUnpacked.hs:157:28: Not in scope: `apE'

TestsUnpacked.hs:159:27: Not in scope: `apE'
-}

Web site source code on Github / Real World Haskell / Haskell.org / Planet Haskell