{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Utils
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2018 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, OverloadedStrings
--
--  Support for the RDF Parsing modules.
--
--------------------------------------------------------------------------------

module Swish.RDF.Parser.Utils
    ( SpecialMap
    -- , mapPrefix
              
    -- tables
    , prefixTable, specialTable

    -- parser
    , runParserWithError
    , ParseResult
    , ignore
    , char
    , ichar
    , string
    , stringT
    , symbol
    , isymbol
    , lexeme
    , notFollowedBy
    , whiteSpace
    , skipMany
    , skipMany1
    , endBy
    , sepEndBy
    , sepEndBy1
    , manyTill
    , noneOf
    , eoln
    , fullStop
    , hex4
    , hex8
    , appendURIs
    )
    where

import Swish.Namespace (Namespace, makeNamespace, ScopedName)

import Swish.RDF.Graph (RDFGraph)
import Swish.RDF.Vocabulary
    ( namespaceRDF
    , namespaceRDFS
    , namespaceRDFD
    , namespaceOWL
    , namespaceLOG
    , rdfType
    , rdfFirst, rdfRest, rdfNil
    , owlSameAs, logImplies
    , defaultBase
    )

import Data.Char (isSpace, isHexDigit, chr)

#if MIN_VERSION_base(4, 7, 0)
import Data.Functor (($>))
#endif

import Data.Maybe (fromMaybe, fromJust)

import Network.URI (URI(..), relativeTo, parseURIReference)

import Text.ParserCombinators.Poly.StateText

import qualified Data.Map       as M
import qualified Data.Text      as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Read as R

#if !MIN_VERSION_base(4, 7, 0)
($>) :: Functor f => f a -> b -> f b
($>) = flip (<$)
#endif

-- Code

-- | Append the two URIs. Given the change in signature of
--   `Network.URI.relativeTo` in version @2.4.0.0@ of @network@,
--   it is not clear that this function is necessary. At the
--   very least, it should be changed to just return a `URI`.
--
appendURIs ::
  URI     -- ^ The base URI
  -> URI  -- ^ The URI to append (it can be an absolute URI).
  -> Either String URI
appendURIs :: URI -> URI -> Either String URI
appendURIs base :: URI
base uri :: URI
uri =
  case URI -> String
uriScheme URI
uri of
    "" -> URI -> Either String URI
forall a b. b -> Either a b
Right (URI -> Either String URI) -> URI -> Either String URI
forall a b. (a -> b) -> a -> b
$ URI
uri URI -> URI -> URI
`relativeTo` URI
base
    _  -> URI -> Either String URI
forall a b. b -> Either a b
Right URI
uri

-- | Type for special name lookup table
type SpecialMap = M.Map String ScopedName

-- | Define default table of namespaces
prefixTable :: [Namespace]
prefixTable :: [Namespace]
prefixTable =   [ Namespace
namespaceRDF
                , Namespace
namespaceRDFS
                , Namespace
namespaceRDFD     -- datatypes
                , Namespace
namespaceOWL
                , Namespace
namespaceLOG
                , Maybe Text -> URI -> Namespace
makeNamespace Maybe Text
forall a. Maybe a
Nothing (URI -> Namespace) -> URI -> Namespace
forall a b. (a -> b) -> a -> b
$ Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe URI
parseURIReference "#") -- is this correct?
                ]

-- | Define default special-URI table.
specialTable ::
    Maybe ScopedName  -- ^ initial base URI, otherwise uses 'defaultBase'
    -> [(String,ScopedName)]
specialTable :: Maybe ScopedName -> [(String, ScopedName)]
specialTable mbase :: Maybe ScopedName
mbase =
  [ ("a",         ScopedName
rdfType    ),
    ("equals",    ScopedName
owlSameAs  ),
    ("implies",   ScopedName
logImplies ),
    ("listfirst", ScopedName
rdfFirst   ),
    ("listrest",  ScopedName
rdfRest    ),
    ("listnull",  ScopedName
rdfNil     ),
    ("base",      ScopedName -> Maybe ScopedName -> ScopedName
forall a. a -> Maybe a -> a
fromMaybe ScopedName
defaultBase Maybe ScopedName
mbase ) 
  ]

-- Parser routines, heavily based on Parsec combinators

-- | Run the parser and return the successful parse or an error
-- message which consists of the standard Polyparse error plus
-- a fragment of the unparsed input to provide context.
--
runParserWithError :: 
  Parser a b -- ^ parser (carrying state) to apply
  -> a       -- ^ starting state for the parser
  -> L.Text       -- ^ input to be parsed
  -> Either String b
