1 {-# OPTIONS_GHC -cpp #-}
    2 {-# LANGUAGE CPP #-}
    3 
    4 {-
    5 Copyright (C) 2004 David Roundy
    6 
    7 This program is free software; you can redistribute it and/or modify
    8 it under the terms of the GNU General Public License as published by
    9 the Free Software Foundation; either version 2, or (at your option)
   10 any later version.
   11 
   12 This program is distributed in the hope that it will be useful,
   13 but WITHOUT ANY WARRANTY; without even the implied warranty of
   14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15 GNU General Public License for more details.
   16 
   17 You should have received a copy of the GNU General Public License
   18 along with this program; see the file COPYING.  If not, write to
   19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   20 Boston, MA 02110-1301, USA.
   21 -}
   22 
   23 {-|
   24 
   25   Path resolving:
   26 
   27     * A URL contains the sequence @\":\/\/\"@.
   28 
   29     * A local filepath does not contain colons, except
   30       as second character (windows drives).
   31 
   32     * A path that is neither a URL nor a local file
   33       is an ssh-path.
   34 
   35   Examples:
   36 
   37   > /usr/repo/foo                 -- local file
   38   > c:/src/darcs                  -- local file
   39   > http://darcs.net/             -- URL
   40   > peter@host:/path              -- ssh
   41   > droundy@host:                 -- ssh
   42   > host:/path                    -- ssh
   43 
   44   This means that single-letter hosts in ssh-paths do not work,
   45   unless a username is provided.
   46 
   47   Perhaps ssh-paths should use @\"ssh:\/\/user\@host\/path\"@-syntax instead?
   48 -}
   49 
   50 module Darcs.URL (
   51     is_file, is_url, is_ssh, is_relative, is_absolute,
   52     is_ssh_nopath
   53   ) where
   54 
   55 #include "impossible.h"
   56 
   57 is_relative :: String -> Bool
   58 is_relative (_:':':_) = False
   59 is_relative f@(c:_) = is_file f && c /= '/' && c /= '~'
   60 is_relative "" = bug "Empty filename in is_relative"                                                                                            
   61 
   62 is_absolute :: String -> Bool
   63 is_absolute "" = bug "is_absolute called with empty filename"                                                                                            
   64 is_absolute f = is_file f && (not $ is_relative f)
   65 
   66 is_file :: String -> Bool
   67 is_file (_:_:fou) = ':' `notElem` fou
   68 is_file _ = True
   69 
   70 is_url :: String -> Bool
   71 is_url (':':'/':'/':_:_) = True
   72 is_url (_:x) = is_url x
   73 is_url "" = False
   74 
   75 is_ssh :: String -> Bool
   76 is_ssh s = not (is_file s || is_url s)
   77 
   78 is_ssh_nopath :: String -> Bool
   79 is_ssh_nopath s = case reverse s of
   80                   ':':x@(_:_:_) -> ':' `notElem` x
   81                   _ -> False