diff options
| -rw-r--r-- | ChangeLog.md | 15 | ||||
| -rw-r--r-- | src/Data/UUID/Typed.hs | 91 | ||||
| -rw-r--r-- | typed-uuid.cabal | 5 |
3 files changed, 75 insertions, 36 deletions
diff --git a/ChangeLog.md b/ChangeLog.md index c93d176..3aaa68e 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,21 @@ ## Unreleased changes +## [0.1.0.0] - 2020-05-10 + +### Added + +* `parseUUIDAsciiBytes` +* `parseUUIDLazyAsciiBytes` +* `instance YamlSchema (UUID a)` +* `instance YamlKeySchema (UUID a)` + +### Changed + +* Renamed `uuidBs` to `uuidASCIIBytes` +* Renamed `uuidLBs` to `uuidLazyASCIIBytes` +* Renamed `parseUUID` to `parseUUIDText` + ## [0.0.0.2] - 2020-02-13 Put a lower bound on the base version diff --git a/src/Data/UUID/Typed.hs b/src/Data/UUID/Typed.hs index 5051a04..c69a158 100644 --- a/src/Data/UUID/Typed.hs +++ b/src/Data/UUID/Typed.hs @@ -3,13 +3,22 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -module Data.UUID.Typed where - -import Control.Monad.IO.Class -import GHC.Generics -import Text.Read +module Data.UUID.Typed + ( UUID (..), + uuidText, + uuidString, + uuidASCIIBytes, + uuidLazyASCIIBytes, + nextRandomUUID, + parseUUIDText, + parseUUIDString, + parseUUIDAsciiBytes, + parseUUIDLazyAsciiBytes, + ) +where import Control.DeepSeq +import Control.Monad.IO.Class import Data.Aeson as JSON import Data.Aeson.Types as JSON import Data.Binary @@ -19,51 +28,59 @@ import Data.Data import Data.Hashable import qualified Data.Text as T import Data.Text (Text) +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as UUID +import Data.Validity +import Data.Validity.UUID () import Foreign.Storable +import GHC.Generics import System.Random +import Text.Read import Web.HttpApiData +import YamlParse.Applicative (YamlKeySchema (..), YamlSchema (..), extraParser, viaYamlSchema) -import Data.Validity -import Data.Validity.UUID () - -import qualified Data.UUID as UUID -import qualified Data.UUID.V4 as UUID - -newtype UUID a = - UUID - { unUUID :: UUID.UUID - } - deriving (Eq, Ord, Generic, Data, Storable, Binary, NFData, Hashable, Random) - -instance Validity (UUID a) - -instance Show (UUID a) where - show (UUID u) = show u +newtype UUID a + = UUID + { unUUID :: UUID.UUID + } + deriving (Eq, Ord, Generic, Data, Storable, Binary, NFData, Hashable, Random, Show, Read, Validity) -instance Read (UUID a) where - readPrec = UUID <$> readPrec - -uuidBs :: UUID a -> SB.ByteString -uuidBs (UUID uuid) = UUID.toASCIIBytes uuid - -uuidLBs :: UUID a -> LB.ByteString -uuidLBs = LB.fromStrict . uuidBs +-- | See 'UUID.toText' +uuidText :: UUID a -> Text +uuidText (UUID uuid) = UUID.toText uuid +-- | See 'UUID.toString' uuidString :: UUID a -> String uuidString (UUID uuid) = UUID.toString uuid -uuidText :: UUID a -> Text -uuidText (UUID uuid) = UUID.toText uuid +-- | See 'UUID.toASCIIBytes' +uuidASCIIBytes :: UUID a -> SB.ByteString +uuidASCIIBytes (UUID uuid) = UUID.toASCIIBytes uuid +-- | See 'UUID.toLazyASCIIBytes' +uuidLazyASCIIBytes :: UUID a -> LB.ByteString +uuidLazyASCIIBytes (UUID uuid) = UUID.toLazyASCIIBytes uuid + +-- | See 'UUID.nextRandom' nextRandomUUID :: MonadIO m => m (UUID a) nextRandomUUID = liftIO $ UUID <$> UUID.nextRandom -parseUUID :: Text -> Maybe (UUID a) -parseUUID = fmap UUID . UUID.fromText +-- | See 'UUID.fromText' +parseUUIDText :: Text -> Maybe (UUID a) +parseUUIDText = fmap UUID . UUID.fromText +-- | See 'UUID.fromString' parseUUIDString :: String -> Maybe (UUID a) parseUUIDString = fmap UUID . UUID.fromString +-- | See 'UUID.parseUUIDAsciiBytes' +parseUUIDAsciiBytes :: SB.ByteString -> Maybe (UUID a) +parseUUIDAsciiBytes = fmap UUID . UUID.fromASCIIBytes + +-- | See 'UUID.parseUUIDLazyAsciiBytes' +parseUUIDLazyAsciiBytes :: LB.ByteString -> Maybe (UUID a) +parseUUIDLazyAsciiBytes = fmap UUID . UUID.fromLazyASCIIBytes + instance FromJSONKey (UUID a) where fromJSONKey = FromJSONKeyTextParser textJSONParseUUID @@ -71,7 +88,13 @@ instance ToJSONKey (UUID a) where toJSONKey = toJSONKeyText (UUID.toText . unUUID) instance FromJSON (UUID a) where - parseJSON = jsonParseUUID + parseJSON = viaYamlSchema + +instance YamlSchema (UUID a) where + yamlSchema = extraParser textJSONParseUUID yamlSchema + +instance YamlKeySchema (UUID a) where + yamlKeySchema = extraParser textJSONParseUUID yamlKeySchema jsonParseUUID :: Value -> Parser (UUID a) jsonParseUUID = withText "UUID" textJSONParseUUID diff --git a/typed-uuid.cabal b/typed-uuid.cabal index 5bd812f..bf21742 100644 --- a/typed-uuid.cabal +++ b/typed-uuid.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 689ba6b86a977a9b1605472b0ce39c908c5cd8db9682482bbb92d2e30be10973 +-- hash: 3beab03fce46280926d3d2293c040ade8b4b61d482353da4ed41730cda4b0cc2 name: typed-uuid -version: 0.0.0.2 +version: 0.1.0.0 synopsis: Phantom-Typed version of UUID description: Please see the README on Github at <https://github.com/NorfairKing/typed-uuid#readme> category: Data @@ -47,4 +47,5 @@ library , uuid >=1.3 && <1.4 , validity , validity-uuid >=0.0 + , yamlparse-applicative default-language: Haskell2010 |