Skip to content

Instantly share code, notes, and snippets.

@japesinator
Last active August 29, 2015 14:23
Show Gist options
  • Save japesinator/4ededf7ce5b171060e76 to your computer and use it in GitHub Desktop.
Save japesinator/4ededf7ce5b171060e76 to your computer and use it in GitHub Desktop.
mkPersist sqlSettings [persistLowerCase|
Person
name String
age Int
deriving Show
|]
data Person = Person
{ personName :: !String
, personAge :: !Int
}
deriving Show
type PersonId = Key Person
instance PersistEntity Person where
newtype Key Person = PersonKey (BackendKey SqlBackend)
deriving (PersistField, Show, Eq, Read, Ord)
data EntityField Person typ where
PersonId :: EntityField Person PersonId
PersonName :: EntityField Person String
PersonAge :: EntityField Person Int
data Unique Person
type PersistEntityBackend Person = SqlBackend
toPersistFields (Person name age) =
[ SomePersistField name
, SomePersistField age
]
fromPersistValues [nameValue, ageValue] = Person
<$> fromPersistValue nameValue
<*> fromPersistValue ageValue
fromPersistValues _ = Left "Invalid fromPersistValues input"
persistFieldDef PersonId = FieldDef
(HaskellName "Id")
(DBName "id")
(FTTypeCon Nothing "PersonId")
SqlInt64
[]
True
NoReference
persistFieldDef PersonName = FieldDef
(HaskellName "name")
(DBName "name")
(FTTypeCon Nothing "String")
SqlString
[]
True
NoReference
persistFieldDef PersonAge = FieldDef
(HaskellName "age")
(DBName "age")
(FTTypeCon Nothing "Int")
SqlInt64
[]
True
NoReference
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment