@@ -1,11 +1,14 @@
1+{-# LANGUAGE TemplateHaskell #-}
12{-# OPTIONS_GHC -Wno-orphans #-}
23
34module Data.Id
45 ( Id(..)
56 , coerceId
7+ , _Id
68 ) where
79
810import Control.DeepSeq (NFData)
11+import Control.Lens
912import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
1013import Data.Binary (Binary)
1114import Data.Coerce (coerce)
@@ -15,22 +18,32 @@ import qualified Data.UUID as UUID
1518import Database.PostgreSQL.Simple.FromField (FromField)
1619import Database.PostgreSQL.Simple.ToField (ToField)
1720import GHC.Generics (Generic)
21+import Test.QuickCheck
1822import Yesod.Core (PathPiece(..))
1923
2024
21−newtype Id (t :: k) = Id { unId :: UUID }
25+newtype Id t = Id { unId :: UUID }
2226 deriving
2327 ( Eq, Ord, Generic, Read, Show, ToField, FromField, PathPiece, FromJSON
2428 , ToJSON, NFData, Hashable, FromJSONKey, ToJSONKey)
2529
2630type role Id nominal
2731
32+instance Arbitrary (Id t) where
33+ arbitrary = fmap Id $ UUID.fromWords
34+ <$> arbitrary
35+ <*> arbitrary
36+ <*> arbitrary
37+ <*> arbitrary
38+
2839instance Binary (Id t) where
2940
3041instance PathPiece UUID.UUID where
3142 fromPathPiece = UUID.fromText
3243 toPathPiece = UUID.toText
3344
45+makePrisms ''Id
46+
3447-- | This is a more \"explicit\" 'coerce' specifically for 'Id'.
3548-- You are forced to explicitly specify the phantom types you are converting
3649-- via the @TypeApplications@ compiler extension.