version 0.0.0.00.0.0.0

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