{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  QName
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  OverloadedStrings
--
--  This module defines an algebraic datatype for qualified names (QNames),
--  which represents a 'URI' as the combination of a namespace 'URI'
--  and a local component ('LName'), which can be empty.
--
--  Although RDF supports using IRIs, the use of 'URI' here precludes this,
--  which means that, for instance, 'LName' only accepts a subset of valid
--  characters. There is currently no attempt to convert from an IRI into a URI.
--
--------------------------------------------------------------------------------

-- At present we support using URI references rather than forcing an absolute
-- URI. This is partly to support the existing tests (too lazy to resolve whether
-- the tests really should be using relative URIs in this case).

module Swish.QName
    ( QName
    , LName
    , emptyLName
    , newLName
    , getLName
    , newQName
    , qnameFromURI
    , getNamespace
    , getLocalName
    , getQNameURI
    , qnameFromFilePath
    )
    where

import Control.Monad (liftM)

import Data.Char (isAscii)
import Data.Maybe (fromMaybe)
import Data.Interned (intern, unintern)
import Data.Interned.URI (InternedURI)
import Data.Ord (comparing)
import Data.String (IsString(..))

import Network.URI (URI(..), URIAuth(..), parseURIReference)
import Network.URI.Ord ()

import System.Directory (canonicalizePath)
import System.FilePath (splitFileName)

import qualified Data.Text as T

------------------------------------------------------------
--  Qualified name
------------------------------------------------------------
--
--  These are RDF QNames rather than XML ones (as much as
--  RDF can claim to have them).
--


{-| A local name, which can be empty.

At present, the local name can not contain a space character and can only
contain ascii characters (those that match 'Data.Char.isAscii').

In version @0.9.0.3@ and earlier, the following characters were not
allowed in local names: \'#\', \':\', or \'/\' characters.

This is all rather experimental.
-}
newtype LName = LName T.Text
    deriving (Eq, Ord)

instance Show LName where
    show (LName t) = show t

-- | This is not total since attempting to convert a string
--   containing invalid characters will cause an error.
instance IsString LName where
    fromString s = 
        fromMaybe (error ("Invalid local name: " ++ s)) $
                  newLName (T.pack s)

-- | The empty local name.
emptyLName :: LName
emptyLName = LName ""

-- | Create a local name.
newLName :: T.Text -> Maybe LName
-- newLName l = if T.any (`elem` " #:/") l then Nothing else Just (LName l) -- 0.7.0.1 and earlier
-- newLName l = if T.any (\c -> c `elem` " #:/" || not (isAscii c)) l then Nothing else Just (LName l) -- 0.9.0.3 and earlier
newLName l = if T.any (\c -> c == ' ' || not (isAscii c)) l then Nothing else Just (LName l)

-- | Extract the local name.
getLName :: LName -> T.Text
getLName (LName l) = l

{-| 

A qualified name, consisting of a namespace URI
and the local part of the identifier, which can be empty.
The serialisation of a QName is formed by concatanating the
two components.

> Prelude> :set prompt "swish> "
> swish> :set -XOverloadedStrings
> swish> :m + Swish.QName
> swish> let qn1 = "http://example.com/" :: QName
> swish> let qn2 = "http://example.com/bob" :: QName
> swish> let qn3 = "http://example.com/bob/fred" :: QName
> swish> let qn4 = "http://example.com/bob/fred#x" :: QName
> swish> let qn5 = "http://example.com/bob/fred:joe" :: QName
> swish> map getLocalName [qn1, qn2, qn3, qn4, qn5]
> ["","bob","fred","x","fred:joe"]
> swish> getNamespace qn1
> http://example.com/
> swish> getNamespace qn2
> http://example.com/
> swish> getNamespace qn3
> http://example.com/bob/
> swish> getNamespace qn4
> http://example.com/bob/fred#

-}

{-
For now I have added in storing the actual URI
as well as the namespace component. This may or
may not be a good idea (space vs time saving).
-}

data QName = QName !InternedURI URI LName

-- | This is not total since it will fail if the input string is not a valid URI.
instance IsString QName where
  fromString s = 
      fromMaybe (error ("QName conversion given an invalid URI: " ++ s))
      (parseURIReference s >>= qnameFromURI)

-- | Equality is determined by a case sensitive comparison of the               
-- URI.
instance Eq QName where
    u1 == u2 = getQNameURI u1 == getQNameURI u2

-- | In @0.8.0.0@ the ordering now uses the ordering defined in
--   "Network.URI.Ord" rather than the @Show@
--   instance. This should make no difference unless a password
--   was included in the URI when using basic access authorization.
--
instance Ord QName where
    compare = comparing getQNameURI
  
-- | The format used to display the URI is @\<uri\>@, and does not
--   include the password if using basic access authorization.
instance Show QName where
    show (QName u _ _) = "<" ++ show u ++ ">"

{-
The assumption in QName is that the validation done in creating
the local name is sufficient to ensure that the combined 
URI is syntactically valid. Is this true?
-}

-- | Create a new qualified name with an explicit local component.
--
newQName ::
    URI            -- ^ Namespace
    -> LName       -- ^ Local component
    -> QName
newQName ns l@(LName local) = 
  -- Until profiling shows that this is a time/space issue, we use
  -- the following code rather than trying to deconstruct the URI
  -- directly
  let lstr   = T.unpack local
      uristr = show ns ++ lstr
  in case parseURIReference uristr of
       Just uri -> QName (intern uri) ns l
       _ -> error $ "Unable to combine " ++ show ns ++ " with " ++ lstr
  
{-

old behavior

 splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
 splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
 splitQname "http://example.org/aaa/"    = ("http://example.org/aaa/","")

Should "urn:foo:bar" have a local name of "" or "foo:bar"? For now go
with the first option.

-}

-- | Create a new qualified name.
qnameFromURI :: 
    URI      -- ^ The URI will be deconstructed to find if it contains a local component.
    -> Maybe QName -- ^ The failure case may be removed.
qnameFromURI uri =
  let uf = uriFragment uri
      up = uriPath uri
      q0 = Just $ start uri emptyLName
      start = QName (intern uri)
  in case uf of
       "#"    -> q0
       '#':xs -> start (uri {uriFragment = "#"}) `liftM` newLName (T.pack xs)
       ""     -> case break (=='/') (reverse up) of
                   ("",_) -> q0 -- path ends in / or is empty
                   (_,"") -> q0 -- path contains no /
                   (rlname,rpath) -> 
                       start (uri {uriPath = reverse rpath}) `liftM` 
                       newLName (T.pack (reverse rlname))

       -- e -> error $ "Unexpected: uri=" ++ show uri ++ " has fragment='" ++ show e ++ "'" 
       _ -> Nothing

-- | Return the URI of the namespace stored in the QName.
-- This does not contain the local component.
--
getNamespace :: QName -> URI
getNamespace (QName _ ns _) = ns

-- | Return the local component of the QName.
getLocalName :: QName -> LName
getLocalName (QName _ _ l) = l

-- | Returns the full URI of the QName (ie the combination of the
-- namespace and local components).
getQNameURI :: QName -> URI
getQNameURI (QName u _ _) = unintern u

{-|
Convert a filepath to a file: URI stored in a QName. If the
input file path is relative then the current working directory is used
to convert it into an absolute path.

If the input represents a directory then it *must* end in 
the directory separator - so for Posix systems use 
@\"\/foo\/bar\/\"@ rather than 
@\"\/foo\/bar\"@.

This has not been tested on Windows.
-}

{-
NOTE: not sure why I say directories should end in the path
seperator since

ghci> System.Directory.canonicalizePath "/Users/dburke/haskell/swish-text"
"/Users/dburke/haskell/swish-text"
ghci> System.Directory.canonicalizePath "/Users/dburke/haskell/swish-text/"
"/Users/dburke/haskell/swish-text"

-}

qnameFromFilePath :: FilePath -> IO QName
qnameFromFilePath fname = do
  ipath <- canonicalizePath fname
  let (dname, lname) = splitFileName ipath
      nsuri = URI "file:" emptyAuth dname "" ""
      uri = URI "file:" emptyAuth ipath "" ""
  case lname of
    "" -> return $ QName (intern nsuri) nsuri emptyLName
    _  -> return $ QName (intern uri) nsuri (LName (T.pack lname))

emptyAuth :: Maybe URIAuth
emptyAuth = Just $ URIAuth "" "" ""

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2013 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
--
--------------------------------------------------------------------------------