runParserWithError :: Parser a b -> a -> Text -> Either String b
runParserWithError parser :: Parser a b
parser state0 :: a
state0 input :: Text
input = 
  let (result :: Either String b
result, _, unparsed :: Text
unparsed) = Parser a b -> a -> Text -> (Either String b, a, Text)
forall s a. Parser s a -> s -> Text -> (Either String a, s, Text)
runParser Parser a b
parser a
state0 Text
input
     
      -- TODO: work out how best to report error context; for now just take the
      -- next 40 characters and assume there is enough context.
      econtext :: String
econtext = if Text -> Bool
L.null Text
unparsed
                 then "\n(at end of the text)\n"
                 else "\nRemaining input:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
                      case Text -> Int64 -> Ordering
L.compareLength Text
unparsed 40 of
                        GT -> Text -> String
L.unpack (Int64 -> Text -> Text
L.take 40 Text
unparsed) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "..."
                        _ -> Text -> String
L.unpack Text
unparsed

  in case Either String b
result of
    Left emsg :: String
emsg -> String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
emsg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
econtext
    _ -> Either String b
result

-- | The result of a parse, which is either an error message or a graph.
type ParseResult = Either String RDFGraph


-- | Run the parser and ignore the result.
ignore :: (Applicative f) => f a -> f ()
ignore :: f a -> f ()
ignore f :: f a
f = f a
f f a -> () -> f ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

-- | Match the character.
char :: Char -> Parser s Char
char :: Char -> Parser s Char
char c :: Char
c = (Char -> Bool) -> Parser s Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c)

-- | Match the character, ignoring the result.
ichar :: Char -> Parser s ()
ichar :: Char -> Parser s ()
ichar = Parser s Char -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s Char -> Parser s ())
-> (Char -> Parser s Char) -> Char -> Parser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser s Char
forall s. Char -> Parser s Char
char

-- TODO: is there a better way to do this?
-- | Match the text.
string :: String -> Parser s String
string :: String -> Parser s String
string = (Char -> Parser s Char) -> String -> Parser s String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Parser s Char
forall s. Char -> Parser s Char
char
  
-- | Match the text.
stringT :: T.Text -> Parser s T.Text
stringT :: Text -> Parser s Text
stringT s :: Text
s = String -> Parser s String
forall s. String -> Parser s String
string (Text -> String
T.unpack Text
s) Parser s String -> Parser s Text -> Parser s Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser s Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

-- | Run the parser 'many' times and ignore the result.
skipMany :: Parser s a -> Parser s ()
skipMany :: Parser s a -> Parser s ()
skipMany = Parser s [a] -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s [a] -> Parser s ())
-> (Parser s a -> Parser s [a]) -> Parser s a -> Parser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser s a -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  
-- | Run the parser 'many1' times and ignore the result.
skipMany1 :: Parser s a -> Parser s ()
skipMany1 :: Parser s a -> Parser s ()
skipMany1 = Parser s [a] -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s [a] -> Parser s ())
-> (Parser s a -> Parser s [a]) -> Parser s a -> Parser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser s a -> Parser s [a]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1

-- | Match zero or more occurences of
-- parser followed by separator.
endBy :: 
    Parser s a    -- ^ parser
    -> Parser s b -- ^ separator
    -> Parser s [a]
endBy :: Parser s a -> Parser s b -> Parser s [a]
endBy p :: Parser s a
p sep :: Parser s b
sep = Parser s a -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser s a
p Parser s a -> Parser s b -> Parser s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s b
sep)

-- | Match zero or more occurences of the parser followed
-- by the separator.
sepEndBy :: 
    Parser s a    -- ^ parser
    -> Parser s b -- ^ separator
    -> Parser s [a]
sepEndBy :: Parser s a -> Parser s b -> Parser s [a]
sepEndBy p :: Parser s a
p sep :: Parser s b
sep = Parser s a -> Parser s b -> Parser s [a]
forall s a b. Parser s a -> Parser s b -> Parser s [a]
sepEndBy1 Parser s a
p Parser s b
sep Parser s [a] -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser s [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Accept one or more occurences of the parser
-- separated by the separator. Unlike 'endBy' the
-- last separator is optional.
sepEndBy1 :: 
    Parser s a    -- ^ parser
    -> Parser s b -- ^ separator
    -> Parser s [a]
sepEndBy1 :: Parser s a -> Parser s b -> Parser s [a]
sepEndBy1 p :: Parser s a
p sep :: Parser s b
sep = do
  a
x <- Parser s a
p
  (Parser s b
sep Parser s b -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser s a -> Parser s b -> Parser s [a]
forall s a b. Parser s a -> Parser s b -> Parser s [a]
sepEndBy Parser s a
p Parser s b
sep)) Parser s [a] -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
x]
  
