database-id-groundhog (empty) → 0.1.0.1

raw patch · 7 files changed

+157/−0 lines, 7 filesdep +aesondep +basedep +database-id-classsetup-changed

Dependencies added: aeson, base, database-id-class, groundhog, template-haskell

Files

CHANGELOG.md +11/−0
LICENSE +30/−0
README.md +19/−0
Setup.hs +2/−0
database-id-groundhog.cabal +27/−0
src/Database/Id/Groundhog.hs +39/−0
src/Database/Id/Groundhog/TH.hs +29/−0

+ CHANGELOG.md view

@@ -0,0 +1,11 @@+# Revision history for database-id-groundhog++## 0.1.0.1++* Add readme++## 0.1.0.0++* Initial release. Defines the DefaultKeyId class, connecting groundhog IDs to HasId instances, and some convenience functions for going back and forth between the two.+* Add PersistField instances handy for storing `Id`s in the database (e.g., as foreign keys).+* Add Template Haskell for generating IdData and DefaultKeyId instances

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Obsidian Systems LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Obsidian Systems LLC nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,19 @@+database-id-groundhog+---------------------++This package provides support for groundhog database interaction to database-id-class, in particular, the functions++    toId :: DefaultKeyId a => DefaultKey a -> Id a+    fromId :: DefaultKeyId a => Id a -> DefaultKey a++which convert back and forth between the Id and groundhog's DefaultKey representation according to the instances of+the `DefaultKeyId` class.++It also includes the Template Haskell macro `makeDefaultKeyIdInt64` which, given the `Name` of a datatype and the `Name` of+the data constructor for its groundhog-generated key datatype (typically named the same as the type, with the suffix+"Key"), produces an instance of DefaultKeyId in cases where the primary key is an `Int64`.++Similar to this, `makeDefaultKeyIdSimple` exists for cases where all that is required to go between `DefaultKey a` and+`IdData a` is to remove (or put back) Groundhog's type-specific Key data constructor.++It also includes instances of `PersistField` and `PrimitivePersistField` for `Id a`.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ database-id-groundhog.cabal view

@@ -0,0 +1,27 @@+cabal-version:       >=1.10+name:                database-id-groundhog+version:             0.1.0.1+synopsis:            HasId/Groundhog interop+description:         A class and some instances for HasId/Groundhog interoperation+license:             BSD3+license-file:        LICENSE+author:              Obsidian Systems LLC+maintainer:          maintainer@obsidian.systems+copyright:           2019 Obsidian Systems LLC+category:            Database+build-type:          Simple+extra-source-files: CHANGELOG.md+                    README.md++library+  exposed-modules: Database.Id.Groundhog+                 , Database.Id.Groundhog.TH+  other-extensions: QuasiQuotes+                  , TemplateHaskell+  build-depends: base >=4.11 && <4.13+               , aeson+               , database-id-class+               , groundhog <= 0.7.0.3+               , template-haskell+  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Database/Id/Groundhog.hs view

@@ -0,0 +1,39 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}+module Database.Id.Groundhog where++import Data.Proxy+import Database.Groundhog.Core+import Database.Id.Class++class HasId a => DefaultKeyId a where+  toIdData :: Proxy a -> DefaultKey a -> IdData a+  fromIdData :: Proxy a -> IdData a -> DefaultKey a++toId :: forall a. DefaultKeyId a => DefaultKey a -> Id a+toId = Id . toIdData (Proxy :: Proxy a)++fromId :: forall a. DefaultKeyId a => Id a -> DefaultKey a+fromId = fromIdData (Proxy :: Proxy a) . unId++deriving instance NeverNull (IdData a) => NeverNull (Id a) -- A redundant constraint warning is expected here++instance (PersistField (DefaultKey a), DefaultKeyId a) => PersistField (Id a) where+  persistName = persistName+  toPersistValues = toPersistValues . fromId+  fromPersistValues vs = do+    (a, vs') <- fromPersistValues vs+    return (toId a, vs')+  dbType p _ = dbType p (undefined :: DefaultKey a)++instance (PrimitivePersistField (DefaultKey a), DefaultKeyId a) => PrimitivePersistField (Id a) where+  toPrimitivePersistValue p = toPrimitivePersistValue p . fromId+  fromPrimitivePersistValue p = toId . fromPrimitivePersistValue p++type IdDataIs a b = IdData a ~ b

+ src/Database/Id/Groundhog/TH.hs view

@@ -0,0 +1,29 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++module Database.Id.Groundhog.TH where++import Data.Int+import Database.Id.Groundhog+import Database.Groundhog.Core+import Language.Haskell.TH++makeDefaultKeyIdInt64 :: Name -> Name -> Q [Dec]+makeDefaultKeyIdInt64 n k = do+  pv <- newName "pv"+  [d|+    instance IdDataIs $(conT n) Int64 => DefaultKeyId $(conT n) where+      toIdData _ dk = case $(lamE [conP k [varP pv]] (varE pv)) dk of+        PersistInt64 x -> x+        _ -> error "makeDefaultKeyIdInt64: pattern match failure (this should be impossible)"+      fromIdData _ = $(conE k) . PersistInt64+    |]++makeDefaultKeyIdSimple :: Name -> Name -> Q [Dec]+makeDefaultKeyIdSimple n k = do+  pv <- newName "pv"+  [d|+    instance DefaultKeyId $(conT n) where+      toIdData _ = $(lamE [conP k [varP pv]] (varE pv))+      fromIdData _ = $(conE k)+    |]