mirror of
https://github.com/typeable/id.git
synced 2024-09-11 13:26:02 +03:00
Merge pull request #3 from typeable/ville/add-read-instance
Add read instance for benefit of yesod in contractor
This commit is contained in:
commit
676e18ea93
@ -31,6 +31,7 @@ import Data.Csv as Csv hiding(Name)
|
||||
import Flat as F
|
||||
import GHC.TypeLits
|
||||
import Test.QuickCheck
|
||||
import Text.ParserCombinators.ReadP
|
||||
import Web.HttpApiData
|
||||
import Web.PathPieces (PathPiece(..))
|
||||
|
||||
@ -55,6 +56,11 @@ mkId = coerce
|
||||
instance KnownSymbol s => Show (Id s) where
|
||||
show (Id v) = "Id-" <> symbolVal (Proxy @s) <> "-" <> show v
|
||||
|
||||
instance KnownSymbol s => Read (Id s) where
|
||||
readsPrec _ = readP_to_S $ do
|
||||
_ <- string ("Id-" <> symbolVal (Proxy @s) <> "-")
|
||||
mkId <$> readS_to_P reads
|
||||
|
||||
instance Flat (Id s) where
|
||||
encode = F.encode . UUID.toWords . coerce
|
||||
decode = coerce . (\(a,b,c,d) -> UUID.fromWords a b c d) <$> F.decode
|
||||
@ -122,6 +128,11 @@ mkIntId = coerce
|
||||
instance KnownSymbol s => Show (IntId s) where
|
||||
show (IntId v) = "IntId-" <> symbolVal (Proxy @s) <> "-" <> show v
|
||||
|
||||
instance KnownSymbol s => Read (IntId s) where
|
||||
readsPrec _ = readP_to_S $ do
|
||||
_ <- string ("IntId-" <> symbolVal (Proxy @s) <> "-")
|
||||
mkIntId <$> readS_to_P reads
|
||||
|
||||
-- | This is a more \"explicit\" 'coerce' specifically for 'IntId'.
|
||||
-- You are forced to explicitly specify the phantom types you are converting
|
||||
-- via the @TypeApplications@ compiler extension.
|
||||
@ -155,6 +166,11 @@ mkName = coerce
|
||||
instance KnownSymbol s => Show (Name s) where
|
||||
show (Name v) = "Name-" <> symbolVal (Proxy @s) <> "-" <> show v
|
||||
|
||||
instance KnownSymbol s => Read (Name s) where
|
||||
readsPrec _ = readP_to_S $ do
|
||||
_ <- string ("Name-" <> symbolVal (Proxy @s) <> "-")
|
||||
mkName <$> readS_to_P reads
|
||||
|
||||
instance Arbitrary (Name s) where
|
||||
arbitrary = coerce . T.pack . getPrintableString <$> arbitrary
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user