{-# LANGUAGE CPP, DeriveGeneric, DeriveLift, StandaloneDeriving, TemplateHaskell #-}

module Data.UUID.Orphans (showUUID) where

import Data.SafeCopy -- (base, contain, deriveSafeCopy, SafeCopy(..))
import Data.Text as T (pack, unpack)
import Data.UUID.Types (toString, fromString)
import Data.UUID.Types.Internal (UUID(..))
import Language.Haskell.TH.Lift (Lift)
import Web.Routes.PathInfo

deriving instance Generic UUID

#if MIN_VERSION_safecopy(0,9,5)
instance SafeCopy UUID where version :: Version UUID
version = Version UUID
0
#else
$(deriveSafeCopy 0 'base ''UUID)
#endif

#if 0
-- Splices
instance SafeCopy UUID where
      putCopy (UUID a1 a2 a3 a4)
        = contain
            (do safePut_Word32 <- getSafePut
                safePut_Word32 a1
                safePut_Word32 a2
                safePut_Word32 a3
                safePut_Word32 a4
                return ())
      getCopy
        = contain
            ((label "Data.UUID.Types.Internal.UUID:")
               (do safeGet_Word32 <- getSafeGet
                   ((((return UUID <*> safeGet_Word32) <*> safeGet_Word32)
                       <*> safeGet_Word32)
                      <*> safeGet_Word32)))
      version = 0
      kind = base
      errorTypeName _ = "Data.UUID.Types.Internal.UUID"
#endif

#if !MIN_VERSION_uuid_types(1,0,5)
deriving instance Lift UUID
#endif

instance PathInfo UUID where
  toPathSegments :: UUID -> [Text]
toPathSegments = (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> (UUID -> Text) -> UUID -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
toString
  fromPathSegments :: URLParser UUID
fromPathSegments = (Any -> String) -> (Text -> Maybe UUID) -> URLParser UUID
forall tok a. tok -> (Text -> Maybe a) -> URLParser a
pToken (String -> Any -> String
forall a b. a -> b -> a
const (String
"UUID" :: String)) Text -> Maybe UUID
checkUUID
    where checkUUID :: Text -> Maybe UUID
checkUUID Text
txt = String -> Maybe UUID
fromString (Text -> String
T.unpack Text
txt)

-- | The Show instance for UUID does not return a string containing a
-- haskell expression, so if that is required use this function instead.
showUUID :: UUID -> String
showUUID :: UUID -> String
showUUID UUID
uuid = String
"(read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (UUID -> String
forall a. Show a => a -> String
show UUID
uuid) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: UUID)"