src/Darcs/URL.hs

   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 module Darcs.URL (
  24     is_file, is_url, is_ssh, is_relative, is_absolute,
  25     is_ssh_nopath
  26   ) where
  27
  28 #include "impossible.h"
  29
  30 {-
  31   Path resolving:
  32     * A URL contains the sequence "://".
  33     * A local filepath does not contain colons, except
  34       as second character (windows drives).
  35     * A path that is neither a URL nor a local file
  36       is an ssh-path.
  37
  38   Examples:
  39     /usr/repo/foo                 - local file
  40     c:/src/darcs                  - local file
  41     http://darcs.net/             - URL
  42     peter@host:/path              - ssh
  43     droundy@host:                 - ssh
  44     host:/path                    - ssh
  45
  46
  47   This means that single-letter hosts in ssh-paths doesn't work,
  48   unless a username is provided.
  49
  50   Perhaps ssh-paths should use "ssh://user@host/path"-syntax instead?
  51 -}
  52
  53 is_relative :: String -> Bool
  54 is_relative (_:':':_) = False
  55 is_relative f@(c:_) = is_file f && c /= '/' && c /= '~'
  56 is_relative "" = bug "Empty filename in is_relative"
  57
  58 is_absolute :: String -> Bool
  59 is_absolute f = is_file f && (not $ is_relative f)
  60
  61 is_file :: String -> Bool
  62 is_file (_:_:fou) = ':' `notElem` fou
  63 is_file _ = True
  64
  65 is_url :: String -> Bool
  66 is_url (':':'/':'/':_:_) = True
  67 is_url (_:x) = is_url x
  68 is_url "" = False
  69
  70 is_ssh :: String -> Bool
  71 is_ssh s = not (is_file s || is_url s)
  72
  73 is_ssh_nopath :: String -> Bool
  74 is_ssh_nopath s = case reverse s of
  75                   ':':x@(_:_:_) -> ':' `notElem` x
  76                   _ -> False