{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  URI
--  Copyright   :  (c) 2011, 2012 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, TypeFamilies, FlexibleInstances
--
--  Support interning URIs.
--
--------------------------------------------------------------------------------

module Data.Interned.URI
       ( InternedURI
       ) where

import Data.String (IsString(..))
import Data.Hashable
import Data.Interned
import Data.Maybe (fromMaybe)

import Network.URI

-- Could look at adding UNPACK statements before the Int component

-- | An interned URI. The hashing is based on the
-- reversed URI (as a string).
data InternedURI = InternedURI !Int !URI

instance IsString InternedURI where
  fromString :: String -> InternedURI
fromString = URI -> InternedURI
forall t. Interned t => Uninterned t -> t
intern (URI -> InternedURI) -> (String -> URI) -> String -> InternedURI
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe (String -> URI
forall a. HasCallStack => String -> a
error String
"Error: unable to create a URI.") (Maybe URI -> URI) -> (String -> Maybe URI) -> String -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               String -> Maybe URI
parseURIReference
              

instance Eq InternedURI where
  InternedURI Int
a URI
_ == :: InternedURI -> InternedURI -> Bool
== InternedURI Int
b URI
_ = Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b

instance Ord InternedURI where
  compare :: InternedURI -> InternedURI -> Ordering
compare (InternedURI Int
a URI
_) (InternedURI Int
b URI
_) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
a Int
b

instance Show InternedURI where
  showsPrec :: Int -> InternedURI -> ShowS
showsPrec Int
d (InternedURI Int
_ URI
b) = Int -> URI -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d URI
b

instance Interned InternedURI where
  type Uninterned InternedURI = URI
  data Description InternedURI = DU !URI deriving (Description InternedURI -> Description InternedURI -> Bool
(Description InternedURI -> Description InternedURI -> Bool)
-> (Description InternedURI -> Description InternedURI -> Bool)
-> Eq (Description InternedURI)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description InternedURI -> Description InternedURI -> Bool
$c/= :: Description InternedURI -> Description InternedURI -> Bool
== :: Description InternedURI -> Description InternedURI -> Bool
$c== :: Description InternedURI -> Description InternedURI -> Bool
Eq) -- DU {-# UNPACK #-} !URI deriving (Eq) 
  describe :: Uninterned InternedURI -> Description InternedURI
describe = Uninterned InternedURI -> Description InternedURI
URI -> Description InternedURI
DU
  identify :: Int -> Uninterned InternedURI -> InternedURI
identify = Int -> Uninterned InternedURI -> InternedURI
Int -> URI -> InternedURI
InternedURI
#if MIN_VERSION_intern(0,9,0)
#else
  identity (InternedURI i _) = i
#endif
  cache :: Cache InternedURI
cache = Cache InternedURI
iuCache

instance Uninternable InternedURI where
  unintern :: InternedURI -> Uninterned InternedURI
unintern (InternedURI Int
_ URI
b) = Uninterned InternedURI
URI
b 

-- Rather than access the URI components, just use the reverse of the
-- string representation of the URI.
instance Hashable (Description InternedURI) where
#if MIN_VERSION_hashable(1,2,0)
#else
  hash = hashWithSalt 5381 -- use the stringSalt value from Data.Hashable
#endif
  hashWithSalt :: Int -> Description InternedURI -> Int
hashWithSalt Int
salt (DU u) = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt ((ShowS
forall a. [a] -> [a]
reverse ShowS -> (URI -> String) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show) URI
u)

iuCache :: Cache InternedURI
iuCache :: Cache InternedURI
iuCache = Cache InternedURI
forall t. Interned t => Cache t
mkCache
{-# NOINLINE iuCache #-}

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012 Douglas Burke
--  All rights reserved.
--
--  This file is part of Swish.
--
--  Swish is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  Swish is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with Swish; if not, write to:
--    The Free Software Foundation, Inc.,
--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--------------------------------------------------------------------------------