summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorfair <>2019-08-19 11:29:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-08-19 11:29:00 (GMT)
commit644d0b688fbcb799f039cc5073e0e74920a236c7 (patch)
treef83f1aa2dc2421cc82be7fe6dc2b6817bafe2338
version 0.0.0.00.0.0.0
-rw-r--r--ChangeLog.md3
-rw-r--r--LICENSE21
-rw-r--r--README.md1
-rw-r--r--Setup.hs3
-rw-r--r--src/Data/UUID/Typed.hs101
-rw-r--r--typed-uuid.cabal50
6 files changed, 179 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..a65ef28
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for typed-uuid
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..2f3a2a5
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2018-2019 Tom Sydney Kerckhove
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..744731c
--- /dev/null
+++ b/README.md
@@ -0,0 +1 @@
+# typed-uuid
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..e8ef27d
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/src/Data/UUID/Typed.hs b/src/Data/UUID/Typed.hs
new file mode 100644
index 0000000..78a5b5f
--- /dev/null
+++ b/src/Data/UUID/Typed.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Data.UUID.Typed where
+
+import Control.Monad.IO.Class
+import GHC.Generics
+import Text.Read
+
+import Control.DeepSeq
+import Data.Aeson as JSON
+import Data.Aeson.Types as JSON
+import Data.Binary
+import qualified Data.ByteString as SB
+import qualified Data.ByteString.Lazy as LB
+import Data.Data
+import Data.Hashable
+import qualified Data.Text as T
+import Data.Text (Text)
+import Foreign.Storable
+import System.Random
+import Web.HttpApiData
+
+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
+
+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
+
+uuidString :: UUID a -> String
+uuidString (UUID uuid) = UUID.toString uuid
+
+uuidText :: UUID a -> Text
+uuidText (UUID uuid) = UUID.toText uuid
+
+nextRandomUUID :: MonadIO m => m (UUID a)
+nextRandomUUID = liftIO $ UUID <$> UUID.nextRandom
+
+parseUUID :: Text -> Maybe (UUID a)
+parseUUID = fmap UUID . UUID.fromText
+
+parseUUIDString :: String -> Maybe (UUID a)
+parseUUIDString = fmap UUID . UUID.fromString
+
+instance FromJSONKey (UUID a) where
+ fromJSONKey = FromJSONKeyTextParser textJSONParseUUID
+
+instance ToJSONKey (UUID a) where
+ toJSONKey = toJSONKeyText (UUID.toText . unUUID)
+
+instance FromJSON (UUID a) where
+ parseJSON = jsonParseUUID
+
+jsonParseUUID :: Value -> Parser (UUID a)
+jsonParseUUID = withText "UUID" textJSONParseUUID
+
+textJSONParseUUID :: Text -> Parser (UUID a)
+textJSONParseUUID t =
+ case UUID.fromText t of
+ Nothing -> fail "Invalid Text when parsing UUID"
+ Just u -> pure $ UUID u
+
+instance ToJSON (UUID a) where
+ toJSON (UUID u) = JSON.String $ UUID.toText u
+
+instance FromHttpApiData (UUID a) where
+ parseUrlPiece t =
+ case UUID.fromText t of
+ Nothing -> fail $ "Invalid UUID in Url Piece: " ++ T.unpack t
+ Just uuid -> pure $ UUID uuid
+
+instance ToHttpApiData (UUID a) where
+ toUrlPiece (UUID uuid) = UUID.toText uuid
diff --git a/typed-uuid.cabal b/typed-uuid.cabal
new file mode 100644
index 0000000..168d08a
--- /dev/null
+++ b/typed-uuid.cabal
@@ -0,0 +1,50 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.31.1.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: f564cfded862f8dd6830c839a9b9ad4a464a251ad0254961b2362973c1552fa5
+
+name: typed-uuid
+version: 0.0.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
+homepage: https://github.com/NorfairKing/typed-uuid#readme
+bug-reports: https://github.com/NorfairKing/typed-uuid/issues
+author: Tom Sydney Kerckhove
+maintainer: syd@cs-syd.eu
+copyright: Copyright: (c) 2018-2019 Tom Sydney Kerckhove
+license: MIT
+license-file: LICENSE
+build-type: Simple
+extra-source-files:
+ README.md
+ ChangeLog.md
+
+source-repository head
+ type: git
+ location: https://github.com/NorfairKing/typed-uuid
+
+library
+ exposed-modules:
+ Data.UUID.Typed
+ other-modules:
+ Paths_typed_uuid
+ hs-source-dirs:
+ src
+ build-depends:
+ aeson
+ , base >=4.7 && <5
+ , binary
+ , bytestring
+ , deepseq
+ , hashable
+ , http-api-data
+ , random
+ , text
+ , uuid >=1.3 && <1.4
+ , validity
+ , validity-uuid >=0.0
+ default-language: Haskell2010