-- | Accept zero or more runs of the parser
-- ending with the delimiter.
manyTill :: 
    Parser s a    -- ^ parser
    -> Parser s b -- ^ delimiter
    -> Parser s [a]
manyTill :: Parser s a -> Parser s b -> Parser s [a]
manyTill p :: Parser s a
p end :: Parser s b
end = Parser s [a]
go
  where
    go :: Parser s [a]
go = (Parser s b
end Parser s b -> [a] -> Parser s [a]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [])
         Parser s [a] -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         ((:) (a -> [a] -> [a]) -> Parser s a -> Parser s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser s a
p Parser s ([a] -> [a]) -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser s [a]
go)

-- | Accept any character that is not a member of the given string.
noneOf :: String -> Parser s Char           
noneOf :: String -> Parser s Char
noneOf istr :: String
istr = (Char -> Bool) -> Parser s Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
istr)

-- | Matches '.'.           
fullStop :: Parser s ()
fullStop :: Parser s ()
fullStop = Char -> Parser s ()
forall s. Char -> Parser s ()
ichar '.'

-- | Match the end-of-line sequence (@"\\n"@, @"\\r"@, or @"\\r\\n"@). 
eoln :: Parser s ()
-- eoln = ignore (newline <|> (lineFeed *> optional newline))
-- eoln = ignore (try (string "\r\n") <|> string "\r" <|> string "\n")
eoln :: Parser s ()
eoln = Parser s String -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore ([Parser s String] -> Parser s String
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [String -> Parser s String
forall s. String -> Parser s String
string "\r\n", String -> Parser s String
forall s. String -> Parser s String
string "\r", String -> Parser s String
forall s. String -> Parser s String
string "\n"])

-- | Succeed if the next character does not match the given function.
notFollowedBy :: (Char -> Bool) -> Parser s ()
notFollowedBy :: (Char -> Bool) -> Parser s ()
notFollowedBy p :: Char -> Bool
p = do
  Char
c <- Parser s Char
forall s. Parser s Char
next
  if Char -> Bool
p Char
c 
    then String -> Parser s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser s ()) -> String -> Parser s ()
forall a b. (a -> b) -> a -> b
$ "Unexpected character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show [Char
c]
    else Text -> Parser s ()
forall s. Text -> Parser s ()
reparse (Text -> Parser s ()) -> Text -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Char -> Text
L.singleton Char
c

-- | Match the given string and any trailing 'whiteSpace'.
symbol :: String -> Parser s String
symbol :: String -> Parser s String
symbol = Parser s String -> Parser s String
forall s a. Parser s a -> Parser s a
lexeme (Parser s String -> Parser s String)
-> (String -> Parser s String) -> String -> Parser s String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser s String
forall s. String -> Parser s String
string

-- | As 'symbol' but ignoring the result.
isymbol :: String -> Parser s ()
isymbol :: String -> Parser s ()
isymbol = Parser s String -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s String -> Parser s ())
-> (String -> Parser s String) -> String -> Parser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser s String
forall s. String -> Parser s String
symbol

-- | Convert a parser into one that also matches, and ignores,
-- trailing 'whiteSpace'.
lexeme :: Parser s a -> Parser s a
lexeme :: Parser s a -> Parser s a
lexeme p :: Parser s a
p = Parser s a
p Parser s a -> Parser s () -> Parser s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. Parser s ()
whiteSpace

-- | Match white space: a space or a comment (@#@ character and anything following it
-- up to to a new line).
whiteSpace :: Parser s ()
whiteSpace :: Parser s ()
whiteSpace = Parser s () -> Parser s ()
forall s a. Parser s a -> Parser s ()
skipMany (Parser s ()
forall s. Parser s ()
simpleSpace Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser s ()
forall s. Parser s ()
oneLineComment)

simpleSpace :: Parser s ()
simpleSpace :: Parser s ()
simpleSpace = Parser s Text -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s Text -> Parser s ()) -> Parser s Text -> Parser s ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser s Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isSpace

