UUID.hs

{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeSynonymInstances  #-}

module RFC.Data.UUID
  ( module Data.UUID.Types
  ) where

import           ClassyPrelude
import           RFC.String

import           Data.UUID.Types
import qualified Data.UUID.Types                    as UUID

#if MIN_VERSION_aeson(1,1,0)
-- UUID has ToJSON and FromJSON
#else
import           Data.Aeson.Types
#endif

#ifndef GHCJS_BROWSER
import           Database.PostgreSQL.Simple.FromRow
import           Database.PostgreSQL.Simple.ToRow
import           Database.PostgreSQL.Simple.Types   (Only (..))
import           Servant.API.Capture
import           Servant.Docs
#endif

#ifndef GHCJS_BROWSER
instance ToCapture (Capture "id" UUID) where
  toCapture _ = DocCapture "id" "UUID identifier"

instance ToSample UUID where
  toSamples _ = samples $ catMaybes $ map UUID.fromString $
    [ "cf41ac06-3f70-479c-a2ed-d618a5e6dee2"
    , "26998bb3-d6c6-4f63-8a36-6b81eb6e6de9"
    , "6176b857-e461-4f34-a6a6-aeb8cbf7ffdf"
    , "26009820-d2d1-4360-87e0-aa73db3c0433"
    ]

#endif

#ifndef GHCJS_BROWSER
instance FromRow UUID where
  fromRow = do
    (Only id) <- fromRow
    return id

instance ToRow UUID where
  toRow id = toRow $ Only id
#endif

#if MIN_VERSION_aeson(1,1,0)
-- UUID has ToJSON and FromJSON
#else

instance ToJSON UUID where
  toJSON = toJSON . UUID.toText

instance FromJSON UUID where
  parseJSON (String txt) =
    case UUID.fromText txt of
      Nothing   -> fail $ "Invalid UUID: " ++ cs txt
      Just uuid -> return uuid

  parseJSON invalid = typeMismatch "UUID" invalid

#endif

instance ConvertibleStrings UUID String where
  convertString = UUID.toString

instance ConvertibleStrings UUID StrictText where
  convertString = UUID.toText

instance ConvertibleStrings UUID LazyText where
  convertString = toLazyText

instance ConvertibleStrings UUID StrictByteString where
  convertString = UUID.toASCIIBytes

instance ConvertibleStrings UUID LazyByteString where
  convertString = UUID.toLazyASCIIBytes