-- TODO: this should use eoln rather than a check on \n
oneLineComment :: Parser s ()
oneLineComment :: Parser s ()
oneLineComment = (Char -> Parser s ()
forall s. Char -> Parser s ()
ichar '#' Parser s () -> Parser s Text -> Parser s Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser s Text
forall s. (Char -> Bool) -> Parser s Text
manySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')) Parser s Text -> () -> Parser s ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

{-

Not sure we can get this with polyparse

-- | Annotate a Parsec error with the local context - i.e. the actual text
-- that caused the error and preceeding/succeeding lines (if available)
--
annotateParsecError :: 
    Int -- ^ the number of extra lines to include in the context (<=0 is ignored)
    -> [String] -- ^ text being parsed
    -> ParseError -- ^ the parse error
    -> String -- ^ Parsec error with additional context
annotateParsecError extraLines ls err = 
    -- the following is based on the show instance of ParseError
    let ePos = errorPos err
        lNum = sourceLine ePos
        cNum = sourceColumn ePos
        -- it is possible to be at the end of the input so need
        -- to check; should produce better output than this in this
        -- case
        nLines = length ls
        ln1 = lNum - 1
        eln = max 0 extraLines
        lNums = [max 0 (ln1 - eln) .. min (nLines-1) (ln1 + eln)]
        
        beforeLines = map (ls !!) $ filter (< ln1) lNums
        afterLines  = map (ls !!) $ filter (> ln1) lNums
        
        -- in testing was able to get a line number after the text so catch this
        -- case; is it still necessary?
        errorLine = if ln1 >= nLines then "" else ls !! ln1
        arrowLine = replicate (cNum-1) ' ' ++ "^"
        finalLine = "(line " ++ show lNum ++ ", column " ++ show cNum ++ " indicated by the '^' sign above):"
        
        eHdr = "" : beforeLines ++ errorLine : arrowLine : afterLines ++ [finalLine]
        eMsg = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input"
               (errorMessages err)

    in unlines eHdr ++ eMsg

-}

{-
Handle hex encoding; the spec for N3 and NTriples suggest that
only upper-case A..F are valid but you can find lower-case values
out there so support these too.
-}

hexDigit :: Parser a Char
-- hexDigit = satisfy (`elem` ['0'..'9'] ++ ['A'..'F'])
hexDigit :: Parser a Char
hexDigit = (Char -> Bool) -> Parser a Char
forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
isHexDigit

-- | A four-digit hex value (e.g. @1a34@ or @03F1@).
hex4 :: Parser a Char
hex4 :: Parser a Char
hex4 = do
  String
digs <- Int -> Parser a Char -> Parser a String
forall (p :: * -> *) a. PolyParse p => Int -> p a -> p [a]
exactly 4 Parser a Char
forall s. Parser s Char
hexDigit
  let mhex :: Either String (Int, Text)
mhex = Reader Int
forall a. Integral a => Reader a
R.hexadecimal (String -> Text
T.pack String
digs)
  case Either String (Int, Text)
mhex of
    Left emsg :: String
emsg     -> String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser a Char) -> String -> Parser a Char
forall a b. (a -> b) -> a -> b
$ "Internal error: unable to parse hex4: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
emsg
    Right (v :: Int
v, "") -> Char -> Parser a Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser a Char) -> Char -> Parser a Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
v
    Right (_, vs :: Text
vs) -> String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser a Char) -> String -> Parser a Char
forall a b. (a -> b) -> a -> b
$ "Internal error: hex4 remainder = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
vs

-- | An eight-digit hex value that has a maximum of @0010FFFF@.
hex8 :: Parser a Char
hex8 :: Parser a Char
hex8 = do
  String
digs <- Int -> Parser a Char -> Parser a String
forall (p :: * -> *) a. PolyParse p => Int -> p a -> p [a]
exactly 8 Parser a Char
forall s. Parser s Char
hexDigit
  let mhex :: Either String (Int, Text)
mhex = Reader Int
forall a. Integral a => Reader a
R.hexadecimal (String -> Text
T.pack String
digs)
  case Either String (Int, Text)
mhex of
    Left emsg :: String
emsg     -> String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser a Char) -> String -> Parser a Char
forall a b. (a -> b) -> a -> b
$ "Internal error: unable to parse hex8: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
emsg
    Right (v :: Int
v, "") -> if Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x10FFFF
                     then Char -> Parser a Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser a Char) -> Char -> Parser a Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
v
                     else String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"
    Right (_, vs :: Text
vs) -> String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser a Char) -> String -> Parser a Char
forall a b. (a -> b) -> a -> b
$ "Internal error: hex8 remainder = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
vs
        
--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2014, 2018 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
--
--------------------------------------------------------------------------------