diff --git a/README.md b/README.md index 1c5022a..1284abb 100644 --- a/README.md +++ b/README.md @@ -13,7 +13,6 @@ Set of libraries to deal with filepaths and files. ## Projects * [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [hpath](./hpath): Support for well-typed paths -* [![Hackage version](https://img.shields.io/hackage/v/hpath-filepath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-filepath) [hpath-filepath](./hpath-filepath): ByteString based filepath manipulation (can be used without hpath) * [![Hackage version](https://img.shields.io/hackage/v/hpath-directory.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-directory) [hpath-directory](./hpath-directory): High-level IO operations for files/directories on raw ByteString filepaths (use hpath-io for the type-safe path version) * [![Hackage version](https://img.shields.io/hackage/v/hpath-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [hpath-io](./hpath-io): High-level IO operations for files/directories utilizing type-safe Path * [![Hackage version](https://img.shields.io/hackage/v/hpath-posix.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-posix) [hpath-posix](./hpath-posix): Some low-level POSIX glue code that is not in 'unix' diff --git a/cabal.project b/cabal.project index 48842ae..54705b2 100644 --- a/cabal.project +++ b/cabal.project @@ -1,8 +1,23 @@ packages: ./hpath ./hpath-directory - ./hpath-filepath - ./hpath-io ./hpath-posix + ./streamly-posix + https://hackage.haskell.org/package/filepath-1.4.99.5/candidate/filepath-1.4.99.5.tar.gz + +source-repository-package + type: git + location: https://github.com/hasufell/unix.git + tag: f3b8ff89e1166df51ae02ce405fc1b3efe3c590f + +source-repository-package + type: git + location: https://github.com/hasufell/Win32.git + tag: 766234a476e9f7b88c72fe13b51e0012f95837e9 + +source-repository-package + type: git + location: https://github.com/hasufell/file-io.git + tag: fbf71938823f98610c4d7f8e647bb4d26c5d0c20 package hpath-io ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 @@ -10,3 +25,5 @@ package hpath-io -- https://github.com/composewell/streamly/blob/master/docs/Build.md package streamly ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 + +allow-newer: filepath, Win32, unix diff --git a/hpath-directory/Setup.hs b/hpath-directory/Setup.hs index 9a994af..54f57d6 100644 --- a/hpath-directory/Setup.hs +++ b/hpath-directory/Setup.hs @@ -1,2 +1,6 @@ +module Main (main) where + import Distribution.Simple -main = defaultMain + +main :: IO () +main = defaultMainWithHooks autoconfUserHooks diff --git a/hpath-directory/configure b/hpath-directory/configure new file mode 100755 index 0000000..9f04169 --- /dev/null +++ b/hpath-directory/configure @@ -0,0 +1,4401 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for Haskell directory package 1.0. +# +# Report bugs to . +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org and +$0: libraries@haskell.org about your system, including any +$0: error possibly output before this message. Then install +$0: a modern shell, or manually run the script under such a +$0: shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='Haskell directory package' +PACKAGE_TARNAME='directory' +PACKAGE_VERSION='1.0' +PACKAGE_STRING='Haskell directory package 1.0' +PACKAGE_BUGREPORT='libraries@haskell.org' +PACKAGE_URL='' + +ac_unique_file="src/System/Directory/OsPath.hs" +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_subst_vars='LTLIBOBJS +LIBOBJS +EGREP +GREP +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +runstatedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_gcc +with_compiler +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir runstatedir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures Haskell directory package 1.0 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/directory] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of Haskell directory package 1.0:";; + esac + cat <<\_ACEOF + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) +C compiler +GHC compiler + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to . +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +Haskell directory package configure 1.0 +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} +( $as_echo "## ------------------------------------ ## +## Report this to libraries@haskell.org ## +## ------------------------------------ ##" + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by Haskell directory package $as_me 1.0, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +# Safety check: Ensure that we are in the correct source directory. + + +ac_config_headers="$ac_config_headers src/HsDirectoryConfig.h" + + +# Autoconf chokes on spaces, but we may receive a path from Cabal containing +# spaces. In that case, we just ignore Cabal's suggestion. +set_with_gcc() { + case $withval in + *" "*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: --with-gcc ignored due to presence of spaces" >&5 +$as_echo "$as_me: WARNING: --with-gcc ignored due to presence of spaces" >&2;};; + *) + CC=$withval + esac +} + +# Legacy support for setting the C compiler with Cabal<1.24 +# Newer versions use Autoconf's native `CC=...` facility + +# Check whether --with-gcc was given. +if test "${with_gcc+set}" = set; then : + withval=$with_gcc; set_with_gcc +fi + +# avoid warnings when run via Cabal + +# Check whether --with-compiler was given. +if test "${with_compiler+set}" = set; then : + withval=$with_compiler; +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# check for specific header (.h) files that we are interested in + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_header in fcntl.h limits.h sys/types.h sys/stat.h time.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_func in utimensat +do : + ac_fn_c_check_func "$LINENO" "utimensat" "ac_cv_func_utimensat" +if test "x$ac_cv_func_utimensat" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_UTIMENSAT 1 +_ACEOF + +fi +done + +for ac_func in CreateSymbolicLinkW +do : + ac_fn_c_check_func "$LINENO" "CreateSymbolicLinkW" "ac_cv_func_CreateSymbolicLinkW" +if test "x$ac_cv_func_CreateSymbolicLinkW" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_CREATESYMBOLICLINKW 1 +_ACEOF + +fi +done + +for ac_func in GetFinalPathNameByHandleW +do : + ac_fn_c_check_func "$LINENO" "GetFinalPathNameByHandleW" "ac_cv_func_GetFinalPathNameByHandleW" +if test "x$ac_cv_func_GetFinalPathNameByHandleW" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_GETFINALPATHNAMEBYHANDLEW 1 +_ACEOF + +fi +done + + +# EXTEXT is defined automatically by AC_PROG_CC; +# we just need to capture it in the header file + +cat >>confdefs.h <<_ACEOF +#define EXE_EXTENSION "$EXEEXT" +_ACEOF + + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by Haskell directory package $as_me 1.0, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_headers="$ac_config_headers" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration headers: +$config_headers + +Report bugs to ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +Haskell directory package config.status 1.0 +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error $? "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "src/HsDirectoryConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS src/HsDirectoryConfig.h" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$ac_tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' >$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :H $CONFIG_HEADERS " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi + else + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 + fi + ;; + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + diff --git a/hpath-directory/configure.ac b/hpath-directory/configure.ac new file mode 100644 index 0000000..3630f67 --- /dev/null +++ b/hpath-directory/configure.ac @@ -0,0 +1,42 @@ +AC_INIT([Haskell directory package], [1.0], [libraries@haskell.org], [directory]) + +# Safety check: Ensure that we are in the correct source directory. +AC_CONFIG_SRCDIR([src/System/Directory/OsPath.hs]) + +AC_CONFIG_HEADERS([src/HsDirectoryConfig.h]) + +# Autoconf chokes on spaces, but we may receive a path from Cabal containing +# spaces. In that case, we just ignore Cabal's suggestion. +set_with_gcc() { + case $withval in + *" "*) + AC_MSG_WARN([--with-gcc ignored due to presence of spaces]);; + *) + CC=$withval + esac +} + +# Legacy support for setting the C compiler with Cabal<1.24 +# Newer versions use Autoconf's native `CC=...` facility +AC_ARG_WITH([gcc], + [C compiler], + [set_with_gcc]) +# avoid warnings when run via Cabal +AC_ARG_WITH([compiler], + [GHC compiler], + []) +AC_PROG_CC() + +# check for specific header (.h) files that we are interested in +AC_CHECK_HEADERS([fcntl.h limits.h sys/types.h sys/stat.h time.h]) + +AC_CHECK_FUNCS([utimensat]) +AC_CHECK_FUNCS([CreateSymbolicLinkW]) +AC_CHECK_FUNCS([GetFinalPathNameByHandleW]) + +# EXTEXT is defined automatically by AC_PROG_CC; +# we just need to capture it in the header file +AC_DEFINE_UNQUOTED([EXE_EXTENSION], ["$EXEEXT"], + [Filename extension of executable files]) + +AC_OUTPUT diff --git a/hpath-directory/hpath-directory.cabal b/hpath-directory/hpath-directory.cabal index fbb073c..49eeca6 100644 --- a/hpath-directory/hpath-directory.cabal +++ b/hpath-directory/hpath-directory.cabal @@ -1,116 +1,156 @@ -cabal-version: >=1.10 - -name: hpath-directory -version: 0.14.2.2 -synopsis: Alternative to 'directory' package with ByteString based filepaths -description: This provides a safer alternative to the 'directory' - package. FilePaths are ByteString based, so this - package only works on POSIX systems. - - For a more high-level version of this with - proper Path type, use 'hpath-io', which makes - use of this package. -homepage: https://github.com/hasufell/hpath -bug-reports: https://github.com/hasufell/hpath/issues -license: BSD3 -license-file: LICENSE -author: Julian Ospald -maintainer: Julian Ospald -copyright: Julian Ospald 2020 -category: Filesystem -build-type: Simple -extra-source-files: CHANGELOG.md -tested-with: GHC==7.10.3 - , GHC==8.0.2 - , GHC==8.2.2 - , GHC==8.4.4 - , GHC==8.6.5 - , GHC==8.8.1 +cabal-version: >=1.10 +name: hpath-directory +version: 0.15.2.2 +synopsis: + Alternative to 'directory' package with OsPath based filepaths + +description: + This provides a safer alternative to the 'directory' + package. + For a more high-level version of this with + proper Path type, use 'hpath-io', which makes + use of this package. + +homepage: https://github.com/hasufell/hpath +bug-reports: https://github.com/hasufell/hpath/issues +license: BSD3 +license-file: LICENSE +author: Julian Ospald +maintainer: Julian Ospald +copyright: Julian Ospald 2020 +category: Filesystem +build-type: Configure +extra-tmp-files: + autom4te.cache + config.log + config.status + src/HsDirectoryConfig.h + +extra-source-files: + ./src/HsDirectoryConfig.h.in + ./src/System/Win32/WindowsPath/*.h + CHANGELOG.md + +tested-with: + GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 library if os(windows) - build-depends: unbuildable<0 - buildable: False - exposed-modules: System.Posix.RawFilePath.Directory - System.Posix.RawFilePath.Directory.Errors + cpp-options: -DWINDOWS + exposed-modules: System.Win32.WindowsPath.Directory + build-depends: + Win32 + + include-dirs: src + + else + exposed-modules: + System.Posix.PosixPath.Directory + System.Posix.PosixPath.Directory.Errors + + build-depends: + hpath-posix >=0.14.0 + , streamly-posix >=0.1.0.2 + , unix >=2.8 + , unix-bytestring >=0.3 + + exposed-modules: + System.Directory.OsPath + System.Directory.HPath + System.Directory.Errors + System.Directory.Types + -- other-modules: -- other-extensions: - build-depends: base >= 4.8 && <5 - , IfElse - , bytestring >= 0.10 - , exceptions >= 0.10 - , hpath-filepath >= 0.10.4 - , hpath-posix >= 0.13.3 - , safe-exceptions >= 0.1 - , streamly >= 0.7 - , streamly-bytestring >= 0.1.2 - , streamly-posix >= 0.1.0.2 - , time >= 1.8 - , transformers - , unix >= 2.5 - , unix-bytestring >= 0.3 - , utf8-string - if impl(ghc < 8.0) - build-depends: - fail >= 4.9 + build-depends: + base >=4.8 && <5 + , bytestring >=0.10 + , exceptions >=0.10 + , filepath >=1.4.99.5 + , file-io + , IfElse + , hpath + , safe-exceptions >=0.1 + , split + , streamly >=0.8.2 + , streamly-bytestring >=0.1.2 + , time >=1.8 + , transformers + , utf8-string + + if impl(ghc <8.0) + build-depends: fail >=4.9 - hs-source-dirs: src - default-language: Haskell2010 + hs-source-dirs: src + default-language: Haskell2010 default-extensions: PackageImports - GHC-Options: -Wall + ghc-options: -Wall test-suite spec if os(windows) - build-depends: unbuildable<0 - buildable: False - Type: exitcode-stdio-1.0 - Default-Language: Haskell2010 - Hs-Source-Dirs: test - Main-Is: Main.hs + cpp-options: -DWINDOWS + + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs other-modules: - System.Posix.RawFilePath.Directory.AppendFileSpec - System.Posix.RawFilePath.Directory.CanonicalizePathSpec - System.Posix.RawFilePath.Directory.CopyDirRecursiveCollectFailuresSpec - System.Posix.RawFilePath.Directory.CopyDirRecursiveOverwriteSpec - System.Posix.RawFilePath.Directory.CopyDirRecursiveSpec - System.Posix.RawFilePath.Directory.CopyFileOverwriteSpec - System.Posix.RawFilePath.Directory.CopyFileSpec - System.Posix.RawFilePath.Directory.CreateDirIfMissingSpec - System.Posix.RawFilePath.Directory.CreateDirRecursiveSpec - System.Posix.RawFilePath.Directory.CreateDirSpec - System.Posix.RawFilePath.Directory.CreateRegularFileSpec - System.Posix.RawFilePath.Directory.CreateSymlinkSpec - System.Posix.RawFilePath.Directory.DeleteDirRecursiveSpec - System.Posix.RawFilePath.Directory.DeleteDirSpec - System.Posix.RawFilePath.Directory.DeleteFileSpec - System.Posix.RawFilePath.Directory.GetDirsFilesSpec - System.Posix.RawFilePath.Directory.GetFileTypeSpec - System.Posix.RawFilePath.Directory.MoveFileOverwriteSpec - System.Posix.RawFilePath.Directory.MoveFileSpec - System.Posix.RawFilePath.Directory.ReadFileSpec - System.Posix.RawFilePath.Directory.RecreateSymlinkOverwriteSpec - System.Posix.RawFilePath.Directory.RecreateSymlinkSpec - System.Posix.RawFilePath.Directory.RenameFileSpec - System.Posix.RawFilePath.Directory.ToAbsSpec - System.Posix.RawFilePath.Directory.WriteFileLSpec - System.Posix.RawFilePath.Directory.WriteFileSpec - Spec - Utils - GHC-Options: -Wall - Build-Depends: base - , HUnit - , IfElse - , bytestring >= 0.10.0.0 - , hpath-directory - , hpath-filepath >= 0.10 - , hpath-posix >= 0.13 - , hspec >= 1.3 - , process - , time >= 1.8 - , unix - , unix-bytestring - , utf8-string - build-tool-depends: hspec-discover:hspec-discover + Spec + System.Directory.AFP.AppendFileSpec + System.Directory.AFP.CanonicalizePathSpec + System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec + System.Directory.AFP.CopyDirRecursiveOverwriteSpec + System.Directory.AFP.CopyDirRecursiveSpec + System.Directory.AFP.CopyFileOverwriteSpec + System.Directory.AFP.CopyFileSpec + System.Directory.AFP.CreateDirIfMissingSpec + System.Directory.AFP.CreateDirRecursiveSpec + System.Directory.AFP.CreateDirSpec + System.Directory.AFP.CreateRegularFileSpec + System.Directory.AFP.CreateSymlinkSpec + System.Directory.AFP.DeleteDirRecursiveSpec + System.Directory.AFP.DeleteDirSpec + System.Directory.AFP.DeleteFileSpec + System.Directory.AFP.GetDirsFilesSpec + System.Directory.AFP.MoveFileOverwriteSpec + System.Directory.AFP.MoveFileSpec + System.Directory.AFP.ReadFileSpec + System.Directory.AFP.RecreateSymlinkOverwriteSpec + System.Directory.AFP.RecreateSymlinkSpec + System.Directory.AFP.RenameFileSpec + System.Directory.AFP.ToAbsSpec + System.Directory.AFP.WriteFileLSpec + System.Directory.AFP.WriteFileSpec + System.Directory.Posix.PosixFilePath.Directory.GetFileTypeSpec + Utils + + ghc-options: -Wall + + if os(windows) + cpp-options: -DWINDOWS + build-depends: + Win32 >=2.13.2.0 + + else + build-depends: + hpath-posix >=0.13 + , unix >=2.8 + , unix-bytestring + + build-depends: + filepath >=1.4.99.5 + , base + , bytestring >=0.10.0.0 + , hpath-directory + , file-io + , hspec >=1.3 + , HUnit + , IfElse + , process + , time >=1.8 + , utf8-string + + build-tool-depends: hspec-discover:hspec-discover -any default-extensions: PackageImports source-repository head diff --git a/hpath-directory/src/HsDirectoryConfig.h.in b/hpath-directory/src/HsDirectoryConfig.h.in new file mode 100644 index 0000000..81a8549 --- /dev/null +++ b/hpath-directory/src/HsDirectoryConfig.h.in @@ -0,0 +1,70 @@ +/* src/HsDirectoryConfig.h.in. Generated from configure.ac by autoheader. */ + +/* Filename extension of executable files */ +#undef EXE_EXTENSION + +/* Define to 1 if you have the `CreateSymbolicLinkW' function. */ +#undef HAVE_CREATESYMBOLICLINKW + +/* Define to 1 if you have the header file. */ +#undef HAVE_FCNTL_H + +/* Define to 1 if you have the `GetFinalPathNameByHandleW' function. */ +#undef HAVE_GETFINALPATHNAMEBYHANDLEW + +/* Define to 1 if you have the header file. */ +#undef HAVE_INTTYPES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_LIMITS_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_MEMORY_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDINT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDLIB_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STRINGS_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STRING_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_STAT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_TYPES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_TIME_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_UNISTD_H + +/* Define to 1 if you have the `utimensat' function. */ +#undef HAVE_UTIMENSAT + +/* Define to the address where bug reports for this package should be sent. */ +#undef PACKAGE_BUGREPORT + +/* Define to the full name of this package. */ +#undef PACKAGE_NAME + +/* Define to the full name and version of this package. */ +#undef PACKAGE_STRING + +/* Define to the one symbol short name of this package. */ +#undef PACKAGE_TARNAME + +/* Define to the home page for this package. */ +#undef PACKAGE_URL + +/* Define to the version of this package. */ +#undef PACKAGE_VERSION + +/* Define to 1 if you have the ANSI C header files. */ +#undef STDC_HEADERS diff --git a/hpath-directory/src/System/Directory/Errors.hs b/hpath-directory/src/System/Directory/Errors.hs new file mode 100644 index 0000000..711b3c8 --- /dev/null +++ b/hpath-directory/src/System/Directory/Errors.hs @@ -0,0 +1,143 @@ +-- | +-- Module : System.Directory.Errors +-- Copyright : © 2016 Julian Ospald +-- License : BSD3 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- Provides error handling. + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module System.Directory.Errors + ( + -- * Types + HPathIOException(..) + , RecursiveFailureHint(..) + + -- * Exception identifiers + , isSameFile + , isDestinationInSource + , isRecursiveFailure + , isReadContentsFailed + , isCreateDirFailed + , isCopyFileFailed + , isRecreateSymlinkFailed + + -- * Error handling functions + , handleIOError + , hideError + , bracketeer + , reactOnError + ) + where + + +import Control.Exception.Safe hiding (handleIOError) +import GHC.IO.Exception + ( + IOErrorType + ) +import System.IO.Error + ( + ioeGetErrorType + ) +import System.Directory.Types + + + + +toConstr :: HPathIOException -> String +toConstr SameFile {} = "SameFile" +toConstr DestinationInSource {} = "DestinationInSource" +toConstr RecursiveFailure {} = "RecursiveFailure" + + + + + + ----------------------------- + --[ Exception identifiers ]-- + ----------------------------- + + +isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool +isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty) +isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) +isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) + + +isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool +isReadContentsFailed ReadContentsFailed{} = True +isReadContentsFailed _ = False +isCreateDirFailed CreateDirFailed{} = True +isCreateDirFailed _ = False +isCopyFileFailed CopyFileFailed{} = True +isCopyFileFailed _ = False +isRecreateSymlinkFailed RecreateSymlinkFailed{} = True +isRecreateSymlinkFailed _ = False + + + + + + -------------------------------- + --[ Error handling functions ]-- + -------------------------------- + + + + +-- |Like `catchIOError`, with arguments swapped. +handleIOError :: (IOError -> IO a) -> IO a -> IO a +handleIOError = flip catchIOError + + +hideError :: IOErrorType -> IO () -> IO () +hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e) + + +-- |Like `bracket`, but allows to have different clean-up +-- actions depending on whether the in-between computation +-- has raised an exception or not. +bracketeer :: IO a -- ^ computation to run first + -> (a -> IO b) -- ^ computation to run last, when + -- no exception was raised + -> (a -> IO b) -- ^ computation to run last, + -- when an exception was raised + -> (a -> IO c) -- ^ computation to run in-between + -> IO c +bracketeer before after afterEx thing = + mask $ \restore -> do + a <- before + r <- restore (thing a) `onException` afterEx a + _ <- after a + return r + + +reactOnError :: IO a + -> [(IOErrorType, IO a)] -- ^ reaction on IO errors + -> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException + -> IO a +reactOnError a ios fmios = + a `catches` [iohandler, fmiohandler] + where + iohandler = Handler $ + \(ex :: IOException) -> + foldr (\(t, a') y -> if ioeGetErrorType ex == t + then a' + else y) + (throwIO ex) + ios + fmiohandler = Handler $ + \(ex :: HPathIOException) -> + foldr (\(t, a') y -> if toConstr ex == toConstr t + then a' + else y) + (throwIO ex) + fmios + + diff --git a/hpath-io/src/HPath/IO.hs b/hpath-directory/src/System/Directory/HPath.hs similarity index 50% rename from hpath-io/src/HPath/IO.hs rename to hpath-directory/src/System/Directory/HPath.hs index 3e53867..230aec7 100644 --- a/hpath-io/src/HPath/IO.hs +++ b/hpath-directory/src/System/Directory/HPath.hs @@ -1,41 +1,11 @@ --- | --- Module : HPath.IO --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- This module provides high-level IO related file operations like --- copy, delete, move and so on. It only operates on /Path x/ which --- guarantees us well-typed paths. This is a thin wrapper over --- System.Posix.RawFilePath.Directory in 'hpath-directory'. It's --- encouraged to use this module. --- --- Some of these operations are due to their nature __not atomic__, which --- means they may do multiple syscalls which form one context. Some --- of them also have to examine the filetypes explicitly before the --- syscalls, so a reasonable decision can be made. That means --- the result is undefined if another process changes that context --- while the non-atomic operation is still happening. However, where --- possible, as few syscalls as possible are used and the underlying --- exception handling is kept. --- --- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket` --- are ignored by some of the more high-level functions (like `easyCopy`). --- For other functions (like `copyFile`), the behavior on these file types is --- unreliable/unsafe. Check the documentation of those functions for details. - -{-# LANGUAGE FlexibleContexts #-} -- streamly -{-# LANGUAGE PackageImports #-} - -module HPath.IO +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} + +module System.Directory.HPath ( -- * Types - FileType(..) - , RecursiveErrorMode(..) - , CopyMode(..) + module System.Directory.Types + , Permissions -- * File copying , copyDirRecursive , recreateSymlink @@ -46,9 +16,6 @@ module HPath.IO , deleteDir , deleteDirRecursive , easyDelete - -- * File opening - , openFile - , executeFile -- * File creation , createRegularFile , createDir @@ -58,17 +25,22 @@ module HPath.IO -- * File renaming/moving , renameFile , moveFile - -- * File reading - , readFile - , readFileStrict - , readFileStream + -- * File opening + , openFile + , openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' -- * File writing , writeFile - , writeFileL + , writeFile' , appendFile - -- * File permissions - , RD.newFilePerms - , RD.newDirPerms + , appendFile' + -- * File reading + , readFile + , readFile' + , readSymbolicLink -- * File checks , doesExist , doesFileExist @@ -83,128 +55,95 @@ module HPath.IO , setModificationTimeHiRes -- * Directory reading , getDirsFiles + , getDirsFilesRec , getDirsFiles' + , getDirsFilesRec' , getDirsFilesStream - -- * Filetype operations - , getFileType + , getDirsFilesStreamRec + -- * CWD + , getCurrentDirectory + , setCurrentDirectory + -- * Permissions + , getPermissions + , setPermissions + , AFP.emptyPermissions + , AFP.setOwnerReadable + , AFP.setOwnerWritable + , AFP.setOwnerExecutable + , AFP.setOwnerSearchable + , AFP.newFilePerms + , AFP.newDirPerms -- * Others , canonicalizePath , toAbs - , withRawFilePath - , withHandle - , module System.Posix.RawFilePath.Directory.Errors + , getFileType + , AFP.FileType ) -where - - -import Control.Exception.Safe ( MonadMask - , MonadCatch - , bracketOnError - , finally - ) -import Control.Monad.Catch ( MonadThrow(..) ) + where -import Data.ByteString ( ByteString ) -import qualified Data.ByteString as BS -import Data.Traversable ( for ) -import qualified Data.ByteString.Lazy as L -import Data.Time.Clock -import Data.Time.Clock.POSIX ( POSIXTime ) -import Data.Word ( Word8 ) -import HPath +import System.Directory.OsPath (Permissions) +import qualified System.Directory.OsPath as AFP +import System.File.OsPath import Prelude hiding ( appendFile , readFile , writeFile ) -import Streamly -import Streamly.Memory.Array -import qualified System.IO as SIO -import System.Posix.Directory.ByteString - ( getWorkingDirectory ) -import qualified "unix" System.Posix.IO.ByteString - as SPI -import System.Posix.FD ( openFd ) -import System.Posix.RawFilePath.Directory.Errors -import System.Posix.Types ( FileMode - , ProcessID - , EpochTime - ) -import qualified System.Posix.RawFilePath.Directory - as RD -import System.Posix.RawFilePath.Directory - ( FileType - , RecursiveErrorMode - , CopyMode - ) +import HPath +import HPath.Internal +import System.Directory.Types +import Data.Time.Clock +import Data.Time.Clock.POSIX +import Streamly.Prelude ( SerialT, MonadAsync ) +import Control.Exception.Safe ( MonadCatch + , MonadMask + ) - -------------------- - --[ File Copying ]-- - -------------------- --- |Copies the contents of a directory recursively to the given destination, while preserving permissions. --- Does not follow symbolic links. This behaves more or less like --- the following, without descending into the destination if it --- already exists: --- --- @ --- cp -a \/source\/dir \/destination\/somedir --- @ --- --- For directory contents, this will ignore any file type that is not --- `RegularFile`, `SymbolicLink` or `Directory`. --- --- For `Overwrite` copy mode this does not prune destination directory --- contents, so the destination might contain more files than the source after --- the operation has completed. Permissions of existing directories are --- fixed. --- --- Safety/reliability concerns: --- --- * not atomic --- * examines filetypes explicitly --- * an explicit check `throwDestinationInSource` is carried out for the --- top directory for basic sanity, because otherwise we might end up --- with an infinite copy loop... however, this operation is not --- carried out recursively (because it's slow) --- --- Throws: +-- | Get the permissions of a file or directory. -- --- - `NoSuchThing` if source directory does not exist --- - `PermissionDenied` if source directory can't be opened --- - `SameFile` if source and destination are the same file --- (`HPathIOException`) --- - `DestinationInSource` if destination is contained in source --- (`HPathIOException`) +-- On Windows, the 'writable' permission corresponds to the "read-only" +-- attribute. The 'executable' permission is set if the file extension is of +-- an executable file type. The 'readable' permission is always set. -- --- Throws in `FailEarly` RecursiveErrorMode only: +-- On POSIX systems, this returns the result of @access@. -- --- - `PermissionDenied` if output directory is not writable --- - `InvalidArgument` if source directory is wrong type (symlink) --- - `InappropriateType` if source directory is wrong type (regular file) +-- The operation may fail with: -- --- Throws in `CollectFailures` RecursiveErrorMode only: +-- * 'isPermissionError' if the user is not permitted to access the +-- permissions, or -- --- - `RecursiveFailure` if any of the recursive operations that are not --- part of the top-directory sanity-checks fail (`HPathIOException`) --- --- Throws in `Strict` CopyMode only: --- --- - `AlreadyExists` if destination already exists +-- * 'isDoesNotExistError' if the file or directory does not exist. +getPermissions :: Path b -> IO Permissions +getPermissions (MkPath path) = AFP.getPermissions path + +getFileType :: Path b -> IO AFP.FileType +getFileType (MkPath path) = AFP.getFileType path + +setPermissions :: Path b -> Permissions -> IO () +setPermissions (MkPath path) = AFP.setPermissions path + + + + -------------------- + --[ File Copying ]-- + -------------------- + + copyDirRecursive :: Path b1 -- ^ source dir -> Path b2 -- ^ destination (parent dirs - -- are not automatically created) + -- are not automatically created) -> CopyMode -> RecursiveErrorMode -> IO () -copyDirRecursive (Path fromp) (Path destdirp) cm rm = - RD.copyDirRecursive fromp destdirp cm rm +copyDirRecursive (MkPath fromp) (MkPath destdirp) cm rm = + AFP.copyDirRecursive fromp destdirp cm rm -- |Recreate a symlink. @@ -235,12 +174,12 @@ copyDirRecursive (Path fromp) (Path destdirp) cm rm = -- Notes: -- -- - calls `symlink` -recreateSymlink :: Path b1 -- ^ the old symlink file - -> Path b2 -- ^ destination file +recreateSymlink :: Path b1 -- ^ the old symlink file + -> Path b2 -- ^ destination file -> CopyMode -> IO () -recreateSymlink (Path symsourceBS) (Path newsymBS) cm = - RD.recreateSymlink symsourceBS newsymBS cm +recreateSymlink (MkPath symsource) (MkPath newsym) cm = + AFP.recreateSymlink symsource newsym cm -- |Copies the given regular file to the given destination. @@ -281,7 +220,9 @@ copyFile :: Path b1 -- ^ source file -> Path b2 -- ^ destination file -> CopyMode -> IO () -copyFile (Path from) (Path to) cm = RD.copyFile from to cm +copyFile (MkPath from) (MkPath to) cm = + AFP.copyFile from to cm + -- |Copies a regular file, directory or symbolic link. In case of a -- symbolic link it is just recreated, even if it points to a directory. @@ -291,9 +232,13 @@ copyFile (Path from) (Path to) cm = RD.copyFile from to cm -- -- * examines filetypes explicitly -- * calls `copyDirRecursive` for directories -easyCopy :: Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO () -easyCopy (Path from) (Path to) cm rm = RD.easyCopy from to cm rm - +easyCopy :: Path b1 + -> Path b2 + -> CopyMode + -> RecursiveErrorMode + -> IO () +easyCopy (MkPath from) (MkPath to) cm rm = + AFP.easyCopy from to cm rm @@ -315,7 +260,8 @@ easyCopy (Path from) (Path to) cm rm = RD.easyCopy from to cm rm -- -- Notes: calls `unlink` deleteFile :: Path b -> IO () -deleteFile (Path p) = RD.deleteFile p +deleteFile (MkPath fp) = + AFP.deleteFile fp -- |Deletes the given directory, which must be empty, never symlinks. @@ -330,7 +276,7 @@ deleteFile (Path p) = RD.deleteFile p -- -- Notes: calls `rmdir` deleteDir :: Path b -> IO () -deleteDir (Path p) = RD.deleteDir p +deleteDir (MkPath fp) = AFP.deleteDir fp -- |Deletes the given directory recursively. Does not follow symbolic @@ -353,8 +299,7 @@ deleteDir (Path p) = RD.deleteDir p -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory deleteDirRecursive :: Path b -> IO () -deleteDirRecursive (Path p) = RD.deleteDirRecursive p - +deleteDirRecursive (MkPath p) = AFP.deleteDirRecursive p -- |Deletes a file, directory or symlink. @@ -367,28 +312,7 @@ deleteDirRecursive (Path p) = RD.deleteDirRecursive p -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories easyDelete :: Path b -> IO () -easyDelete (Path p) = RD.easyDelete p - - - - - -------------------- - --[ File Opening ]-- - -------------------- - - --- |Opens a file appropriately by invoking xdg-open. The file type --- is not checked. This forks a process. -openFile :: Path b -> IO ProcessID -openFile (Path fp) = RD.openFile fp - - --- |Executes a program with the given arguments. This forks a process. -executeFile :: Path b -- ^ program - -> [ByteString] -- ^ arguments - -> IO ProcessID -executeFile (Path fp) args = RD.executeFile fp args - +easyDelete (MkPath p) = AFP.easyDelete p @@ -406,8 +330,8 @@ executeFile (Path fp) args = RD.executeFile fp args -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createRegularFile :: FileMode -> Path b -> IO () -createRegularFile fm (Path destBS) = RD.createRegularFile fm destBS +createRegularFile :: Path b -> IO () +createRegularFile (MkPath destBS) = AFP.createRegularFile destBS -- |Create an empty directory at the given directory with the given filename. @@ -418,8 +342,8 @@ createRegularFile fm (Path destBS) = RD.createRegularFile fm destBS -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDir :: FileMode -> Path b -> IO () -createDir fm (Path destBS) = RD.createDir fm destBS +createDir :: Path b -> IO () +createDir (MkPath destBS) = AFP.createDir destBS -- |Create an empty directory at the given directory with the given filename. -- @@ -428,8 +352,9 @@ createDir fm (Path destBS) = RD.createDir fm destBS -- - `PermissionDenied` if output directory cannot be written to -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDirIfMissing :: FileMode -> Path b -> IO () -createDirIfMissing fm (Path destBS) = RD.createDirIfMissing fm destBS +createDirIfMissing :: Path b -> IO () +createDirIfMissing (MkPath destBS) = + AFP.createDirIfMissing destBS -- |Create an empty directory at the given directory with the given filename. @@ -450,9 +375,8 @@ createDirIfMissing fm (Path destBS) = RD.createDirIfMissing fm destBS -- exist and cannot be written to -- - `AlreadyExists` if destination already exists and -- is *not* a directory -createDirRecursive :: FileMode -> Path b -> IO () -createDirRecursive fm (Path p) = RD.createDirRecursive fm p - +createDirRecursive :: Path b -> IO () +createDirRecursive (MkPath p) = AFP.createDirRecursive p -- |Create a symlink. @@ -465,10 +389,12 @@ createDirRecursive fm (Path p) = RD.createDirRecursive fm p -- do not exist -- -- Note: calls `symlink` -createSymlink :: Path b -- ^ destination file - -> ByteString -- ^ path the symlink points to +createSymlink :: Path b1 -- ^ destination file + -> Path b2 -- ^ path the symlink points to + -> Bool -- ^ whether this is a dir (irrelevant on posix) -> IO () -createSymlink (Path destBS) sympoint = RD.createSymlink destBS sympoint +createSymlink (MkPath destBS) (MkPath sympoint) dir = + AFP.createSymlink destBS sympoint dir @@ -499,8 +425,7 @@ createSymlink (Path destBS) sympoint = RD.createSymlink destBS sympoint -- -- Note: calls `rename` (but does not allow to rename over existing files) renameFile :: Path b1 -> Path b2 -> IO () -renameFile (Path from) (Path to) = RD.renameFile from to - +renameFile (MkPath fromf) (MkPath tof) = AFP.renameFile fromf tof -- |Move a file. This also works across devices by copy-delete fallback. @@ -538,7 +463,7 @@ moveFile :: Path b1 -- ^ file to move -> Path b2 -- ^ destination -> CopyMode -> IO () -moveFile (Path from) (Path to) cm = RD.moveFile from to cm +moveFile (MkPath from) (MkPath to) cm = AFP.moveFile from to cm @@ -549,101 +474,10 @@ moveFile (Path from) (Path to) cm = RD.moveFile from to cm -------------------- --- |Read the given file lazily. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFile :: Path b -> IO L.ByteString -readFile (Path path) = RD.readFile path - - --- |Read the given file strictly into memory. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStrict :: Path b -> IO BS.ByteString -readFileStrict (Path path) = RD.readFileStrict path - - --- | Open the given file as a filestream. Once the filestream is --- exits, the filehandle is cleaned up. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStream :: Path b -> IO (SerialT IO (Array Word8)) -readFileStream (Path fp) = RD.readFileStream fp - - - - - -------------------- - --[ File Writing ]-- - -------------------- - - --- |Write a given ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -writeFile :: Path b - -> Maybe FileMode -- ^ if Nothing, file must exist - -> ByteString - -> IO () -writeFile (Path fp) fmode bs = RD.writeFile fp fmode bs - - --- |Write a given lazy ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist --- --- Note: uses streamly under the hood -writeFileL :: Path b - -> Maybe FileMode -- ^ if Nothing, file must exist - -> L.ByteString - -> IO () -writeFileL (Path fp) fmode lbs = RD.writeFileL fp fmode lbs - - --- |Append a given ByteString to a file. --- The file must exist. Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -appendFile :: Path b -> ByteString -> IO () -appendFile (Path fp) bs = RD.appendFile fp bs - +-- | Read the target of a symbolic link. +readSymbolicLink :: Path b1 -> IO (Path b2) +readSymbolicLink (MkPath fp) = MkPath <$> AFP.readSymbolicLink fp @@ -657,7 +491,7 @@ appendFile (Path fp) bs = RD.appendFile fp bs -- -- Only eNOENT is catched (and returns False). doesExist :: Path b -> IO Bool -doesExist (Path bs) = RD.doesExist bs +doesExist (MkPath bs) = AFP.doesExist bs -- |Checks if the given file exists and is not a directory. @@ -665,7 +499,7 @@ doesExist (Path bs) = RD.doesExist bs -- -- Only eNOENT is catched (and returns False). doesFileExist :: Path b -> IO Bool -doesFileExist (Path bs) = RD.doesFileExist bs +doesFileExist (MkPath bs) = AFP.doesFileExist bs -- |Checks if the given file exists and is a directory. @@ -673,7 +507,7 @@ doesFileExist (Path bs) = RD.doesFileExist bs -- -- Only eNOENT is catched (and returns False). doesDirectoryExist :: Path b -> IO Bool -doesDirectoryExist (Path bs) = RD.doesDirectoryExist bs +doesDirectoryExist (MkPath bs) = AFP.doesDirectoryExist bs -- |Checks whether a file or folder is readable. @@ -684,7 +518,7 @@ doesDirectoryExist (Path bs) = RD.doesDirectoryExist bs -- -- - `NoSuchThing` if the file does not exist isReadable :: Path b -> IO Bool -isReadable (Path bs) = RD.isReadable bs +isReadable (MkPath bs) = AFP.isReadable bs -- |Checks whether a file or folder is writable. -- @@ -694,7 +528,7 @@ isReadable (Path bs) = RD.isReadable bs -- -- - `NoSuchThing` if the file does not exist isWritable :: Path b -> IO Bool -isWritable (Path bs) = RD.isWritable bs +isWritable (MkPath bs) = AFP.isWritable bs -- |Checks whether a file or folder is executable. @@ -705,14 +539,14 @@ isWritable (Path bs) = RD.isWritable bs -- -- - `NoSuchThing` if the file does not exist isExecutable :: Path b -> IO Bool -isExecutable (Path bs) = RD.isExecutable bs +isExecutable (MkPath bs) = AFP.isExecutable bs -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. canOpenDirectory :: Path b -> IO Bool -canOpenDirectory (Path bs) = RD.canOpenDirectory bs +canOpenDirectory (MkPath bs) = AFP.canOpenDirectory bs @@ -723,13 +557,13 @@ canOpenDirectory (Path bs) = RD.canOpenDirectory bs getModificationTime :: Path b -> IO UTCTime -getModificationTime (Path bs) = RD.getModificationTime bs +getModificationTime (MkPath bs) = AFP.getModificationTime bs -setModificationTime :: Path b -> EpochTime -> IO () -setModificationTime (Path bs) t = RD.setModificationTime bs t +setModificationTime :: Path b -> UTCTime -> IO () +setModificationTime (MkPath bs) t = AFP.setModificationTime bs t setModificationTimeHiRes :: Path b -> POSIXTime -> IO () -setModificationTimeHiRes (Path bs) t = RD.setModificationTimeHiRes bs t +setModificationTimeHiRes (MkPath bs) t = AFP.setModificationTimeHiRes bs t @@ -750,48 +584,51 @@ setModificationTimeHiRes (Path bs) t = RD.setModificationTimeHiRes bs t -- - `InappropriateType` if file type is wrong (symlink to file) -- - `InappropriateType` if file type is wrong (symlink to dir) -- - `PermissionDenied` if directory cannot be opened --- - `PathParseException` if a filename could not be parsed (should never happen) getDirsFiles :: Path b -- ^ dir to read -> IO [Path b] -getDirsFiles p = do - contents <- getDirsFiles' p - pure $ fmap (p ) contents +getDirsFiles (MkPath p) = fmap MkPath <$> AFP.getDirsFiles p + + +getDirsFilesRec :: Path b -- ^ dir to read + -> IO [Path b] +getDirsFilesRec (MkPath p) = fmap MkPath <$> AFP.getDirsFilesRec p -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. getDirsFiles' :: Path b -- ^ dir to read -> IO [Path Rel] -getDirsFiles' (Path fp) = do - rawContents <- RD.getDirsFiles' fp - for rawContents $ \r -> parseRel r +getDirsFiles' (MkPath fp) = fmap MkPath <$> AFP.getDirsFiles' fp + + +getDirsFilesRec' :: Path b -- ^ dir to read + -> IO [Path Rel] +getDirsFilesRec' (MkPath p) = fmap MkPath <$> AFP.getDirsFilesRec' p + + +getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) + => Path b + -> IO (SerialT m (Path Rel)) +getDirsFilesStreamRec (MkPath fp) = fmap MkPath <$> AFP.getDirsFilesStreamRec fp -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) => Path b -> IO (SerialT m (Path Rel)) -getDirsFilesStream (Path fp) = do - s <- RD.getDirsFilesStream fp - pure (s >>= parseRel) - +getDirsFilesStream (MkPath fp) = fmap MkPath <$> AFP.getDirsFilesStream fp + ----------- + --[ CWD ]-- + ----------- - --------------------------- - --[ FileType operations ]-- - --------------------------- +getCurrentDirectory :: IO (Path b) +getCurrentDirectory = MkPath <$> AFP.getCurrentDirectory +setCurrentDirectory :: Path b -> IO () +setCurrentDirectory (MkPath fp) = AFP.setCurrentDirectory fp --- |Get the file type of the file located at the given path. Does --- not follow symbolic links. --- --- Throws: --- --- - `NoSuchThing` if the file does not exist --- - `PermissionDenied` if any part of the path is not accessible -getFileType :: Path b -> IO FileType -getFileType (Path fp) = RD.getFileType fp @@ -807,11 +644,8 @@ getFileType (Path fp) = RD.getFileType fp -- -- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the symlink is broken --- - `PathParseException` if realpath does not return an absolute path canonicalizePath :: Path b -> IO (Path Abs) -canonicalizePath (Path l) = do - nl <- RD.canonicalizePath l - parseAbs nl +canonicalizePath (MkPath fp) = MkPath <$> AFP.canonicalizePath fp -- |Converts any path to an absolute path. @@ -820,48 +654,5 @@ canonicalizePath (Path l) = do -- - if the path is already an absolute one, just return it -- - if it's a relative path, prepend the current directory to it toAbs :: Path b -> IO (Path Abs) -toAbs (Path bs) = do - let mabs = parseAbs bs :: Maybe (Path Abs) - case mabs of - Just a -> return a - Nothing -> do - cwd <- getWorkingDirectory >>= parseAbs - r <- parseRel bs -- we know it must be relative now - return $ cwd r - - --- | Helper function to use the Path library without --- buying into the Path type too much. This uses 'parseAny' --- under the hood and may throw `PathParseException`. --- --- Throws: --- --- - `PathParseException` if the bytestring could neither be parsed as --- relative or absolute Path -withRawFilePath :: MonadThrow m - => ByteString - -> (Either (Path Abs) (Path Rel) -> m b) - -> m b -withRawFilePath bs action = do - path <- parseAny bs - action path - +toAbs (MkPath bs) = MkPath <$> AFP.toAbs bs --- | Convenience function to open the path as a handle. --- --- If the file does not exist, it will be created with 'newFilePerms'. --- --- Throws: --- --- - `PathParseException` if the bytestring could neither be parsed as --- relative or absolute Path -withHandle :: ByteString - -> SPI.OpenMode - -> ((SIO.Handle, Either (Path Abs) (Path Rel)) -> IO a) - -> IO a -withHandle bs mode action = do - path <- parseAny bs - handle <- - bracketOnError (openFd bs mode [] (Just RD.newFilePerms)) (SPI.closeFd) - $ SPI.fdToHandle - finally (action (handle, path)) (SIO.hClose handle) diff --git a/hpath-directory/src/System/Directory/OsPath.hs b/hpath-directory/src/System/Directory/OsPath.hs new file mode 100644 index 0000000..29c528c --- /dev/null +++ b/hpath-directory/src/System/Directory/OsPath.hs @@ -0,0 +1,815 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} + +module System.Directory.OsPath + ( + -- * Types + module System.Directory.Types + , Permissions + -- * File copying + , copyDirRecursive + , recreateSymlink + , copyFile + , easyCopy + -- * File deletion + , deleteFile + , deleteDir + , deleteDirRecursive + , easyDelete + -- * File creation + , createRegularFile + , createDir + , createDirIfMissing + , createDirRecursive + , createSymlink + -- * File renaming/moving + , renameFile + , moveFile + -- * File opening + , openFile + , openExistingFile + , openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' + -- * File writing + , writeFile + , writeFile' + , writeExistingFile + , writeExistingFile' + , appendFile + , appendFile' + , appendExistingFile + , appendExistingFile' + -- * File reading + , readFile + , readFile' + , readExistingFile + , readExistingFile' + , readSymbolicLink + -- * File checks + , doesExist + , doesFileExist + , doesDirectoryExist + , isReadable + , isWritable + , isExecutable + , canOpenDirectory + -- * File times + , getModificationTime + , setModificationTime + , setModificationTimeHiRes + -- * Directory reading + , getDirsFiles + , getDirsFilesRec + , getDirsFiles' + , getDirsFilesRec' + , getDirsFilesStream + , getDirsFilesStreamRec + -- * CWD + , getCurrentDirectory + , setCurrentDirectory + -- * Permissions + , getPermissions + , setPermissions + , emptyPermissions + , setOwnerReadable + , setOwnerWritable + , setOwnerExecutable + , setOwnerSearchable + , newFilePerms + , newDirPerms + -- * Others + , canonicalizePath + , toAbs + , getFileType + , Dir.FileType + ) + where + +import System.File.OsPath +import Prelude hiding ( appendFile + , readFile + , writeFile + ) +import System.Directory.Types +#ifdef WINDOWS +import qualified System.Win32.WindowsPath.Directory as Dir +#else +import Data.Bits +import qualified System.Posix.PosixPath.Directory as Dir +import qualified System.Posix as Posix (FileMode) +import qualified System.Posix.Files.ByteString as Posix +import qualified Data.ByteString.Short as SBS +#endif +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as L +import System.OsPath.Types +import System.OsString.Internal.Types +import Data.Time.Clock +import Data.Time.Clock.POSIX +import Streamly.Prelude ( SerialT, MonadAsync ) + +import Control.Exception.Safe ( MonadCatch + , MonadMask + ) + + ---------------------- + --[ Abstract types ]-- + ---------------------- + + + + +data Permissions + = Permissions + { readable :: Bool + , writable :: Bool + , executable :: Bool + , searchable :: Bool + } deriving (Eq, Ord, Read, Show) + + + + + ------------------------ + --[ File Permissions ]-- + ------------------------ + + +emptyPermissions :: Permissions +emptyPermissions = Permissions { + readable = False, + writable = False, + executable = False, + searchable = False + } + +setOwnerReadable :: Bool -> Permissions -> Permissions +setOwnerReadable b p = p { readable = b } + +setOwnerWritable :: Bool -> Permissions -> Permissions +setOwnerWritable b p = p { writable = b } + +setOwnerExecutable :: Bool -> Permissions -> Permissions +setOwnerExecutable b p = p { executable = b } + +setOwnerSearchable :: Bool -> Permissions -> Permissions +setOwnerSearchable b p = p { searchable = b } + + +-- |Default permissions for a new file. +newFilePerms :: Permissions +newFilePerms = Permissions { + readable = True, + writable = True, + executable = False, + searchable = False + } + + +-- |Default permissions for a new directory. +newDirPerms :: Permissions +newDirPerms = Permissions { + readable = True, + writable = True, + executable = False, + searchable = True + } + + +-- | Get the permissions of a file or directory. +-- +-- On Windows, the 'writable' permission corresponds to the "read-only" +-- attribute. The 'executable' permission is set if the file extension is of +-- an executable file type. The 'readable' permission is always set. +-- +-- On POSIX systems, this returns the result of @access@. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to access the +-- permissions, or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +getPermissions :: OsPath -> IO Permissions +#ifdef WINDOWS +getPermissions (OsString path) = do + t <- Dir.getFileType path + let isDir = t == Dir.Directory || t == Dir.DirectoryLink + w <- Dir.isWritable path + x <- Dir.isExecutable path + pure Permissions + { readable = True + , writable = w + , executable = x && not isDir + , searchable = isDir + } +#else +getPermissions (OsString (PS path')) = do + let path = SBS.fromShort path' + m <- Posix.getFileStatus path + let isDir = Posix.isDirectory m + r <- Posix.fileAccess path True False False + w <- Posix.fileAccess path False True False + x <- Posix.fileAccess path False False True + pure Permissions + { readable = r + , writable = w + , executable = x && not isDir + , searchable = x && isDir + } +#endif + +getFileType :: OsPath -> IO Dir.FileType +getFileType (OsString path) = Dir.getFileType path + +setPermissions :: OsPath -> Permissions -> IO () +#ifdef WINDOWS +setPermissions (OsString path) Permissions{writable = w} = do + Dir.setFilePermissions path (Dir.setWriteMode w 0) +#else +setPermissions (OsString (PS path')) (Permissions r w e s) = do + let path = SBS.fromShort path' + m <- Posix.getFileStatus path + Posix.setFileMode path (modifyBit (e || s) Posix.ownerExecuteMode . + modifyBit w Posix.ownerWriteMode . + modifyBit r Posix.ownerReadMode . + Posix.fileMode $ m) + where + modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode + modifyBit False b m = m .&. complement b + modifyBit True b m = m .|. b +#endif + + + + -------------------- + --[ File Copying ]-- + -------------------- + + +copyDirRecursive :: OsPath -- ^ source dir + -> OsPath -- ^ destination (parent dirs + -- are not automatically created) + -> CopyMode + -> RecursiveErrorMode + -> IO () +copyDirRecursive (OsString fromp) (OsString destdirp) cm rm = + Dir.copyDirRecursive fromp destdirp cm rm + + +-- |Recreate a symlink. +-- +-- In `Overwrite` copy mode only files and empty directories are deleted. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is inherently non-atomic +-- +-- Throws: +-- +-- - `InvalidArgument` if source file is wrong type (not a symlink) +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +-- +-- Throws in `Overwrite` mode only: +-- +-- - `UnsatisfiedConstraints` if destination file is non-empty directory +-- +-- Notes: +-- +-- - calls `symlink` +recreateSymlink :: OsPath -- ^ the old symlink file + -> OsPath -- ^ destination file + -> CopyMode + -> IO () +recreateSymlink (OsString symsource) (OsString newsym) cm = + Dir.recreateSymlink symsource newsym cm + + +-- |Copies the given regular file to the given destination. +-- Neither follows symbolic links, nor accepts them. +-- For "copying" symbolic links, use `recreateSymlink` instead. +-- +-- Note that this is still sort of a low-level function and doesn't +-- examine file types. For a more high-level version, use `easyCopy` +-- instead. +-- +-- In `Overwrite` copy mode only overwrites actual files, not directories. +-- In `Strict` mode the destination file must not exist. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is not atomic +-- * when used on `CharacterDevice`, reads the "contents" and copies +-- them to a regular file, which might take indefinitely +-- * when used on `BlockDevice`, may either read the "contents" +-- and copy them to a regular file (potentially hanging indefinitely) +-- or may create a regular empty destination file +-- * when used on `NamedPipe`, will hang indefinitely +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `NoSuchThing` if source file is a a `Socket` +-- - `PermissionDenied` if output directory is not writable +-- - `PermissionDenied` if source directory can't be opened +-- - `InvalidArgument` if source file is wrong type (symlink or directory) +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +copyFile :: OsPath -- ^ source file + -> OsPath -- ^ destination file + -> CopyMode + -> IO () +copyFile (OsString from) (OsString to) cm = + Dir.copyFile from to cm + + +-- |Copies a regular file, directory or symbolic link. In case of a +-- symbolic link it is just recreated, even if it points to a directory. +-- Any other file type is ignored. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `copyDirRecursive` for directories +easyCopy :: OsPath + -> OsPath + -> CopyMode + -> RecursiveErrorMode + -> IO () +easyCopy (OsString from) (OsString to) cm rm = + Dir.easyCopy from to cm rm + + + + + + --------------------- + --[ File Deletion ]-- + --------------------- + + +-- |Deletes the given file. Raises `eISDIR` +-- if run on a directory. Does not follow symbolic links. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (directory) +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if the directory cannot be read +-- +-- Notes: calls `unlink` +deleteFile :: OsPath -> IO () +deleteFile (OsString fp) = + Dir.deleteFile fp + + +-- |Deletes the given directory, which must be empty, never symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `UnsatisfiedConstraints` if directory is not empty +-- - `PermissionDenied` if we can't open or write to parent directory +-- +-- Notes: calls `rmdir` +deleteDir :: OsPath -> IO () +deleteDir (OsString fp) = Dir.deleteDir fp + + +-- |Deletes the given directory recursively. Does not follow symbolic +-- links. Tries `deleteDir` first before attemtping a recursive +-- deletion. +-- +-- On directory contents this behaves like `easyDelete` +-- and thus will ignore any file type that is not `RegularFile`, +-- `SymbolicLink` or `Directory`. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * examines filetypes explicitly +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `PermissionDenied` if we can't open or write to parent directory +deleteDirRecursive :: OsPath -> IO () +deleteDirRecursive (OsString p) = Dir.deleteDirRecursive p + + +-- |Deletes a file, directory or symlink. +-- In case of directory, performs recursive deletion. In case of +-- a symlink, the symlink file is deleted. +-- Any other file type is ignored. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `deleteDirRecursive` for directories +easyDelete :: OsPath -> IO () +easyDelete (OsString p) = Dir.easyDelete p + + + + --------------------- + --[ File Creation ]-- + --------------------- + + +-- |Create an empty regular file at the given directory with the given +-- filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createRegularFile :: OsPath -> IO () +createRegularFile (OsString destBS) = Dir.createRegularFile Dir.newFilePerms destBS + + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createDir :: OsPath -> IO () +createDir (OsString destBS) = +#if WINDOWS + Dir.createDir destBS +#else + Dir.createDir Dir.newDirPerms destBS +#endif + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createDirIfMissing :: OsPath -> IO () +createDirIfMissing (OsString destBS) = +#if WINDOWS + Dir.createDirIfMissing destBS +#else + Dir.createDirIfMissing Dir.newDirPerms destBS +#endif + + +-- |Create an empty directory at the given directory with the given filename. +-- All parent directories are created with the same filemode. This +-- basically behaves like: +-- +-- @ +-- mkdir -p \/some\/dir +-- @ +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- +-- Throws: +-- +-- - `PermissionDenied` if any part of the path components do not +-- exist and cannot be written to +-- - `AlreadyExists` if destination already exists and +-- is *not* a directory +createDirRecursive :: OsPath -> IO () +createDirRecursive (OsString p) = +#if WINDOWS + Dir.createDirRecursive p +#else + Dir.createDirRecursive Dir.newDirPerms p +#endif + + +-- |Create a symlink. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination file already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +-- +-- Note: calls `symlink` +createSymlink :: OsPath -- ^ destination file + -> OsPath -- ^ path the symlink points to + -> Bool -- ^ whether this is a dir (irrelevant on posix) + -> IO () +#if WINDOWS +createSymlink (OsString destBS) (OsString sympoint) dir = + Dir.createSymlink destBS sympoint dir +#else +createSymlink (OsString destBS) (OsString sympoint) _ = + Dir.createSymlink destBS sympoint +#endif + + + + ---------------------------- + --[ File Renaming/Moving ]-- + ---------------------------- + + +-- |Rename a given file with the provided filename. Destination and source +-- must be on the same device, otherwise `eXDEV` will be raised. +-- +-- Does not follow symbolic links, but renames the symbolic link file. +-- +-- Safety/reliability concerns: +-- +-- * has a separate set of exception handling, apart from the syscall +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `UnsupportedOperation` if source and destination are on different +-- devices +-- - `AlreadyExists` if destination already exists +-- - `SameFile` if destination and source are the same file +-- (`HPathIOException`) +-- +-- Note: calls `rename` (but does not allow to rename over existing files) +renameFile :: OsPath -> OsPath -> IO () +renameFile (OsString fromf) (OsString tof) = Dir.renameFile fromf tof + + +-- |Move a file. This also works across devices by copy-delete fallback. +-- And also works on directories. +-- +-- Does not follow symbolic links, but renames the symbolic link file. +-- +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is not atomic +-- * copy-delete fallback is inherently non-atomic +-- * since this function calls `easyCopy` and `easyDelete` as a fallback +-- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink` +-- or `Directory` may be ignored +-- * for `Overwrite` mode, the destination will be deleted (not recursively) +-- before moving +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `SameFile` if destination and source are the same file +-- (`HPathIOException`) +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +-- +-- Notes: +-- +-- - calls `rename` (but does not allow to rename over existing files) +moveFile :: OsPath -- ^ file to move + -> OsPath -- ^ destination + -> CopyMode + -> IO () +moveFile (OsString from) (OsString to) cm = Dir.moveFile from to cm + + + ------------------ + --[ File Write ]-- + ------------------ + +appendExistingFile :: OsPath -> L.ByteString -> IO () +appendExistingFile (OsString fp) = Dir.appendExistingFile fp + +appendExistingFile' :: OsPath -> BS.ByteString -> IO () +appendExistingFile' (OsString fp) = Dir.appendExistingFile' fp + + +writeExistingFile :: OsPath -> L.ByteString -> IO () +writeExistingFile (OsString fp) = Dir.writeExistingFile fp + +writeExistingFile' :: OsPath -> BS.ByteString -> IO () +writeExistingFile' (OsString fp) = Dir.writeExistingFile' fp + + -------------------- + --[ File Reading ]-- + -------------------- + +readExistingFile :: OsPath -> IO L.ByteString +readExistingFile (OsString fp) = Dir.readExistingFile fp + +readExistingFile' :: OsPath -> IO BS.ByteString +readExistingFile' (OsString fp) = Dir.readExistingFile' fp + +-- | Read the target of a symbolic link. +readSymbolicLink :: OsPath -> IO OsPath +readSymbolicLink (OsString fp) = OsString <$> Dir.readSymbolicLink fp + + + + + ------------------- + --[ File checks ]-- + ------------------- + + +-- |Checks if the given file exists. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesExist :: OsPath -> IO Bool +doesExist (OsString bs) = Dir.doesExist bs + + +-- |Checks if the given file exists and is not a directory. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesFileExist :: OsPath -> IO Bool +doesFileExist (OsString bs) = Dir.doesFileExist bs + + +-- |Checks if the given file exists and is a directory. +-- Does not follow symlinks. +-- +-- Only eNOENT is catched (and returns False). +doesDirectoryExist :: OsPath -> IO Bool +doesDirectoryExist (OsString bs) = Dir.doesDirectoryExist bs + + +-- |Checks whether a file or folder is readable. +-- +-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False). +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isReadable :: OsPath -> IO Bool +isReadable (OsString bs) = Dir.isReadable bs + +-- |Checks whether a file or folder is writable. +-- +-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False). +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isWritable :: OsPath -> IO Bool +isWritable (OsString bs) = Dir.isWritable bs + + +-- |Checks whether a file or folder is executable. +-- +-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False). +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isExecutable :: OsPath -> IO Bool +isExecutable (OsString bs) = Dir.isExecutable bs + + + +-- |Checks whether the directory at the given path exists and can be +-- opened. This invokes `openDirStream` which follows symlinks. +canOpenDirectory :: OsPath -> IO Bool +canOpenDirectory (OsString bs) = Dir.canOpenDirectory bs + + + + + ------------------ + --[ File times ]-- + ------------------ + + +getModificationTime :: OsPath -> IO UTCTime +getModificationTime (OsString bs) = Dir.getModificationTime bs + +setModificationTime :: OsPath -> UTCTime -> IO () +setModificationTime (OsString bs) t = Dir.setModificationTime bs t + +setModificationTimeHiRes :: OsPath -> POSIXTime -> IO () +setModificationTimeHiRes (OsString bs) t = +#ifdef WINDOWS + Dir.setModificationTimeHiRes bs (Dir.posixToWindowsTime t) +#else + Dir.setModificationTimeHiRes bs t +#endif + + + + ------------------------- + --[ Directory reading ]-- + ------------------------- + + +-- |Gets all filenames of the given directory. This excludes "." and "..". +-- This version does not follow symbolic links. +-- +-- The contents are not sorted and there is no guarantee on the ordering. +-- +-- Throws: +-- +-- - `NoSuchThing` if directory does not exist +-- - `InappropriateType` if file type is wrong (file) +-- - `InappropriateType` if file type is wrong (symlink to file) +-- - `InappropriateType` if file type is wrong (symlink to dir) +-- - `PermissionDenied` if directory cannot be opened +getDirsFiles :: OsPath -- ^ dir to read + -> IO [OsPath] +getDirsFiles (OsString p) = fmap OsString <$> Dir.getDirsFiles p + + +getDirsFilesRec :: OsPath -- ^ dir to read + -> IO [OsPath] +getDirsFilesRec (OsString p) = fmap OsString <$> Dir.getDirsFilesRec p + + +-- | Like 'getDirsFiles', but returns the filename only, instead +-- of prepending the base path. +getDirsFiles' :: OsPath -- ^ dir to read + -> IO [OsPath] +getDirsFiles' (OsString fp) = fmap OsString <$> Dir.getDirsFiles' fp + + +getDirsFilesRec' :: OsPath -- ^ dir to read + -> IO [OsPath] +getDirsFilesRec' (OsString p) = fmap OsString <$> Dir.getDirsFilesRec' p + + +getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) + => OsPath + -> IO (SerialT m OsPath) +getDirsFilesStreamRec (OsString fp) = fmap OsString <$> Dir.getDirsFilesStreamRec fp + + +-- | Like 'getDirsFiles'', except returning a Stream. +getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) + => OsPath + -> IO (SerialT m OsPath) +getDirsFilesStream (OsString fp) = fmap OsString <$> Dir.getDirsFilesStream fp + + + ----------- + --[ CWD ]-- + ----------- + +getCurrentDirectory :: IO OsPath +getCurrentDirectory = OsString <$> Dir.getCurrentDirectory + +setCurrentDirectory :: OsPath -> IO () +setCurrentDirectory (OsString fp) = Dir.setCurrentDirectory fp + + + + + -------------- + --[ Others ]-- + -------------- + + + +-- |Applies `realpath` on the given path. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file at the given path does not exist +-- - `NoSuchThing` if the symlink is broken +canonicalizePath :: OsPath -> IO OsPath +canonicalizePath (OsString fp) = OsString <$> Dir.canonicalizePath fp + + +-- |Converts any path to an absolute path. +-- This is done in the following way: +-- +-- - if the path is already an absolute one, just return it +-- - if it's a relative path, prepend the current directory to it +toAbs :: OsPath -> IO OsPath +toAbs (OsString bs) = OsString <$> Dir.toAbs bs + diff --git a/hpath-directory/src/System/Directory/Types.hs b/hpath-directory/src/System/Directory/Types.hs new file mode 100644 index 0000000..df2f000 --- /dev/null +++ b/hpath-directory/src/System/Directory/Types.hs @@ -0,0 +1,63 @@ +module System.Directory.Types where + +import Control.Exception (Exception, IOException) +import Data.Typeable (Typeable) +import System.OsPath.Types + + + + + + ------------- + --[ Types ]-- + ------------- + +-- |Additional generic IO exceptions that the posix functions +-- do not provide. +data HPathIOException = SameFile OsPath OsPath + | DestinationInSource OsPath OsPath + | RecursiveFailure [(RecursiveFailureHint, IOException)] + deriving (Eq, Show, Typeable) + + +-- |A type for giving failure hints on recursive failure, which allows +-- to programmatically make choices without examining +-- the weakly typed I/O error attributes (like `ioeGetFileName`). +-- +-- The first argument to the data constructor is always the +-- source and the second the destination. +data RecursiveFailureHint = ReadContentsFailed OsPath OsPath + | CreateDirFailed OsPath OsPath + | CopyFileFailed OsPath OsPath + | RecreateSymlinkFailed OsPath OsPath + deriving (Eq, Show) + + + +instance Exception HPathIOException + + + +-- |The error mode for recursive operations. +-- +-- On `FailEarly` the whole operation fails immediately if any of the +-- recursive sub-operations fail, which is sort of the default +-- for IO operations. +-- +-- On `CollectFailures` skips errors in the recursion and keeps on recursing. +-- However all errors are collected in the `RecursiveFailure` error type, +-- which is raised finally if there was any error. Also note that +-- `RecursiveFailure` does not give any guarantees on the ordering +-- of the collected exceptions. +data RecursiveErrorMode = FailEarly + | CollectFailures + deriving (Eq, Show) + + +-- |The mode for copy and file moves. +-- Overwrite mode is usually not very well defined, but is a convenience +-- shortcut. +data CopyMode = Strict -- ^ fail if any target exists + | Overwrite -- ^ overwrite targets + deriving (Eq, Show) + diff --git a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs b/hpath-directory/src/System/Posix/PosixPath/Directory.hs similarity index 75% rename from hpath-directory/src/System/Posix/RawFilePath/Directory.hs rename to hpath-directory/src/System/Posix/PosixPath/Directory.hs index e8dae84..95a58c3 100644 --- a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs +++ b/hpath-directory/src/System/Posix/PosixPath/Directory.hs @@ -1,5 +1,5 @@ -- | --- Module : System.Posix.RawFilePath.Directory +-- Module : System.Posix.PosixPath.Directory -- Copyright : © 2020 Julian Ospald -- License : BSD3 -- @@ -25,12 +25,13 @@ -- unreliable/unsafe. Check the documentation of those functions for details. -- -- Import as: --- > import System.Posix.RawFilePath.Directory +-- > import System.Posix.PosixPath.Directory {-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-} -- streamly -module System.Posix.RawFilePath.Directory +module System.Posix.PosixPath.Directory ( -- * Types FileType(..) @@ -46,9 +47,6 @@ module System.Posix.RawFilePath.Directory , deleteDir , deleteDirRecursive , easyDelete - -- * File opening - , openFile - , executeFile -- * File creation , createRegularFile , createDir @@ -58,14 +56,28 @@ module System.Posix.RawFilePath.Directory -- * File renaming/moving , renameFile , moveFile - -- * File reading - , readFile - , readFileStrict - , readFileStream + -- * File opening + , openFile + , openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' -- * File writing , writeFile - , writeFileL + , writeFile' + , writeExistingFile + , writeExistingFile' , appendFile + , appendFile' + , appendExistingFile + , appendExistingFile' + -- * File reading + , readFile + , readFile' + , readExistingFile + , readExistingFile' + , readSymbolicLink -- * File permissions , newFilePerms , newDirPerms @@ -83,8 +95,14 @@ module System.Posix.RawFilePath.Directory , setModificationTimeHiRes -- * Directory reading , getDirsFiles + , getDirsFilesRec , getDirsFiles' + , getDirsFilesRec' , getDirsFilesStream + , getDirsFilesStreamRec + -- * CWD + , getCurrentDirectory + , setCurrentDirectory -- * Filetype operations , getFileType -- * Others @@ -94,14 +112,13 @@ module System.Posix.RawFilePath.Directory where +import System.File.PlatformPath import Control.Exception.Safe ( IOException , MonadCatch , MonadMask , bracket - , bracketOnError , onException , throwIO - , finally ) #if MIN_VERSION_base(4,9,0) import qualified Control.Monad.Fail as Fail @@ -109,16 +126,13 @@ import qualified Control.Monad.Fail as Fail import qualified Control.Monad as Fail #endif import Control.Monad ( unless - , void , when ) import Control.Monad.IfElse ( unlessM ) -import Control.Monad.IO.Class ( liftIO ) import qualified Data.ByteString as BS -import Data.ByteString ( ByteString ) import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.UTF8 as UTF8 import Data.Foldable ( for_ ) +import Data.String import Data.IORef ( IORef , modifyIORef , newIORef @@ -127,9 +141,9 @@ import Data.IORef ( IORef import Data.Time.Clock import Data.Time.Clock.POSIX ( getPOSIXTime , posixSecondsToUTCTime + , utcTimeToPOSIXSeconds , POSIXTime ) -import Data.Word ( Word8 ) import Foreign.C.Error ( eEXIST , eNOENT , eNOTEMPTY @@ -141,40 +155,31 @@ import Prelude hiding ( appendFile , readFile , writeFile ) -import Streamly -import Streamly.External.ByteString -import qualified Streamly.External.ByteString.Lazy - as SL +import Streamly.Prelude ( SerialT, MonadAsync ) import qualified Streamly.External.Posix.DirStream as SD -import Streamly.Memory.Array import qualified Streamly.FileSystem.Handle as FH -import qualified Streamly.Internal.Data.Unfold as SU import qualified Streamly.Internal.FileSystem.Handle as IFH -#if MIN_VERSION_streamly(0,8,0) -import qualified Streamly.Internal.Data.Array.Stream.Foreign - as AS -#else -import qualified Streamly.Internal.Memory.ArrayStream - as AS -#endif +import qualified Streamly.Internal.Data.Stream.IsStream.Expand as SE import qualified Streamly.Prelude as S +import Control.Monad.IO.Class ( liftIO + ) import qualified System.IO as SIO import System.IO.Error ( catchIOError , ioeGetErrorType ) -import System.Posix.FilePath import System.Posix.ByteString ( exclusive ) -import System.Posix.RawFilePath.Directory.Errors -import System.Posix.Directory.ByteString +import System.Posix.PosixPath.Directory.Errors +import System.Posix.Directory.PosixPath ( createDirectory , closeDirStream , getWorkingDirectory , openDirStream , removeDirectory + , changeWorkingDirectory ) -import System.Posix.Files.ByteString ( createSymbolicLink +import System.Posix.Files.PosixString ( createSymbolicLink , fileAccess , fileMode , getFdStatus @@ -187,36 +192,33 @@ import System.Posix.Files.ByteString ( createSymbolicLink , ownerModes , ownerReadMode , ownerWriteMode - , readSymbolicLink , removeLink , rename , setFileMode , unionFileModes ) -import qualified System.Posix.Files.ByteString as PF -import qualified "unix" System.Posix.IO.ByteString +import qualified System.Posix.Files.PosixString as PF +import qualified System.Posix.IO.PosixString as SPI -import qualified "unix-bytestring" System.Posix.IO.ByteString - as SPB import System.Posix.FD ( openFd ) -import qualified System.Posix.RawFilePath.Directory.Traversals +import qualified System.Posix.PosixFilePath.Directory.Traversals as SPDT import qualified System.Posix.Foreign as SPDF -import qualified System.Posix.Process.ByteString - as SPP import System.Posix.Types ( FileMode - , ProcessID - , EpochTime ) import System.Posix.Time +import System.OsPath.Posix +import System.OsString.Internal.Types +import System.Directory.Types +import System.Directory.Errors - ------------- - --[ Types ]-- - ------------- + ---------------------------- + --[ Posix specific types ]-- + ---------------------------- data FileType = Directory @@ -230,29 +232,6 @@ data FileType = Directory --- |The error mode for recursive operations. --- --- On `FailEarly` the whole operation fails immediately if any of the --- recursive sub-operations fail, which is sort of the default --- for IO operations. --- --- On `CollectFailures` skips errors in the recursion and keeps on recursing. --- However all errors are collected in the `RecursiveFailure` error type, --- which is raised finally if there was any error. Also note that --- `RecursiveFailure` does not give any guarantees on the ordering --- of the collected exceptions. -data RecursiveErrorMode = FailEarly - | CollectFailures - - --- |The mode for copy and file moves. --- Overwrite mode is usually not very well defined, but is a convenience --- shortcut. -data CopyMode = Strict -- ^ fail if any target exists - | Overwrite -- ^ overwrite targets - - - -------------------- --[ File Copying ]-- @@ -309,8 +288,8 @@ data CopyMode = Strict -- ^ fail if any target exists -- Throws in `Strict` CopyMode only: -- -- - `AlreadyExists` if destination already exists -copyDirRecursive :: RawFilePath -- ^ source dir - -> RawFilePath -- ^ destination (parent dirs +copyDirRecursive :: PosixPath -- ^ source dir + -> PosixPath -- ^ destination (parent dirs -- are not automatically created) -> CopyMode -> RecursiveErrorMode @@ -326,17 +305,17 @@ copyDirRecursive fromp destdirp cm rm = do (throwIO . RecursiveFailure $ collectedExceptions) where #if MIN_VERSION_base(4,9,0) - basename :: Fail.MonadFail m => RawFilePath -> m RawFilePath + basename :: Fail.MonadFail m => PosixPath -> m PosixPath #else - basename :: Fail.Monad m => RawFilePath -> m RawFilePath + basename :: Fail.Monad m => PosixPath -> m PosixPath #endif basename x = let b = takeBaseName x - in if BS.null b then Fail.fail ("No base name" :: String) else pure b + in if b == mempty then Fail.fail ("No base name" :: String) else pure b go :: IORef [(RecursiveFailureHint, IOException)] - -> RawFilePath - -> RawFilePath + -> PosixPath + -> PosixPath -> IO () go ce from destdir = do @@ -344,12 +323,12 @@ copyDirRecursive fromp destdirp cm rm = do -- on failure -- get the contents of the source dir - contents <- handleIOE (ReadContentsFailed from destdir) ce [] $ do + contents <- handleIOE (ReadContentsFailed (OsString from) (OsString destdir)) ce [] $ do contents <- getDirsFiles from -- create the destination dir and -- only return contents if we succeed - handleIOE (CreateDirFailed from destdir) ce [] $ do + handleIOE (CreateDirFailed (OsString from) (OsString destdir)) ce [] $ do fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus from case cm of Strict -> createDirectory destdir fmode' @@ -369,11 +348,11 @@ copyDirRecursive fromp destdirp cm rm = do newdest <- (destdir ) <$> basename f case ftype of SymbolicLink -> - handleIOE (RecreateSymlinkFailed f newdest) ce () + handleIOE (RecreateSymlinkFailed (OsString f) (OsString newdest)) ce () $ recreateSymlink f newdest cm Directory -> go ce f newdest RegularFile -> - handleIOE (CopyFileFailed f newdest) ce () $ copyFile f newdest cm + handleIOE (CopyFileFailed (OsString f) (OsString newdest)) ce () $ copyFile f newdest cm _ -> return () -- helper to handle errors for both RecursiveErrorModes and return a @@ -417,8 +396,8 @@ copyDirRecursive fromp destdirp cm rm = do -- Notes: -- -- - calls `symlink` -recreateSymlink :: RawFilePath -- ^ the old symlink file - -> RawFilePath -- ^ destination file +recreateSymlink :: PosixPath -- ^ the old symlink file + -> PosixPath -- ^ destination file -> CopyMode -> IO () recreateSymlink symsource newsym cm = do @@ -471,8 +450,8 @@ recreateSymlink symsource newsym cm = do -- Throws in `Strict` mode only: -- -- - `AlreadyExists` if destination already exists -copyFile :: RawFilePath -- ^ source file - -> RawFilePath -- ^ destination file +copyFile :: PosixPath -- ^ source file + -> PosixPath -- ^ destination file -> CopyMode -> IO () copyFile from to cm = do @@ -485,7 +464,7 @@ copyFile from to cm = do ) (\(_, handle) -> SIO.hClose handle) $ \(fromFd, fH) -> do - sourceFileMode <- System.Posix.Files.ByteString.fileMode + sourceFileMode <- System.Posix.Files.PosixString.fileMode <$> getFdStatus fromFd let dflags = [ SPDF.oNofollow @@ -524,8 +503,8 @@ copyFile from to cm = do -- -- * examines filetypes explicitly -- * calls `copyDirRecursive` for directories -easyCopy :: RawFilePath - -> RawFilePath +easyCopy :: PosixPath + -> PosixPath -> CopyMode -> RecursiveErrorMode -> IO () @@ -556,7 +535,7 @@ easyCopy from to cm rm = do -- - `PermissionDenied` if the directory cannot be read -- -- Notes: calls `unlink` -deleteFile :: RawFilePath -> IO () +deleteFile :: PosixPath -> IO () deleteFile = removeLink @@ -571,7 +550,7 @@ deleteFile = removeLink -- - `PermissionDenied` if we can't open or write to parent directory -- -- Notes: calls `rmdir` -deleteDir :: RawFilePath -> IO () +deleteDir :: PosixPath -> IO () deleteDir = removeDirectory @@ -594,7 +573,7 @@ deleteDir = removeDirectory -- - `InappropriateType` for wrong file type (regular file) -- - `NoSuchThing` if directory does not exist -- - `PermissionDenied` if we can't open or write to parent directory -deleteDirRecursive :: RawFilePath -> IO () +deleteDirRecursive :: PosixPath -> IO () deleteDirRecursive p = catchErrno [eNOTEMPTY, eEXIST] (deleteDir p) $ do files <- getDirsFiles p for_ files $ \file -> do @@ -616,7 +595,7 @@ deleteDirRecursive p = catchErrno [eNOTEMPTY, eEXIST] (deleteDir p) $ do -- -- * examines filetypes explicitly -- * calls `deleteDirRecursive` for directories -easyDelete :: RawFilePath -> IO () +easyDelete :: PosixPath -> IO () easyDelete p = do ftype <- getFileType p case ftype of @@ -626,26 +605,36 @@ easyDelete p = do _ -> return () + ------------------ + --[ File Write ]-- + ------------------ +appendExistingFile :: PosixPath -> L.ByteString -> IO () +appendExistingFile fp contents = withExistingFile fp SIO.AppendMode (`L.hPut` contents) - -------------------- - --[ File Opening ]-- - -------------------- +appendExistingFile' :: PosixPath -> BS.ByteString -> IO () +appendExistingFile' fp contents = withExistingFile fp SIO.AppendMode (`BS.hPut` contents) --- |Opens a file appropriately by invoking xdg-open. The file type --- is not checked. This forks a process. -openFile :: RawFilePath -> IO ProcessID -openFile fp = SPP.forkProcess - $ SPP.executeFile (UTF8.fromString "xdg-open") True [fp] Nothing +writeExistingFile :: PosixPath -> L.ByteString -> IO () +writeExistingFile fp contents = withExistingFile fp SIO.WriteMode (`L.hPut` contents) +writeExistingFile' :: PosixPath -> BS.ByteString -> IO () +writeExistingFile' fp contents = withExistingFile fp SIO.WriteMode (`BS.hPut` contents) --- |Executes a program with the given arguments. This forks a process. -executeFile :: RawFilePath -- ^ program - -> [ByteString] -- ^ arguments - -> IO ProcessID -executeFile fp args = SPP.forkProcess $ SPP.executeFile fp True args Nothing + -------------------- + --[ File Reading ]-- + -------------------- +readExistingFile :: PosixPath -> IO L.ByteString +readExistingFile fp = withExistingFile' fp SIO.ReadMode L.hGetContents + +readExistingFile' :: PosixPath -> IO BS.ByteString +readExistingFile' fp = withExistingFile fp SIO.ReadMode BS.hGetContents + +-- | Read the target of a symbolic link. +readSymbolicLink :: PosixPath -> IO PosixString +readSymbolicLink = PF.readSymbolicLink @@ -663,12 +652,11 @@ executeFile fp args = SPP.forkProcess $ SPP.executeFile fp True args Nothing -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createRegularFile :: FileMode -> RawFilePath -> IO () +createRegularFile :: FileMode -> PosixPath -> IO () createRegularFile fm destBS = bracket (SPI.openFd destBS SPI.WriteOnly - (Just fm) - (SPI.defaultFileFlags { exclusive = True }) + (SPI.defaultFileFlags { exclusive = True, SPI.creat = Just fm }) ) SPI.closeFd (\_ -> return ()) @@ -682,7 +670,7 @@ createRegularFile fm destBS = bracket -- - `AlreadyExists` if destination already exists -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDir :: FileMode -> RawFilePath -> IO () +createDir :: FileMode -> PosixPath -> IO () createDir fm destBS = createDirectory destBS fm -- |Create an empty directory at the given directory with the given filename. @@ -692,7 +680,7 @@ createDir fm destBS = createDirectory destBS fm -- - `PermissionDenied` if output directory cannot be written to -- - `NoSuchThing` if any of the parent components of the path -- do not exist -createDirIfMissing :: FileMode -> RawFilePath -> IO () +createDirIfMissing :: FileMode -> PosixPath -> IO () createDirIfMissing fm destBS = hideError AlreadyExists $ createDirectory destBS fm @@ -715,10 +703,10 @@ createDirIfMissing fm destBS = -- exist and cannot be written to -- - `AlreadyExists` if destination already exists and -- is *not* a directory -createDirRecursive :: FileMode -> RawFilePath -> IO () +createDirRecursive :: FileMode -> PosixPath -> IO () createDirRecursive fm p = go p where - go :: RawFilePath -> IO () + go :: PosixPath -> IO () go dest = do catchIOError (createDirectory dest fm) $ \e -> do errno <- getErrno @@ -743,8 +731,8 @@ createDirRecursive fm p = go p -- do not exist -- -- Note: calls `symlink` -createSymlink :: RawFilePath -- ^ destination file - -> RawFilePath -- ^ path the symlink points to +createSymlink :: PosixPath -- ^ destination file + -> PosixPath -- ^ path the symlink points to -> IO () createSymlink destBS sympoint = createSymbolicLink sympoint destBS @@ -776,7 +764,7 @@ createSymlink destBS sympoint = createSymbolicLink sympoint destBS -- (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files) -renameFile :: RawFilePath -> RawFilePath -> IO () +renameFile :: PosixPath -> PosixPath -> IO () renameFile fromf tof = do throwSameFile fromf tof throwFileDoesExist tof @@ -815,8 +803,8 @@ renameFile fromf tof = do -- Notes: -- -- - calls `rename` (but does not allow to rename over existing files) -moveFile :: RawFilePath -- ^ file to move - -> RawFilePath -- ^ destination +moveFile :: PosixPath -- ^ file to move + -> PosixPath -- ^ destination -> CopyMode -> IO () moveFile from to cm = do @@ -848,123 +836,6 @@ moveFile from to cm = do - -------------------- - --[ File Reading ]-- - -------------------- - - --- |Read the given file lazily. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFile :: RawFilePath -> IO L.ByteString -readFile path = do - stream <- readFileStream path - SL.fromChunksIO stream - - --- |Read the given file strictly into memory. --- --- Symbolic links are followed. File must exist. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStrict :: RawFilePath -> IO BS.ByteString -readFileStrict path = do - stream <- readFileStream path - fromArray <$> AS.toArray stream - - --- | Open the given file as a filestream. Once the filestream --- exits, the filehandle is cleaned up. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -readFileStream :: RawFilePath -> IO (SerialT IO (Array Word8)) -readFileStream fp = do - fd <- openFd fp SPI.ReadOnly [] Nothing - handle <- SPI.fdToHandle fd - let stream = S.unfold (SU.finally SIO.hClose FH.readChunks) handle - pure stream - - - - - -------------------- - --[ File Writing ]-- - -------------------- - - --- |Write a given ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -writeFile :: RawFilePath - -> Maybe FileMode -- ^ if Nothing, file must exist - -> ByteString - -> IO () -writeFile fp fmode bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) - $ \fd -> void $ SPB.fdWrite fd bs - - --- |Write a given lazy ByteString to a file, truncating the file beforehand. --- Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist --- --- Note: uses streamly under the hood -writeFileL :: RawFilePath - -> Maybe FileMode -- ^ if Nothing, file must exist - -> L.ByteString - -> IO () -writeFileL fp fmode lbs = do - handle <- - bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) - $ SPI.fdToHandle - finally (streamlyCopy handle) (SIO.hClose handle) - where streamlyCopy tH = S.fold (FH.writeChunks tH) $ SL.toChunks lbs - - --- |Append a given ByteString to a file. --- The file must exist. Follows symlinks. --- --- Throws: --- --- - `InappropriateType` if file is not a regular file or a symlink --- - `PermissionDenied` if we cannot read the file or the directory --- containting it --- - `NoSuchThing` if the file does not exist -appendFile :: RawFilePath -> ByteString -> IO () -appendFile fp bs = - bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) (SPI.closeFd) - $ \fd -> void $ SPB.fdWrite fd bs - - ----------------------- @@ -975,7 +846,7 @@ appendFile fp bs = -- |Default permissions for a new file. newFilePerms :: FileMode newFilePerms = - ownerWriteMode + ownerWriteMode `unionFileModes` ownerReadMode `unionFileModes` groupWriteMode `unionFileModes` groupReadMode @@ -986,7 +857,7 @@ newFilePerms = -- |Default permissions for a new directory. newDirPerms :: FileMode newDirPerms = - ownerModes + ownerModes `unionFileModes` groupExecuteMode `unionFileModes` groupReadMode `unionFileModes` otherExecuteMode @@ -1004,7 +875,7 @@ newDirPerms = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesExist :: RawFilePath -> IO Bool +doesExist :: PosixPath -> IO Bool doesExist bs = catchErrno [eNOENT] @@ -1019,7 +890,7 @@ doesExist bs = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesFileExist :: RawFilePath -> IO Bool +doesFileExist :: PosixPath -> IO Bool doesFileExist bs = catchErrno [eNOENT] @@ -1034,7 +905,7 @@ doesFileExist bs = -- Does not follow symlinks. -- -- Only eNOENT is catched (and returns False). -doesDirectoryExist :: RawFilePath -> IO Bool +doesDirectoryExist :: PosixPath -> IO Bool doesDirectoryExist bs = catchErrno [eNOENT] @@ -1052,7 +923,7 @@ doesDirectoryExist bs = -- Throws: -- -- - `NoSuchThing` if the file does not exist -isReadable :: RawFilePath -> IO Bool +isReadable :: PosixPath -> IO Bool isReadable bs = fileAccess bs True False False -- |Checks whether a file or folder is writable. @@ -1062,7 +933,7 @@ isReadable bs = fileAccess bs True False False -- Throws: -- -- - `NoSuchThing` if the file does not exist -isWritable :: RawFilePath -> IO Bool +isWritable :: PosixPath -> IO Bool isWritable bs = fileAccess bs False True False @@ -1073,14 +944,14 @@ isWritable bs = fileAccess bs False True False -- Throws: -- -- - `NoSuchThing` if the file does not exist -isExecutable :: RawFilePath -> IO Bool +isExecutable :: PosixPath -> IO Bool isExecutable bs = fileAccess bs False False True -- |Checks whether the directory at the given path exists and can be -- opened. This invokes `openDirStream` which follows symlinks. -canOpenDirectory :: RawFilePath -> IO Bool +canOpenDirectory :: PosixPath -> IO Bool canOpenDirectory bs = handleIOError (\_ -> return False) $ do bracket (openDirStream bs) closeDirStream (\_ -> return ()) return True @@ -1093,18 +964,18 @@ canOpenDirectory bs = handleIOError (\_ -> return False) $ do ------------------ -getModificationTime :: RawFilePath -> IO UTCTime +getModificationTime :: PosixPath -> IO UTCTime getModificationTime bs = do fs <- PF.getFileStatus bs pure $ posixSecondsToUTCTime $ PF.modificationTimeHiRes fs -setModificationTime :: RawFilePath -> EpochTime -> IO () +setModificationTime :: PosixPath -> UTCTime -> IO () setModificationTime bs t = do -- TODO: setFileTimes doesn't allow to pass NULL to utime ctime <- epochTime - PF.setFileTimes bs ctime t + PF.setFileTimes bs ctime (fromInteger . floor . utcTimeToPOSIXSeconds $ t) -setModificationTimeHiRes :: RawFilePath -> POSIXTime -> IO () +setModificationTimeHiRes :: PosixPath -> POSIXTime -> IO () setModificationTimeHiRes bs t = do -- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes ctime <- getPOSIXTime @@ -1129,30 +1000,69 @@ setModificationTimeHiRes bs t = do -- - `InappropriateType` if file type is wrong (symlink to file) -- - `InappropriateType` if file type is wrong (symlink to dir) -- - `PermissionDenied` if directory cannot be opened -getDirsFiles :: RawFilePath -- ^ dir to read - -> IO [RawFilePath] +getDirsFiles :: PosixPath -- ^ dir to read + -> IO [PosixPath] getDirsFiles p = do contents <- getDirsFiles' p pure $ fmap (p ) contents +getDirsFilesRec :: PosixPath -- ^ dir to read + -> IO [PosixPath] +getDirsFilesRec p = do + contents <- getDirsFilesRec' p + pure $ fmap (p ) contents + + -- | Like 'getDirsFiles', but returns the filename only, instead -- of prepending the base path. -getDirsFiles' :: RawFilePath -- ^ dir to read - -> IO [RawFilePath] +getDirsFiles' :: PosixPath -- ^ dir to read + -> IO [PosixPath] getDirsFiles' fp = getDirsFilesStream fp >>= S.toList +getDirsFilesRec' :: PosixPath -- ^ dir to read + -> IO [PosixPath] +getDirsFilesRec' fp = getDirsFilesStreamRec fp >>= S.toList + + +getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) + => PosixPath + -> IO (SerialT m PosixPath) +getDirsFilesStreamRec fp = do + stream <- getDirsFilesStream fp + pure $ S.concatMapM inner stream + where + inner f = do + let nextFile = fp f + isdir <- liftIO $ doesDirectoryExist nextFile + if isdir + then do + stream <- liftIO (getDirsFilesStreamRec nextFile) + pure $ SE.append (pure f) (fmap (f ) stream) + else pure (pure f) + + -- | Like 'getDirsFiles'', except returning a Stream. getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) - => RawFilePath - -> IO (SerialT m RawFilePath) + => PosixPath + -> IO (SerialT m PosixPath) getDirsFilesStream fp = do fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing ds <- SPDT.fdOpendir fd `onException` SPI.closeFd fd pure $ fmap snd $ SD.dirContentsStream ds + ----------- + --[ CWD ]-- + ----------- + +getCurrentDirectory :: IO PosixPath +getCurrentDirectory = getWorkingDirectory + +setCurrentDirectory :: PosixPath -> IO () +setCurrentDirectory = changeWorkingDirectory + --------------------------- @@ -1167,7 +1077,7 @@ getDirsFilesStream fp = do -- -- - `NoSuchThing` if the file does not exist -- - `PermissionDenied` if any part of the path is not accessible -getFileType :: RawFilePath -> IO FileType +getFileType :: PosixPath -> IO FileType getFileType fp = do fs <- PF.getSymbolicLinkStatus fp decide fs @@ -1195,7 +1105,7 @@ getFileType fp = do -- -- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the symlink is broken -canonicalizePath :: RawFilePath -> IO RawFilePath +canonicalizePath :: PosixPath -> IO PosixPath canonicalizePath = SPDT.realpath @@ -1204,10 +1114,22 @@ canonicalizePath = SPDT.realpath -- -- - if the path is already an absolute one, just return it -- - if it's a relative path, prepend the current directory to it -toAbs :: RawFilePath -> IO RawFilePath +toAbs :: PosixPath -> IO PosixPath toAbs bs = do case isAbsolute bs of True -> return bs False -> do cwd <- getWorkingDirectory return $ cwd bs + + +withExistingFile :: PosixPath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile fp iomode = bracket + (openExistingFile fp iomode) + SIO.hClose + +withExistingFile' :: PosixPath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile' fp iomode action = do + h <- openExistingFile fp iomode + action h + diff --git a/hpath-directory/src/System/Posix/PosixPath/Directory.hs-boot b/hpath-directory/src/System/Posix/PosixPath/Directory.hs-boot new file mode 100644 index 0000000..3681b34 --- /dev/null +++ b/hpath-directory/src/System/Posix/PosixPath/Directory.hs-boot @@ -0,0 +1,15 @@ +module System.Posix.PosixPath.Directory where + +import System.OsPath.Posix (PosixPath) + +canonicalizePath :: PosixPath -> IO PosixPath + +toAbs :: PosixPath -> IO PosixPath + +doesFileExist :: PosixPath -> IO Bool + +doesDirectoryExist :: PosixPath -> IO Bool + +isWritable :: PosixPath -> IO Bool + +canOpenDirectory :: PosixPath -> IO Bool diff --git a/hpath-directory/src/System/Posix/PosixPath/Directory/Errors.hs b/hpath-directory/src/System/Posix/PosixPath/Directory/Errors.hs new file mode 100644 index 0000000..1e69955 --- /dev/null +++ b/hpath-directory/src/System/Posix/PosixPath/Directory/Errors.hs @@ -0,0 +1,227 @@ +-- | +-- Module : System.Posix.PosixPath.Directory.Errors +-- Copyright : © 2016 Julian Ospald +-- License : BSD3 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- Provides error handling. + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiWayIf #-} + +module System.Posix.PosixPath.Directory.Errors + ( + -- * Types + HPathIOException(..) + , RecursiveFailureHint(..) + + -- * Path based functions + , throwFileDoesExist + , throwDirDoesExist + , throwSameFile + , sameFile + , throwDestinationInSource + + -- * Error handling functions + , catchErrno + , rethrowErrnoAs + ) + where + + +import Control.Exception.Safe +import Control.Monad + ( + forM + , when + ) +import Control.Monad.IfElse + ( + whenM + ) +import Data.List + ( + mapAccumL + ) +import Foreign.C.Error + ( + getErrno + , Errno + ) +import {-# SOURCE #-} System.Posix.PosixPath.Directory + ( + canonicalizePath + , toAbs + , doesFileExist + , doesDirectoryExist + ) +import System.IO.Error + ( + alreadyExistsErrorType + , mkIOError + ) +import System.Posix.Files.PosixString + ( + getFileStatus + ) +import qualified System.Posix.Files.PosixString as PF +import System.OsPath.Posix +import qualified System.OsPath.Posix.Internal as Raw +import qualified System.OsString.Internal.Types as Raw +import qualified System.OsPath.Data.ByteString.Short as BS +import System.Directory.Types +import System.OsString.Internal.Types + + + + + + + + + + + + ---------------------------- + --[ Path based functions ]-- + ---------------------------- + + +-- |Throws `AlreadyExists` `IOError` if file exists. +throwFileDoesExist :: PosixPath -> IO () +throwFileDoesExist bs = do + locstr <- decodeFS bs + whenM (doesFileExist bs) + (ioError . mkIOError + alreadyExistsErrorType + "File already exists" + Nothing + $ (Just locstr) + ) + + +-- |Throws `AlreadyExists` `IOError` if directory exists. +throwDirDoesExist :: PosixPath -> IO () +throwDirDoesExist bs = do + locstr <- decodeFS bs + whenM (doesDirectoryExist bs) + (ioError . mkIOError + alreadyExistsErrorType + "Directory already exists" + Nothing + $ (Just locstr) + ) + + +-- |Uses `isSameFile` and throws `SameFile` if it returns True. +throwSameFile :: PosixPath + -> PosixPath + -> IO () +throwSameFile bs1 bs2 = + whenM (sameFile bs1 bs2) + (throwIO $ SameFile (OsString bs1) (OsString bs2)) + + +-- |Check if the files are the same by examining device and file id. +-- This follows symbolic links. +sameFile :: PosixPath -> PosixPath -> IO Bool +sameFile fp1 fp2 = + handleIOError (\_ -> return False) $ do + fs1 <- getFileStatus fp1 + fs2 <- getFileStatus fp2 + + if ((PF.deviceID fs1, PF.fileID fs1) == + (PF.deviceID fs2, PF.fileID fs2)) + then return True + else return False + + +-- TODO: make this more robust when destination does not exist +-- |Checks whether the destination directory is contained +-- within the source directory by comparing the device+file ID of the +-- source directory with all device+file IDs of the parent directories +-- of the destination. +throwDestinationInSource :: PosixPath -- ^ source dir + -> PosixPath -- ^ full destination, @dirname dest@ + -- must exist + -> IO () +throwDestinationInSource sbs dbs = do + destAbs <- toAbs dbs + dest' <- (\x -> maybe x (\y -> x y) $ basename dbs) + <$> (canonicalizePath $ takeDirectory destAbs) + dids <- forM (takeAllParents dest') $ \p -> do + fs <- PF.getSymbolicLinkStatus p + return (PF.deviceID fs, PF.fileID fs) + sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) + $ PF.getFileStatus sbs + when (elem sid dids) + (throwIO $ DestinationInSource (OsString dbs) (OsString sbs)) + where + basename x = let b = takeBaseName x + in if b == mempty then Nothing else Just b + + takeAllParents :: PosixPath -> [PosixPath] + takeAllParents p = + let s = splitDirectories p + in fmap Raw.PS + . filterEmptyHead + . snd + . mapAccumL (\a b -> (if | BS.null a -> ( b + , a + ) + | BS.length a == 1 + , Raw.isPathSeparator (BS.head a) -> ( BS.singleton (Raw.unPW pathSeparator) <> b + , BS.singleton (Raw.unPW pathSeparator) + ) + | otherwise -> (a <> BS.singleton (Raw.unPW pathSeparator) <> b + , a + ) + ) + ) mempty + . fmap Raw.unPS + $ s + where + filterEmptyHead :: [BS.ShortByteString] -> [BS.ShortByteString] + filterEmptyHead [] = [] + filterEmptyHead (a:as) + | BS.null a = as + | otherwise = (a:as) + + + + + -------------------------------- + --[ Error handling functions ]-- + -------------------------------- + + +-- |Carries out an action, then checks if there is an IOException and +-- a specific errno. If so, then it carries out another action, otherwise +-- it rethrows the error. +catchErrno :: [Errno] -- ^ errno to catch + -> IO a -- ^ action to try, which can raise an IOException + -> IO a -- ^ action to carry out in case of an IOException and + -- if errno matches + -> IO a +catchErrno en a1 a2 = + catchIOError a1 $ \e -> do + errno <- getErrno + if errno `elem` en + then a2 + else ioError e + + +-- |Execute the given action and retrow IO exceptions as a new Exception +-- that have the given errno. If errno does not match the exception is rethrown +-- as is. +rethrowErrnoAs :: Exception e + => [Errno] -- ^ errno to catch + -> e -- ^ rethrow as if errno matches + -> IO a -- ^ action to try + -> IO a +rethrowErrnoAs en fmex action = catchErrno en action (throwIO fmex) + diff --git a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot b/hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot deleted file mode 100644 index e3ac884..0000000 --- a/hpath-directory/src/System/Posix/RawFilePath/Directory.hs-boot +++ /dev/null @@ -1,15 +0,0 @@ -module System.Posix.RawFilePath.Directory where - -import System.Posix.ByteString.FilePath (RawFilePath) - -canonicalizePath :: RawFilePath -> IO RawFilePath - -toAbs :: RawFilePath -> IO RawFilePath - -doesFileExist :: RawFilePath -> IO Bool - -doesDirectoryExist :: RawFilePath -> IO Bool - -isWritable :: RawFilePath -> IO Bool - -canOpenDirectory :: RawFilePath -> IO Bool diff --git a/hpath-directory/src/System/Posix/RawFilePath/Directory/Errors.hs b/hpath-directory/src/System/Posix/RawFilePath/Directory/Errors.hs deleted file mode 100644 index 20d0862..0000000 --- a/hpath-directory/src/System/Posix/RawFilePath/Directory/Errors.hs +++ /dev/null @@ -1,327 +0,0 @@ --- | --- Module : System.Posix.RawFilePath.Directory.Errors --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- Provides error handling. - -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module System.Posix.RawFilePath.Directory.Errors - ( - -- * Types - HPathIOException(..) - , RecursiveFailureHint(..) - - -- * Exception identifiers - , isSameFile - , isDestinationInSource - , isRecursiveFailure - , isReadContentsFailed - , isCreateDirFailed - , isCopyFileFailed - , isRecreateSymlinkFailed - - -- * Path based functions - , throwFileDoesExist - , throwDirDoesExist - , throwSameFile - , sameFile - , throwDestinationInSource - - -- * Error handling functions - , catchErrno - , rethrowErrnoAs - , handleIOError - , hideError - , bracketeer - , reactOnError - ) - where - - -import Control.Applicative - ( - (<$>) - ) -import Control.Exception.Safe hiding (handleIOError) -import Control.Monad - ( - forM - , when - ) -import Control.Monad.IfElse - ( - whenM - ) -import Data.ByteString - ( - ByteString - ) -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 - ( - toString - ) -import Data.Typeable - ( - Typeable - ) -import Foreign.C.Error - ( - getErrno - , Errno - ) -import GHC.IO.Exception - ( - IOErrorType - ) -import {-# SOURCE #-} System.Posix.RawFilePath.Directory - ( - canonicalizePath - , toAbs - , doesFileExist - , doesDirectoryExist - , isWritable - , canOpenDirectory - ) -import System.IO.Error - ( - alreadyExistsErrorType - , ioeGetErrorType - , mkIOError - ) -import System.Posix.FilePath -import qualified System.Posix.Directory.ByteString as PFD -import System.Posix.Files.ByteString - ( - fileAccess - , getFileStatus - ) -import qualified System.Posix.Files.ByteString as PF - - --- |Additional generic IO exceptions that the posix functions --- do not provide. -data HPathIOException = SameFile ByteString ByteString - | DestinationInSource ByteString ByteString - | RecursiveFailure [(RecursiveFailureHint, IOException)] - deriving (Eq, Show, Typeable) - - --- |A type for giving failure hints on recursive failure, which allows --- to programmatically make choices without examining --- the weakly typed I/O error attributes (like `ioeGetFileName`). --- --- The first argument to the data constructor is always the --- source and the second the destination. -data RecursiveFailureHint = ReadContentsFailed ByteString ByteString - | CreateDirFailed ByteString ByteString - | CopyFileFailed ByteString ByteString - | RecreateSymlinkFailed ByteString ByteString - deriving (Eq, Show) - - -instance Exception HPathIOException - - -toConstr :: HPathIOException -> String -toConstr SameFile {} = "SameFile" -toConstr DestinationInSource {} = "DestinationInSource" -toConstr RecursiveFailure {} = "RecursiveFailure" - - - - - - ----------------------------- - --[ Exception identifiers ]-- - ----------------------------- - - -isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool -isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty) -isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty) -isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty) - - -isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool -isReadContentsFailed ReadContentsFailed{} = True -isReadContentsFailed _ = False -isCreateDirFailed CreateDirFailed{} = True -isCreateDirFailed _ = False -isCopyFileFailed CopyFileFailed{} = True -isCopyFileFailed _ = False -isRecreateSymlinkFailed RecreateSymlinkFailed{} = True -isRecreateSymlinkFailed _ = False - - - - - - ---------------------------- - --[ Path based functions ]-- - ---------------------------- - - --- |Throws `AlreadyExists` `IOError` if file exists. -throwFileDoesExist :: RawFilePath -> IO () -throwFileDoesExist bs = - whenM (doesFileExist bs) - (ioError . mkIOError - alreadyExistsErrorType - "File already exists" - Nothing - $ (Just (toString $ bs)) - ) - - --- |Throws `AlreadyExists` `IOError` if directory exists. -throwDirDoesExist :: RawFilePath -> IO () -throwDirDoesExist bs = - whenM (doesDirectoryExist bs) - (ioError . mkIOError - alreadyExistsErrorType - "Directory already exists" - Nothing - $ (Just (toString $ bs)) - ) - - --- |Uses `isSameFile` and throws `SameFile` if it returns True. -throwSameFile :: RawFilePath - -> RawFilePath - -> IO () -throwSameFile bs1 bs2 = - whenM (sameFile bs1 bs2) - (throwIO $ SameFile bs1 bs2) - - --- |Check if the files are the same by examining device and file id. --- This follows symbolic links. -sameFile :: RawFilePath -> RawFilePath -> IO Bool -sameFile fp1 fp2 = - handleIOError (\_ -> return False) $ do - fs1 <- getFileStatus fp1 - fs2 <- getFileStatus fp2 - - if ((PF.deviceID fs1, PF.fileID fs1) == - (PF.deviceID fs2, PF.fileID fs2)) - then return True - else return False - - --- TODO: make this more robust when destination does not exist --- |Checks whether the destination directory is contained --- within the source directory by comparing the device+file ID of the --- source directory with all device+file IDs of the parent directories --- of the destination. -throwDestinationInSource :: RawFilePath -- ^ source dir - -> RawFilePath -- ^ full destination, @dirname dest@ - -- must exist - -> IO () -throwDestinationInSource sbs dbs = do - destAbs <- toAbs dbs - dest' <- (\x -> maybe x (\y -> x y) $ basename dbs) - <$> (canonicalizePath $ takeDirectory destAbs) - dids <- forM (takeAllParents dest') $ \p -> do - fs <- PF.getSymbolicLinkStatus p - return (PF.deviceID fs, PF.fileID fs) - sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) - $ PF.getFileStatus sbs - when (elem sid dids) - (throwIO $ DestinationInSource dbs sbs) - where - basename x = let b = takeBaseName x - in if BS.null b then Nothing else Just b - - - - -------------------------------- - --[ Error handling functions ]-- - -------------------------------- - - --- |Carries out an action, then checks if there is an IOException and --- a specific errno. If so, then it carries out another action, otherwise --- it rethrows the error. -catchErrno :: [Errno] -- ^ errno to catch - -> IO a -- ^ action to try, which can raise an IOException - -> IO a -- ^ action to carry out in case of an IOException and - -- if errno matches - -> IO a -catchErrno en a1 a2 = - catchIOError a1 $ \e -> do - errno <- getErrno - if errno `elem` en - then a2 - else ioError e - - --- |Execute the given action and retrow IO exceptions as a new Exception --- that have the given errno. If errno does not match the exception is rethrown --- as is. -rethrowErrnoAs :: Exception e - => [Errno] -- ^ errno to catch - -> e -- ^ rethrow as if errno matches - -> IO a -- ^ action to try - -> IO a -rethrowErrnoAs en fmex action = catchErrno en action (throwIO fmex) - - - --- |Like `catchIOError`, with arguments swapped. -handleIOError :: (IOError -> IO a) -> IO a -> IO a -handleIOError = flip catchIOError - - -hideError :: IOErrorType -> IO () -> IO () -hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e) - - --- |Like `bracket`, but allows to have different clean-up --- actions depending on whether the in-between computation --- has raised an exception or not. -bracketeer :: IO a -- ^ computation to run first - -> (a -> IO b) -- ^ computation to run last, when - -- no exception was raised - -> (a -> IO b) -- ^ computation to run last, - -- when an exception was raised - -> (a -> IO c) -- ^ computation to run in-between - -> IO c -bracketeer before after afterEx thing = - mask $ \restore -> do - a <- before - r <- restore (thing a) `onException` afterEx a - _ <- after a - return r - - -reactOnError :: IO a - -> [(IOErrorType, IO a)] -- ^ reaction on IO errors - -> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException - -> IO a -reactOnError a ios fmios = - a `catches` [iohandler, fmiohandler] - where - iohandler = Handler $ - \(ex :: IOException) -> - foldr (\(t, a') y -> if ioeGetErrorType ex == t - then a' - else y) - (throwIO ex) - ios - fmiohandler = Handler $ - \(ex :: HPathIOException) -> - foldr (\(t, a') y -> if toConstr ex == toConstr t - then a' - else y) - (throwIO ex) - fmios - - diff --git a/hpath-directory/src/System/Win32/WindowsPath/Directory.hsc b/hpath-directory/src/System/Win32/WindowsPath/Directory.hsc new file mode 100644 index 0000000..8b02ed1 --- /dev/null +++ b/hpath-directory/src/System/Win32/WindowsPath/Directory.hsc @@ -0,0 +1,1207 @@ +-- | +-- Module : System.Win32.WindowsPath.Directory +-- Copyright : © 2020 Julian Ospald +-- License : BSD3 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- This module provides IO related file operations like +-- copy, delete, move and so on, similar to the 'directory' package. +-- +-- Some of these operations are due to their nature __not atomic__, which +-- means they may do multiple syscalls which form one context. Some +-- of them also have to examine the filetypes explicitly before the +-- syscalls, so a reasonable decision can be made. That means +-- the result is undefined if another process changes that context +-- while the non-atomic operation is still happening. However, where +-- possible, as few syscalls as possible are used and the underlying +-- exception handling is kept. +-- +-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket` +-- are ignored by some of the more high-level functions (like `easyCopy`). +-- For other functions (like `copyFile`), the behavior on these file types is +-- unreliable/unsafe. Check the documentation of those functions for details. +-- +-- Import as: +-- > import System.Win32.WindowsPath.Directory + +{-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} -- streamly + +module System.Win32.WindowsPath.Directory + ( + -- * Types + FileType(..) + , RecursiveErrorMode(..) + , CopyMode(..) + -- * File copying + , copyDirRecursive + , recreateSymlink + , copyFile + , easyCopy + -- * File deletion + , deleteFile + , deleteDir + , deleteDirRecursive + , easyDelete + -- * File creation + , createRegularFile + , createDir + , createDirIfMissing + , createDirRecursive + , createSymlink + -- * File renaming/moving + , renameFile + , moveFile + -- * File opening + , openFile + , openBinaryFile + , withFile + , withBinaryFile + , withFile' + , withBinaryFile' + -- * File writing + , writeFile + , writeFile' + , writeExistingFile + , writeExistingFile' + , appendFile + , appendFile' + , appendExistingFile + , appendExistingFile' + -- * File reading + , readFile + , readFile' + , readExistingFile + , readExistingFile' + , readSymbolicLink + -- * File permissions + , setWriteMode + , setFilePermissions + , newFilePerms + -- * File checks + , doesExist + , doesFileExist + , doesDirectoryExist + , isReadable + , isWritable + , isExecutable + , canOpenDirectory + -- * File times + , getModificationTime + , setModificationTime + , setModificationTimeHiRes + , windowsToPosixTime + , posixToWindowsTime + -- * Directory reading + , getDirsFiles + , getDirsFilesRec + , getDirsFiles' + , getDirsFilesRec' + , getDirsFilesStream + , getDirsFilesStreamRec + -- * CWD + , getCurrentDirectory + , setCurrentDirectory + -- * Filetype operations + , getFileType + -- * Others + , canonicalizePath + , toAbs + ) +where + +#include +#if defined(mingw32_HOST_OS) +##if defined(i386_HOST_ARCH) +## define WINAPI stdcall +##elif defined(x86_64_HOST_ARCH) +## define WINAPI ccall +##else +## error unknown architecture +##endif +#include +#include +#include +#include + +import System.File.PlatformPath +import Control.Exception.Safe ( IOException + , MonadCatch + , MonadMask + , bracket + , throwIO + , handleIO + ) +#if MIN_VERSION_base(4,9,0) +import qualified Control.Monad.Fail as Fail +#else +import qualified Control.Monad as Fail +#endif +import Control.Monad ( when + , forM + ) +import Control.Monad.IO.Class ( liftIO + , MonadIO + ) +import Control.Monad.IfElse ( unlessM ) +import Data.Foldable ( for_ ) +import Data.String +import Data.List.Split +import Data.IORef ( IORef + , modifyIORef + , newIORef + ) +import Data.Time.Clock +import Data.Time.Clock.POSIX ( posixSecondsToUTCTime + , utcTimeToPOSIXSeconds + , POSIXTime + ) +import GHC.IO.Exception ( IOErrorType(..) ) +import Prelude hiding ( appendFile + , readFile + , writeFile + ) +import Streamly.Prelude (MonadAsync, SerialT) + +import qualified Streamly.Internal.Data.Unfold as SU + +import qualified Streamly.Internal.Data.Stream.StreamD.Type + as D +import Streamly.Internal.Data.Unfold.Type +import qualified Streamly.Internal.Data.Stream.IsStream.Expand as SE +import qualified Streamly.Prelude as S + +import System.OsPath.Windows +import System.OsString.Internal.Types +import System.Directory.Types +import System.Directory.Errors +import Data.Bits +import qualified System.Win32 as Win32 +import qualified System.Win32.WindowsString.File as WS +import qualified System.Win32.WindowsString.Info as WS +import qualified System.Win32.WindowsString.SymbolicLink as WS +import Data.Maybe +import System.Environment +import Data.Char +import Foreign.Ptr +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Storable +import Foreign.C.Types +import System.OsPath.Data.ByteString.Short.Word16 (packCWStringLen, ShortByteString) +import qualified System.OsPath.Data.ByteString.Short.Word16 as W16 +import System.IO.Error +import Data.Void +import qualified Data.ByteString.Lazy as L +import qualified System.IO as SIO +import qualified Data.ByteString as BS + + + + + + ------------------------------ + --[ Windows specific types ]-- + ------------------------------ + + +data FileType = Directory + | DirectoryLink + | SymbolicLink + | File + deriving (Eq, Show) + + + +maxShareMode :: Win32.ShareMode +maxShareMode = + Win32.fILE_SHARE_DELETE .|. + Win32.fILE_SHARE_READ .|. + Win32.fILE_SHARE_WRITE + + + +data Win32_REPARSE_DATA_BUFFER + = Win32_MOUNT_POINT_REPARSE_DATA_BUFFER ShortByteString ShortByteString + -- ^ substituteName printName + | Win32_SYMLINK_REPARSE_DATA_BUFFER ShortByteString ShortByteString Bool + -- ^ substituteName printName isRelative + | Win32_GENERIC_REPARSE_DATA_BUFFER + + + -------------------- + --[ File Copying ]-- + -------------------- + + + +-- |Copies the contents of a directory recursively to the given destination, while preserving permissions. +-- Does not follow symbolic links. This behaves more or less like +-- the following, without descending into the destination if it +-- already exists: +-- +-- @ +-- cp -a \/source\/dir \/destination\/somedir +-- @ +-- +-- For directory contents, this will ignore any file type that is not +-- `RegularFile`, `SymbolicLink` or `Directory`. +-- +-- For `Overwrite` copy mode this does not prune destination directory +-- contents, so the destination might contain more files than the source after +-- the operation has completed. Permissions of existing directories are +-- fixed. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * examines filetypes explicitly +-- * an explicit check `throwDestinationInSource` is carried out for the +-- top directory for basic sanity, because otherwise we might end up +-- with an infinite copy loop... however, this operation is not +-- carried out recursively (because it's slow) +-- +-- Throws: +-- +-- - `NoSuchThing` if source directory does not exist +-- - `PermissionDenied` if source directory can't be opened +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- - `DestinationInSource` if destination is contained in source +-- (`HPathIOException`) +-- +-- Throws in `FailEarly` RecursiveErrorMode only: +-- +-- - `PermissionDenied` if output directory is not writable +-- - `InvalidArgument` if source directory is wrong type (symlink) +-- - `InappropriateType` if source directory is wrong type (regular file) +-- +-- Throws in `CollectFailures` RecursiveErrorMode only: +-- +-- - `RecursiveFailure` if any of the recursive operations that are not +-- part of the top-directory sanity-checks fail (`HPathIOException`) +-- +-- Throws in `Strict` CopyMode only: +-- +-- - `AlreadyExists` if destination already exists +copyDirRecursive :: WindowsPath -- ^ source dir + -> WindowsPath -- ^ destination (parent dirs + -- are not automatically created) + -> CopyMode + -> RecursiveErrorMode + -> IO () +copyDirRecursive fromp destdirp cm rm = do + ce <- newIORef [] + -- for performance, sanity checks are only done for the top dir + -- TODO + -- throwSameFile fromp destdirp + -- throwDestinationInSource fromp destdirp + go ce fromp destdirp + -- collectedExceptions <- readIORef ce + -- unless (null collectedExceptions) + -- (throwIO . RecursiveFailure $ collectedExceptions) + where +#if MIN_VERSION_base(4,9,0) + basename :: Fail.MonadFail m => WindowsPath -> m WindowsPath +#else + basename :: Fail.Monad m => WindowsPath -> m WindowsPath +#endif + basename x = + let b = takeFileName x + in if b == mempty then Fail.fail ("No base name" :: String) else pure b + + go :: IORef [(RecursiveFailureHint, IOException)] + -> WindowsPath + -> WindowsPath + -> IO () + go ce from destdir = do + + -- NOTE: order is important here, so we don't get empty directories + -- on failure + + -- get the contents of the source dir + contents <- handleIOE (ReadContentsFailed (OsString from) (OsString destdir)) ce [] $ do + contents <- getDirsFiles from + + -- create the destination dir and + -- only return contents if we succeed + handleIOE (CreateDirFailed (OsString from) (OsString destdir)) ce [] $ do + fmode' <- WS.getFileAttributes from + case cm of + Strict -> createDir destdir + Overwrite -> catchIOError (createDir destdir) $ \e -> + case ioeGetErrorType e of + AlreadyExists -> pure () + _ -> ioError e + WS.setFileAttributes destdir fmode' + return contents + + -- NOTE: we can't use `easyCopy` here, because we want to call `go` + -- recursively to skip the top-level sanity checks + + -- if reading the contents and creating the destination dir worked, + -- then copy the contents to the destination too + for_ contents $ \f -> do + ftype <- getFileType f + newdest <- (destdir ) <$> basename f + case ftype of + SymbolicLink -> + handleIOE (RecreateSymlinkFailed (OsString f) (OsString newdest)) ce () + $ recreateSymlink f newdest cm + DirectoryLink -> + handleIOE (RecreateSymlinkFailed (OsString f) (OsString newdest)) ce () + $ recreateSymlink f newdest cm + Directory -> go ce f newdest + File -> + handleIOE (CopyFileFailed (OsString f) (OsString newdest)) ce () $ copyFile f newdest cm + + -- helper to handle errors for both RecursiveErrorModes and return a + -- default value + handleIOE :: RecursiveFailureHint + -> IORef [(RecursiveFailureHint, IOException)] + -> a + -> IO a + -> IO a + handleIOE hint ce def = case rm of + FailEarly -> handleIOError throwIO + CollectFailures -> + handleIOError (\e -> modifyIORef ce ((hint, e) :) >> return def) + + +-- |Recreate a symlink. +-- +-- In `Overwrite` copy mode only files and empty directories are deleted. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is inherently non-atomic +-- +-- Throws: +-- +-- - `InvalidArgument` if source file is wrong type (not a symlink) +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +-- +-- Throws in `Overwrite` mode only: +-- +-- - `UnsatisfiedConstraints` if destination file is non-empty directory +recreateSymlink :: WindowsPath -- ^ the old symlink file + -> WindowsPath -- ^ destination file + -> CopyMode + -> IO () +recreateSymlink symsource newsym cm = do + isdirSource <- doesDirectoryExist symsource + sympoint <- readSymbolicLink symsource + case cm of + Strict -> return () + Overwrite -> do + writable <- do + e <- doesExist newsym + if e then isWritable newsym else pure False + isfile <- doesFileExist newsym + isdir <- doesDirectoryExist newsym + when (writable && isfile) (deleteFile newsym) + when (writable && isdir) (deleteDir newsym) + createSymlink newsym sympoint isdirSource + + +-- |Copies the given regular file to the given destination. +-- Neither follows symbolic links, nor accepts them. +-- For "copying" symbolic links, use `recreateSymlink` instead. +-- +-- Note that this is still sort of a low-level function and doesn't +-- examine file types. For a more high-level version, use `easyCopy` +-- instead. +-- +-- In `Overwrite` copy mode only overwrites actual files, not directories. +-- In `Strict` mode the destination file must not exist. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is not atomic +-- * when used on `CharacterDevice`, reads the "contents" and copies +-- them to a regular file, which might take indefinitely +-- * when used on `BlockDevice`, may either read the "contents" +-- and copy them to a regular file (potentially hanging indefinitely) +-- or may create a regular empty destination file +-- * when used on `NamedPipe`, will hang indefinitely +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `NoSuchThing` if source file is a a `Socket` +-- - `PermissionDenied` if output directory is not writable +-- - `PermissionDenied` if source directory can't be opened +-- - `InvalidArgument` if source file is wrong type (symlink or directory) +-- - `SameFile` if source and destination are the same file +-- (`HPathIOException`) +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +copyFile :: WindowsPath -- ^ source file + -> WindowsPath -- ^ destination file + -> CopyMode + -> IO () +copyFile from to cm = WS.copyFile from to (cm == Strict) + + +-- |Copies a regular file, directory or symbolic link. In case of a +-- symbolic link it is just recreated, even if it points to a directory. +-- Any other file type is ignored. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `copyDirRecursive` for directories +easyCopy :: WindowsPath + -> WindowsPath + -> CopyMode + -> RecursiveErrorMode + -> IO () +easyCopy from to cm rm = do + ftype <- getFileType from + case ftype of + SymbolicLink -> recreateSymlink from to cm + Directory -> copyDirRecursive from to cm rm + DirectoryLink -> recreateSymlink from to cm + File -> copyFile from to cm + + + + + + --------------------- + --[ File Deletion ]-- + --------------------- + + +-- |Deletes the given file. Raises `eISDIR` +-- if run on a directory. Does not follow symbolic links. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (directory) +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if the directory cannot be read +-- +-- Notes: calls `unlink` +deleteFile :: WindowsPath -> IO () +deleteFile = WS.deleteFile + + +-- |Deletes the given directory, which must be empty, never symlinks. +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `UnsatisfiedConstraints` if directory is not empty +-- - `PermissionDenied` if we can't open or write to parent directory +deleteDir :: WindowsPath -> IO () +deleteDir = WS.removeDirectory + + +-- |Deletes the given directory recursively. Does not follow symbolic +-- links. Tries `deleteDir` first before attemtping a recursive +-- deletion. +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- * examines filetypes explicitly +-- +-- Throws: +-- +-- - `InappropriateType` for wrong file type (symlink to directory) +-- - `InappropriateType` for wrong file type (regular file) +-- - `NoSuchThing` if directory does not exist +-- - `PermissionDenied` if we can't open or write to parent directory +deleteDirRecursive :: WindowsPath -> IO () +deleteDirRecursive p = catchIOError (deleteDir p) $ \e -> + case ioeGetErrorType e of + NoSuchThing -> rmRecursive p + UnsatisfiedConstraints -> rmRecursive p + _ -> throwIO e + where + rmRecursive fp = do + files <- getDirsFiles fp + for_ files $ \file -> do + ftype <- getFileType file + case ftype of + SymbolicLink -> deleteFile file + Directory -> deleteDirRecursive file + DirectoryLink -> deleteDirRecursive file + File -> deleteFile file + deleteDir fp + + +-- |Deletes a file, directory or symlink. +-- In case of directory, performs recursive deletion. In case of +-- a symlink, the symlink file is deleted. +-- +-- Safety/reliability concerns: +-- +-- * examines filetypes explicitly +-- * calls `deleteDirRecursive` for directories +easyDelete :: WindowsPath -> IO () +easyDelete p = do + ftype <- getFileType p + case ftype of + SymbolicLink -> deleteFile p + Directory -> deleteDirRecursive p + DirectoryLink -> deleteDirRecursive p + File -> deleteFile p + + + + ------------------ + --[ File Write ]-- + ------------------ + +appendExistingFile :: WindowsPath -> L.ByteString -> IO () +appendExistingFile fp contents = withExistingFile fp SIO.AppendMode (`L.hPut` contents) + +appendExistingFile' :: WindowsPath -> BS.ByteString -> IO () +appendExistingFile' fp contents = withExistingFile fp SIO.AppendMode (`BS.hPut` contents) + + +writeExistingFile :: WindowsPath -> L.ByteString -> IO () +writeExistingFile fp contents = withExistingFile fp SIO.WriteMode (`L.hPut` contents) + +writeExistingFile' :: WindowsPath -> BS.ByteString -> IO () +writeExistingFile' fp contents = withExistingFile fp SIO.WriteMode (`BS.hPut` contents) + + -------------------- + --[ File Reading ]-- + -------------------- + +readExistingFile :: WindowsPath -> IO L.ByteString +readExistingFile fp = withExistingFile' fp SIO.ReadMode L.hGetContents + +readExistingFile' :: WindowsPath -> IO BS.ByteString +readExistingFile' fp = withExistingFile fp SIO.ReadMode BS.hGetContents + + +foreign import WINAPI unsafe "windows.h DeviceIoControl" + c_DeviceIoControl + :: Win32.HANDLE + -> Win32.DWORD + -> Ptr a + -> Win32.DWORD + -> Ptr b + -> Win32.DWORD + -> Ptr Win32.DWORD + -> Ptr Void + -> IO Win32.BOOL + + +-- | Read the target of a symbolic link. +-- +-- This is mostly stolen from 'directory' package. +readSymbolicLink :: WindowsPath -> IO WindowsPath +readSymbolicLink path = WS <$> do + let open = WS.createFile path 0 maxShareMode Nothing Win32.oPEN_EXISTING + (Win32.fILE_FLAG_BACKUP_SEMANTICS .|. + win32_fILE_FLAG_OPEN_REPARSE_POINT) Nothing + bracket open Win32.closeHandle $ \ h -> do + win32_alloca_REPARSE_DATA_BUFFER $ \ ptrAndSize@(ptr, _) -> do + result <- deviceIoControl h win32_fSCTL_GET_REPARSE_POINT + (nullPtr, 0) ptrAndSize Nothing + case result of + Left e | e == (#const ERROR_INVALID_FUNCTION) -> do + let msg = "Incorrect function. The file system " <> + "might not support symbolic links." + throwIO (mkIOError illegalOperationErrorType + "DeviceIoControl" Nothing Nothing + `ioeSetErrorString` msg) + | otherwise -> Win32.failWith "DeviceIoControl" e + Right _ -> pure () + rData <- win32_peek_REPARSE_DATA_BUFFER ptr + strip <$> case rData of + Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn _ -> pure sn + Win32_SYMLINK_REPARSE_DATA_BUFFER sn _ _ -> pure sn + _ -> throwIO (mkIOError InappropriateType + "readSymbolicLink" Nothing Nothing) + where + strip sn = fromMaybe sn (W16.stripPrefix (fromString "\\??\\") sn) + + win32_iO_REPARSE_TAG_MOUNT_POINT, win32_iO_REPARSE_TAG_SYMLINK :: CULong + win32_iO_REPARSE_TAG_MOUNT_POINT = (#const IO_REPARSE_TAG_MOUNT_POINT) + win32_iO_REPARSE_TAG_SYMLINK = (#const IO_REPARSE_TAG_SYMLINK) + + win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE :: Win32.DWORD + win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE = + (#const MAXIMUM_REPARSE_DATA_BUFFER_SIZE) + + win32_sYMLINK_FLAG_RELATIVE :: CULong + win32_sYMLINK_FLAG_RELATIVE = 0x00000001 + + + win32_fILE_FLAG_OPEN_REPARSE_POINT :: Win32.FileAttributeOrFlag + win32_fILE_FLAG_OPEN_REPARSE_POINT = 0x00200000 + + win32_fSCTL_GET_REPARSE_POINT :: Win32.DWORD + win32_fSCTL_GET_REPARSE_POINT = 0x900a8 + + deviceIoControl + :: Win32.HANDLE + -> Win32.DWORD + -> (Ptr a, Int) + -> (Ptr b, Int) + -> Maybe Void + -> IO (Either Win32.ErrCode Int) + deviceIoControl h code (inPtr, inSize) (outPtr, outSize) _ = do + with 0 $ \ lenPtr -> do + ok <- c_DeviceIoControl h code inPtr (fromIntegral inSize) outPtr + (fromIntegral outSize) lenPtr nullPtr + if ok + then Right . fromIntegral <$> peek lenPtr + else Left <$> Win32.getLastError + + win32_alloca_REPARSE_DATA_BUFFER + :: ((Ptr Win32_REPARSE_DATA_BUFFER, Int) -> IO a) -> IO a + win32_alloca_REPARSE_DATA_BUFFER action = + allocaBytesAligned size align $ \ ptr -> + action (ptr, size) + where size = fromIntegral win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE + -- workaround (hsc2hs for GHC < 8.0 don't support #{alignment ...}) + align = #{size char[alignof(HsDirectory_REPARSE_DATA_BUFFER)]} + + win32_peek_REPARSE_DATA_BUFFER + :: Ptr Win32_REPARSE_DATA_BUFFER -> IO Win32_REPARSE_DATA_BUFFER + win32_peek_REPARSE_DATA_BUFFER p = do + tag <- #{peek HsDirectory_REPARSE_DATA_BUFFER, ReparseTag} p + case () of + _ | tag == win32_iO_REPARSE_TAG_MOUNT_POINT -> do + let buf = #{ptr HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PathBuffer} p + sni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.SubstituteNameOffset} p + sns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.SubstituteNameLength} p + sn <- peekName buf sni sns + pni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PrintNameOffset} p + pns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + MountPointReparseBuffer.PrintNameLength} p + pn <- peekName buf pni pns + pure (Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn pn) + | tag == win32_iO_REPARSE_TAG_SYMLINK -> do + let buf = #{ptr HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PathBuffer} p + sni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.SubstituteNameOffset} p + sns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.SubstituteNameLength} p + sn <- peekName buf sni sns + pni <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PrintNameOffset} p + pns <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.PrintNameLength} p + pn <- peekName buf pni pns + flags <- #{peek HsDirectory_REPARSE_DATA_BUFFER, + SymbolicLinkReparseBuffer.Flags} p + pure (Win32_SYMLINK_REPARSE_DATA_BUFFER sn pn + (flags .&. win32_sYMLINK_FLAG_RELATIVE /= 0)) + | otherwise -> pure Win32_GENERIC_REPARSE_DATA_BUFFER + where + peekName :: Ptr CWchar -> CUShort -> CUShort -> IO ShortByteString + peekName buf offset size = + packCWStringLen ( buf `plusPtr` fromIntegral offset + , fromIntegral size `div` sizeOf (0 :: CWchar) ) + + + + --------------------- + --[ File Creation ]-- + --------------------- + + +-- |Create an empty regular file at the given directory with the given +-- filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createRegularFile :: Win32.AccessMode -> WindowsPath -> IO () +createRegularFile mode fp = bracket open close (\_ -> return ()) + where + open = WS.createFile + fp + mode + maxShareMode + Nothing + Win32.cREATE_NEW + Win32.fILE_ATTRIBUTE_NORMAL + Nothing + close = Win32.closeHandle + + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createDir :: WindowsPath -> IO () +createDir = flip WS.createDirectory Nothing + + +-- |Create an empty directory at the given directory with the given filename. +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createDirIfMissing :: WindowsPath -> IO () +createDirIfMissing = hideError AlreadyExists . createDir + + + +-- |Create an empty directory at the given directory with the given filename. +-- All parent directories are created with the same filemode. This +-- basically behaves like: +-- +-- @ +-- mkdir -p \/some\/dir +-- @ +-- +-- Safety/reliability concerns: +-- +-- * not atomic +-- +-- Throws: +-- +-- - `PermissionDenied` if any part of the path components do not +-- exist and cannot be written to +-- - `AlreadyExists` if destination already exists and +-- is *not* a directory +createDirRecursive :: WindowsPath -> IO () +createDirRecursive p = go p + where + go :: WindowsPath -> IO () + go dest = do + catchIOError (createDir dest) $ \e -> do + case ioeGetErrorType e of + en + | en == alreadyExistsErrorType + -> unlessM (doesDirectoryExist dest) (ioError e) + | en == doesNotExistErrorType + -> go (takeDirectory $ dropTrailingPathSeparator dest) + >> createDir dest + | otherwise + -> ioError e + + +-- |Create a symlink. And tries to do so in unprivileged mode (needs developer mode activated). +-- +-- Throws: +-- +-- - `PermissionDenied` if output directory cannot be written to +-- - `AlreadyExists` if destination file already exists +-- - `NoSuchThing` if any of the parent components of the path +-- do not exist +createSymlink :: WindowsPath -- ^ destination file + -> WindowsPath -- ^ path the symlink points to + -> Bool -- ^ whether this is a directory + -> IO () +createSymlink destBS sympoint dir = + WS.createSymbolicLink' destBS sympoint ((if dir then Win32.sYMBOLIC_LINK_FLAG_DIRECTORY else Win32.sYMBOLIC_LINK_FLAG_FILE) .|. Win32.sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE) + + + + ---------------------------- + --[ File Renaming/Moving ]-- + ---------------------------- + + +-- |Rename a given file with the provided filename. Destination and source +-- must be on the same device. +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `UnsupportedOperation` if source and destination are on different +-- devices +-- - `AlreadyExists` if destination already exists +renameFile :: WindowsPath -> WindowsPath -> IO () +renameFile from to = + WS.moveFileEx from (Just to) 0 + + +-- |Move a file. This also works across devices by copy-delete fallback. +-- And also works on directories. +-- +-- Safety/reliability concerns: +-- +-- * `Overwrite` mode is not atomic +-- * copy-delete fallback is inherently non-atomic +-- +-- Throws: +-- +-- - `NoSuchThing` if source file does not exist +-- - `PermissionDenied` if output directory cannot be written to +-- - `PermissionDenied` if source directory cannot be opened +-- - `PermissionDenied` when moving one directory over another (even in Overwrite mode) +-- +-- Throws in `Strict` mode only: +-- +-- - `AlreadyExists` if destination already exists +moveFile :: WindowsPath -- ^ file to move + -> WindowsPath -- ^ destination + -> CopyMode + -> IO () +moveFile from to cm = do + let flag = case cm of + Strict -> Win32.mOVEFILE_COPY_ALLOWED + Overwrite -> Win32.mOVEFILE_COPY_ALLOWED .|. Win32.mOVEFILE_REPLACE_EXISTING + WS.moveFileEx from (Just to) flag + + + + + + ----------------------- + --[ File Permissions]-- + ----------------------- + + +setWriteMode :: Bool -> Win32.FileAttributeOrFlag -> Win32.FileAttributeOrFlag +setWriteMode False m = m .|. Win32.fILE_ATTRIBUTE_READONLY +setWriteMode True m = m .&. complement Win32.fILE_ATTRIBUTE_READONLY + + +-- | A restricted form of 'setFileMode' that only sets the permission bits. +-- For Windows, this means only the "read-only" attribute is affected. +setFilePermissions :: WindowsPath -> Win32.FileAttributeOrFlag -> IO () +setFilePermissions path m = do + m' <- Win32.bhfiFileAttributes <$> getFileMetadata path + WS.setFileAttributes path ((m' .&. complement Win32.fILE_ATTRIBUTE_READONLY) .|. + (m .&. Win32.fILE_ATTRIBUTE_READONLY)) + + +-- |Default permissions for a new file. +newFilePerms :: Win32.AccessMode +newFilePerms = Win32.gENERIC_READ .|. Win32.gENERIC_WRITE + + + + + ------------------- + --[ File checks ]-- + ------------------- + + +-- |Checks if the given file exists. +-- +-- Only NoSuchThing is catched (and returns False). +doesExist :: WindowsPath -> IO Bool +doesExist bs = + handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ + (const True) <$> getFileType bs + + +-- |Checks if the given file exists and is not a directory. +-- Does follow symlinks. +-- +-- Only NoSuchThing is catched (and returns False). +doesFileExist :: WindowsPath -> IO Bool +doesFileExist bs = + handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ + (\ft -> ft == File || ft == SymbolicLink) <$> getFileType bs + + + +-- |Checks if the given file exists and is a directory. +-- Does follow reparse points. +-- +-- Only NoSuchThing is catched (and returns False). +doesDirectoryExist :: WindowsPath -> IO Bool +doesDirectoryExist bs = + handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure False else ioError e) $ + (\ft -> ft == Directory || ft == DirectoryLink) <$> getFileType bs + + + +-- |Checks whether a file or folder is readable. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file or folder does not exist +isReadable :: WindowsPath -> IO Bool +isReadable bs = (const True) <$> getFileType bs + +-- |Checks whether a file or folder is writable. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file or folder does not exist +isWritable :: WindowsPath -> IO Bool +isWritable bs = do + fi <- getFileMetadata bs + pure (hasWriteMode (Win32.bhfiFileAttributes fi)) + where + hasWriteMode m = m .&. Win32.fILE_ATTRIBUTE_READONLY == 0 + + +-- |Checks whether a file is executable. Returns 'False' on directories. +-- +-- This looks up PATHEXT and compares the files extension with the list. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +isExecutable :: WindowsPath -> IO Bool +isExecutable bs = do + getFileType bs >>= \case + Directory -> pure False + DirectoryLink -> pure False + _ -> do + let ext = takeExtension bs + exeExts <- (fmap . fmap) toLower + . (wordsBy (==';')) + . fromMaybe "" + <$> lookupEnv "PATHEXT" + exeExts' <- forM exeExts encodeFS + pure $ ext `elem` exeExts' + + +-- |Checks whether the directory at the given path exists and can be +-- opened. Returns 'False' on non-directories. +canOpenDirectory :: WindowsPath -> IO Bool +canOpenDirectory bs = handleIOError (\_ -> return False) $ do + let query = bs pack [unsafeFromChar '*'] + bracket + (WS.findFirstFile query) + (\(h, _) -> Win32.findClose h) + (\_ -> return True) + + + + + ------------------ + --[ File times ]-- + ------------------ + + +getModificationTime :: WindowsPath -> IO UTCTime +getModificationTime bs = do + m <- getFileMetadata bs + pure $ posixSecondsToUTCTime $ windowsToPosixTime $ Win32.bhfiLastWriteTime m + +setModificationTime :: WindowsPath -> UTCTime -> IO () +setModificationTime fp t = + bracket (WS.createFile fp Win32.fILE_WRITE_ATTRIBUTES maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) Win32.closeHandle $ \h -> do + Win32.setFileTime h Nothing Nothing (Just . posixToWindowsTime . utcTimeToPOSIXSeconds $ t) + + +setModificationTimeHiRes :: WindowsPath -> Win32.FILETIME -> IO () +setModificationTimeHiRes fp t = + bracket (WS.createFile fp Win32.fILE_WRITE_ATTRIBUTES maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) Win32.closeHandle $ \h -> do + Win32.setFileTime h Nothing Nothing (Just t) + +-- https://docs.microsoft.com/en-us/windows/win32/api/minwinbase/ns-minwinbase-filetime +windowsToPosixTime :: Win32.FILETIME -> POSIXTime +windowsToPosixTime (Win32.FILETIME t) = + (fromIntegral t - 116444736000000000) / 10000000 + +posixToWindowsTime :: POSIXTime -> Win32.FILETIME +posixToWindowsTime t = Win32.FILETIME $ + truncate (t * 10000000 + 116444736000000000) + + + + ------------------------- + --[ Directory reading ]-- + ------------------------- + + +-- |Gets all filenames of the given directory. +-- +-- The contents are not sorted and there is no guarantee on the ordering. +-- +-- Throws: +-- +-- - `NoSuchThing` if directory does not exist +-- - `InappropriateType` if file type is wrong (file) +-- - `InappropriateType` if file type is wrong (symlink to file) +-- - `InappropriateType` if file type is wrong (symlink to dir) +-- - `PermissionDenied` if directory cannot be opened +getDirsFiles :: WindowsPath -- ^ dir to read + -> IO [WindowsPath] +getDirsFiles p = do + contents <- getDirsFiles' p + pure $ fmap (p ) contents + + +getDirsFilesRec :: WindowsPath -- ^ dir to read + -> IO [WindowsPath] +getDirsFilesRec p = do + contents <- getDirsFilesRec' p + pure $ fmap (p ) contents + + +-- | Like 'getDirsFiles', but returns the filename only, instead +-- of prepending the base path. +getDirsFiles' :: WindowsPath -- ^ dir to read + -> IO [WindowsPath] +getDirsFiles' fp = getDirsFilesStream fp >>= S.toList + + +getDirsFilesRec' :: WindowsPath -- ^ dir to read + -> IO [WindowsPath] +getDirsFilesRec' fp = getDirsFilesStreamRec fp >>= S.toList + + +getDirsFilesStreamRec :: (MonadCatch m, MonadAsync m, MonadMask m) + => WindowsPath + -> IO (SerialT m WindowsPath) +getDirsFilesStreamRec fp = do + stream <- getDirsFilesStream fp + pure $ S.concatMapM inner stream + where + inner f = do + let nextFile = fp f + isdir <- liftIO $ doesDirectoryExist nextFile + if isdir + then do + stream <- liftIO (getDirsFilesStreamRec nextFile) + pure $ SE.append (pure f) (fmap (f ) stream) + else pure (pure f) + + +-- | Like 'getDirsFiles'', except returning a Stream. +getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m) + => WindowsPath + -> IO (SerialT m WindowsPath) +getDirsFilesStream fp = do + let query = fp pack [unsafeFromChar '*'] + t <- WS.findFirstFile query + let stream = S.unfold (SU.finally (liftIO . Win32.findClose . fst) unfoldDirContents) $ (fmap Just t) + pure stream + where + unfoldDirContents :: MonadIO m => Unfold m (Win32.HANDLE, Maybe Win32.FindData) WindowsPath + unfoldDirContents = Unfold step return + where + {-# INLINE [0] step #-} + step (_, Nothing) = pure D.Stop + step (handle, Just fd) = do + filename <- liftIO $ WS.getFindDataFileName fd + more <- liftIO $ Win32.findNextFile handle fd + pure $ case () of + _ + | [unsafeFromChar '.'] == unpack filename -> D.Skip (handle, if more then Just fd else Nothing) + | [unsafeFromChar '.', unsafeFromChar '.'] == unpack filename -> D.Skip (handle, if more then Just fd else Nothing) + | otherwise -> D.Yield filename (handle, if more then Just fd else Nothing) + + + + ----------- + --[ CWD ]-- + ----------- + +getCurrentDirectory :: IO WindowsPath +getCurrentDirectory = WS.getCurrentDirectory + +setCurrentDirectory :: WindowsPath -> IO () +setCurrentDirectory = WS.setCurrentDirectory + + + + --------------------------- + --[ FileType operations ]-- + --------------------------- + +-- |Get the file type of the file located at the given path. Does +-- not follow symbolic links. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file does not exist +-- - `PermissionDenied` if any part of the path is not accessible +getFileType :: WindowsPath -> IO FileType +getFileType fp = do + fi <- getFileMetadata fp + pure $ decide fi + where + attrs fi = Win32.bhfiFileAttributes fi + isLink fi = attrs fi .&. Win32.fILE_ATTRIBUTE_REPARSE_POINT /= 0 + isDir fi = attrs fi .&. Win32.fILE_ATTRIBUTE_DIRECTORY /= 0 + decide fi | isLink fi && isDir fi = DirectoryLink + | isLink fi = SymbolicLink + | isDir fi = Directory + | otherwise = File + + +getFileMetadata :: WindowsPath -> IO Win32.BY_HANDLE_FILE_INFORMATION +getFileMetadata fp = do + bracket (WS.createFile fp 0 maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing) + Win32.closeHandle $ \h -> Win32.getFileInformationByHandle h + + + + -------------- + --[ Others ]-- + -------------- + + + +-- |Applies `GetFullPathName` on the given path. +-- +-- Throws: +-- +-- - `NoSuchThing` if the file at the given path does not exist +-- - `NoSuchThing` if the symlink is broken +canonicalizePath :: WindowsPath -> IO WindowsPath +canonicalizePath = WS.getFullPathName + + +-- |Converts any path to an absolute path. +-- This is done in the following way: +-- +-- - if the path is already an absolute one, just return it +-- - if it's a relative path, prepend the current directory to it +toAbs :: WindowsPath -> IO WindowsPath +toAbs bs = do + case isAbsolute bs of + True -> return bs + False -> do + cwd <- getCurrentDirectory + return $ cwd bs + + + +withExistingFile :: WindowsPath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile fp iomode = bracket + (openExistingFile fp iomode) + SIO.hClose + +withExistingFile' :: WindowsPath -> SIO.IOMode -> (SIO.Handle -> IO r) -> IO r +withExistingFile' fp iomode action = do + h <- openExistingFile fp iomode + action h + + +#endif diff --git a/hpath-directory/src/System/Win32/WindowsPath/utility.h b/hpath-directory/src/System/Win32/WindowsPath/utility.h new file mode 100644 index 0000000..2f37ef3 --- /dev/null +++ b/hpath-directory/src/System/Win32/WindowsPath/utility.h @@ -0,0 +1,6 @@ +#if !defined(alignof) && __cplusplus < 201103L +# ifdef STDC_HEADERS +# include +# endif +# define alignof(x) offsetof(struct { char c; x m; }, m) +#endif diff --git a/hpath-directory/src/System/Win32/WindowsPath/windows_ext.h b/hpath-directory/src/System/Win32/WindowsPath/windows_ext.h new file mode 100644 index 0000000..9c5de01 --- /dev/null +++ b/hpath-directory/src/System/Win32/WindowsPath/windows_ext.h @@ -0,0 +1,33 @@ +#ifndef HS_DIRECTORY_WINDOWS_EXT_H +#define HS_DIRECTORY_WINDOWS_EXT_H +#include + +// define prototype to get size, offsets, and alignments +// (can't include because that only exists in WDK) +typedef struct { + ULONG ReparseTag; + USHORT ReparseDataLength; + USHORT Reserved; + union { + struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + ULONG Flags; + WCHAR PathBuffer[1]; + } SymbolicLinkReparseBuffer; + struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + WCHAR PathBuffer[1]; + } MountPointReparseBuffer; + struct { + UCHAR DataBuffer[1]; + } GenericReparseBuffer; + }; +} HsDirectory_REPARSE_DATA_BUFFER; + +#endif diff --git a/hpath-directory/test/Main.hs b/hpath-directory/test/Main.hs index 7a71eac..81ffd50 100644 --- a/hpath-directory/test/Main.hs +++ b/hpath-directory/test/Main.hs @@ -1,16 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} -import qualified Data.ByteString as BS import Data.IORef import Test.Hspec import Test.Hspec.Runner import Test.Hspec.Formatters import qualified Spec import Utils -import System.Posix.Temp.ByteString (mkdtemp) -import System.Posix.Env.ByteString (getEnvDefault) -import System.Posix.FilePath (()) -import "hpath-directory" System.Posix.RawFilePath.Directory +#ifdef WINDOWS +import System.Win32.WindowsString.Info +#else +import System.Posix.Temp.PosixString (mkdtemp) +import System.Posix.Env.PosixString (getEnvDefault) +#endif +import System.Directory.OsPath +import System.OsPath +import System.OsString.Internal.Types -- TODO: chardev, blockdev, namedpipe, socket @@ -18,9 +23,14 @@ import "hpath-directory" System.Posix.RawFilePath.Directory main :: IO () main = do - tmpdir <- getEnvDefault "TMPDIR" "/tmp" >>= canonicalizePath - tmpBase <- mkdtemp (tmpdir "hpath-directory") - writeIORef baseTmpDir (Just (tmpBase `BS.append` "/")) +#ifdef WINDOWS + tmpBase <- fmap (( "hpath-directory") . OsString) getTemporaryDirectory + createDirRecursive tmpBase +#else + (OsString tmpdir) <- fmap ( "hpath-directory") (getEnvDefault "TMPDIR" "/tmp" >>= canonicalizePath . OsString) + tmpBase <- OsString <$> mkdtemp tmpdir +#endif + writeIORef baseTmpDir (Just (tmpBase <> "/")) putStrLn $ ("Temporary test directory at: " ++ show tmpBase) hspecWith defaultConfig { configFormatter = Just progress } diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/AppendFileSpec.hs b/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/AppendFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs index 0715e87..b5ae423 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/AppendFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/AppendFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.AppendFileSpec where +module System.Directory.AFP.AppendFileSpec where import Test.Hspec @@ -26,7 +26,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "fileWithContent" createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" + createSymlink' "inputFileSymL" "fileWithContent" False createDir' "alreadyExistsD" createRegularFile' "noPerms" noPerms "noPerms" @@ -51,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.appendFile" $ do + describe "System.Posix.PosixFilePath.Directory.appendFile" $ do -- successes -- it "appendFile file with content, everything clear" $ do @@ -104,5 +104,5 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "appendFile, file does not exist" $ do - appendFile' "gaga" "" + appendExistingFile' "gaga" "" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CanonicalizePathSpec.hs b/hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs similarity index 85% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CanonicalizePathSpec.hs rename to hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs index ae4cd93..94aa6a4 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CanonicalizePathSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CanonicalizePathSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CanonicalizePathSpec where +module System.Directory.AFP.CanonicalizePathSpec where import Test.Hspec @@ -26,9 +26,9 @@ setupFiles :: IO () setupFiles = do createRegularFile' "file" createDir' "dir" - createSymlink' "dirSym" "dir/" - createSymlink' "brokenSym" "nothing" - createSymlink' "fileSym" "file" + createSymlink' "dirSym" "dir/" True + createSymlink' "brokenSym" "nothing" False + createSymlink' "fileSym" "file" False cleanupFiles :: IO () cleanupFiles = do @@ -41,7 +41,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.canonicalizePath" $ do + describe "System.Posix.PosixFilePath.Directory.canonicalizePath" $ do -- successes -- it "canonicalizePath, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs similarity index 88% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs index 6086dd2..5abf75f 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveCollectFailuresSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveCollectFailuresSpec.hs @@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyDirRecursiveCollectFailuresSpec where +module System.Directory.AFP.CopyDirRecursiveCollectFailuresSpec where import Test.Hspec import Data.List (sort) -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') +import System.Directory.Errors import System.IO.Error ( ioeGetErrorType @@ -19,8 +19,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 (toString) +import System.OsPath @@ -33,7 +32,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" + createSymlink' "wrongInputSymL" "inputDir/" True createDir' "alreadyExistsD" createDir' "noPerms" createDir' "noWritePerm" @@ -116,18 +115,19 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.copyDirRecursive" $ do -- successes -- it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- decodeFS tmpDir' copyDirRecursive' "inputDir" "outputDir" Strict CollectFailures (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "outputDir" ++ " >/dev/null") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" @@ -166,9 +166,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ normalDirPerms "outputDir1/foo2/foo4/inputFile4" c <- allDirectoryContents' "outputDir1" tmpDir' <- getRawTmpDir - let shouldC = (fmap (\x -> tmpDir' `BS.append` x) - ["outputDir1" - ,"outputDir1/foo2" + let shouldC = (fmap (\x -> tmpDir' x) + ["outputDir1/foo2" ,"outputDir1/foo2/inputFile1" ,"outputDir1/foo2/inputFile2" ,"outputDir1/foo2/inputFile3" @@ -195,7 +194,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict CollectFailures `shouldThrow` - isRecursiveFailure + (\e -> case e of + RecursiveFailure{} -> True + _ -> False) it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $ copyDirRecursive' "inputDir" @@ -211,7 +212,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict CollectFailures `shouldThrow` - isRecursiveFailure + (\e -> case e of + RecursiveFailure{} -> True + _ -> False) it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $ copyDirRecursive' "wrongInput" @@ -235,7 +238,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict CollectFailures `shouldThrow` - isDestinationInSource + (\e -> case e of + DestinationInSource{} -> True + _ -> False) it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $ copyDirRecursive' "inputDir" @@ -243,6 +248,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict CollectFailures `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs similarity index 86% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs index 9a66a60..787d450 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveOverwriteSpec.hs @@ -1,12 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyDirRecursiveOverwriteSpec where +module System.Directory.AFP.CopyDirRecursiveOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -18,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import Data.ByteString.UTF8 (toString) +import System.OsPath @@ -32,7 +31,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" + createSymlink' "wrongInputSymL" "inputDir/" True createDir' "noPerms" createDir' "noWritePerm" @@ -88,7 +87,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.copyDirRecursive" $ do -- successes -- it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do @@ -100,22 +99,24 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- decodeFS tmpDir' copyDirRecursive' "inputDir" "outputDir" Overwrite FailEarly (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "outputDir" ++ " >/dev/null") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do tmpDir' <- getRawTmpDir + tmpDirS <- decodeFS tmpDir' (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "alreadyExistsD" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "alreadyExistsD" ++ " >/dev/null") `shouldReturn` (ExitFailure 1) copyDirRecursive' "inputDir" @@ -123,8 +124,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Overwrite FailEarly (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "alreadyExistsD" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "alreadyExistsD" ++ " >/dev/null") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" @@ -194,7 +195,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Overwrite FailEarly `shouldThrow` - isDestinationInSource + (\e -> case e of + DestinationInSource{} -> True + _ -> False) it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $ copyDirRecursive' "inputDir" @@ -202,4 +205,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Overwrite FailEarly `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs similarity index 89% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs index 6ab6526..b65c9c4 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyDirRecursiveSpec.hs @@ -1,12 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyDirRecursiveSpec where +module System.Directory.AFP.CopyDirRecursiveSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -18,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import Data.ByteString.UTF8 (toString) +import System.OsPath @@ -31,7 +30,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists" createRegularFile' "wrongInput" - createSymlink' "wrongInputSymL" "inputDir/" + createSymlink' "wrongInputSymL" "inputDir/" True createDir' "alreadyExistsD" createDir' "noPerms" createDir' "noWritePerm" @@ -73,7 +72,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.copyDirRecursive" $ do -- successes -- it "copyDirRecursive (Strict, FailEarly), all fine" $ do @@ -85,13 +84,14 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- decodeFS tmpDir' copyDirRecursive' "inputDir" "outputDir" Strict FailEarly (system $ "diff -r " - ++ toString tmpDir' ++ "inputDir" ++ " " - ++ toString tmpDir' ++ "outputDir" + ++ tmpDirS ++ "inputDir" ++ " " + ++ tmpDirS ++ "outputDir" ++ " >/dev/null") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" @@ -168,7 +168,12 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict FailEarly `shouldThrow` - isDestinationInSource + (\e -> case e of + DestinationInSource{} -> True + _ -> False) + + + it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $ copyDirRecursive' "inputDir" @@ -176,6 +181,9 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ Strict FailEarly `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) + diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs similarity index 85% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileOverwriteSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs index c19759b..488a8f3 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileOverwriteSpec.hs @@ -1,11 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyFileOverwriteSpec where +module System.Directory.AFP.CopyFileOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -17,7 +16,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import Data.ByteString.UTF8 (toString) +import System.OsPath @@ -31,7 +30,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "inputFile" createRegularFile' "alreadyExists" - createSymlink' "inputFileSymL" "inputFile" + createSymlink' "inputFileSymL" "inputFile" False createDir' "alreadyExistsD" createDir' "noPerms" createRegularFile' "noPerms/inputFile" @@ -59,7 +58,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyFile" $ do + describe "System.Posix.PosixFilePath.Directory.copyFile" $ do -- successes -- it "copyFile (Overwrite), everything clear" $ do @@ -70,10 +69,11 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Overwrite), output file already exists, all clear" $ do tmpDir' <- getRawTmpDir + tmpDirS <- decodeFS tmpDir' copyFile' "alreadyExists" "alreadyExists.bak" Strict copyFile' "inputFile" "alreadyExists" Overwrite - (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " - ++ toString tmpDir' ++ "alreadyExists") + (system $ "cmp -s " ++ tmpDirS ++ "inputFile" ++ " " + ++ tmpDirS ++ "alreadyExists") `shouldReturn` ExitSuccess removeFileIfExists "alreadyExists" copyFile' "alreadyExists.bak" "alreadyExists" Strict @@ -81,11 +81,12 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Overwrite), and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- decodeFS tmpDir' copyFile' "inputFile" "outputFile" Overwrite - (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " - ++ toString tmpDir' ++ "outputFile") + (system $ "cmp -s " ++ tmpDirS ++ "inputFile" ++ " " + ++ tmpDirS ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" @@ -145,4 +146,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ copyFile' "inputFile" "inputFile" Overwrite - `shouldThrow` isSameFile + `shouldThrow` + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileSpec.hs b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs similarity index 87% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs index abcbf7f..1cb598c 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CopyFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CopyFileSpec.hs @@ -1,12 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CopyFileSpec where +module System.Directory.AFP.CopyFileSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -18,7 +17,7 @@ import GHC.IO.Exception import System.Exit import System.Process import Utils -import Data.ByteString.UTF8 (toString) +import System.OsPath @@ -31,7 +30,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "inputFile" createRegularFile' "alreadyExists" - createSymlink' "inputFileSymL" "inputFile" + createSymlink' "inputFileSymL" "inputFile" False createDir' "alreadyExistsD" createDir' "noPerms" createRegularFile' "noPerms/inputFile" @@ -58,7 +57,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.copyFile" $ do + describe "System.Posix.PosixFilePath.Directory.copyFile" $ do -- successes -- it "copyFile (Strict), everything clear" $ do @@ -69,11 +68,12 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ it "copyFile (Strict), and compare" $ do tmpDir' <- getRawTmpDir + tmpDirS <- decodeFS tmpDir' copyFile' "inputFile" "outputFile" Strict - (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " - ++ toString tmpDir' ++ "outputFile") + (system $ "cmp -s " ++ tmpDirS ++ "inputFile" ++ " " + ++ tmpDirS ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" @@ -140,4 +140,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "inputFile" Strict `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) + diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirIfMissingSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateDirIfMissingSpec.hs similarity index 91% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirIfMissingSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateDirIfMissingSpec.hs index 2d80f98..7da2fba 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirIfMissingSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateDirIfMissingSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateDirIfMissingSpec where +module System.Directory.AFP.CreateDirIfMissingSpec where import Test.Hspec @@ -42,7 +42,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.CreateDirIfMissing" $ do + describe "System.Posix.PosixFilePath.Directory.CreateDirIfMissing" $ do -- successes -- it "createDirIfMissing, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateDirRecursiveSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirRecursiveSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateDirRecursiveSpec.hs index 60d6aa9..3dd7b12 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateDirRecursiveSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateDirRecursiveSpec where +module System.Directory.AFP.CreateDirRecursiveSpec where import Test.Hspec @@ -42,7 +42,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.createDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.createDirRecursive" $ do -- successes -- it "createDirRecursive, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateDirSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateDirSpec.hs index a3fb873..041eda9 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateDirSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateDirSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateDirSpec where +module System.Directory.AFP.CreateDirSpec where import Test.Hspec @@ -42,7 +42,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.createDir" $ do + describe "System.Posix.PosixFilePath.Directory.createDir" $ do -- successes -- it "createDir, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateRegularFileSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateRegularFileSpec.hs similarity index 91% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateRegularFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateRegularFileSpec.hs index 71af5c3..a390c78 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateRegularFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateRegularFileSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateRegularFileSpec where +module System.Directory.AFP.CreateRegularFileSpec where import Test.Hspec @@ -40,7 +40,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.createRegularFile" $ do + describe "System.Posix.PosixFilePath.Directory.createRegularFile" $ do -- successes -- it "createRegularFile, all fine" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs similarity index 78% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/CreateSymlinkSpec.hs rename to hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs index 3554829..001b4a5 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/CreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/CreateSymlinkSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.CreateSymlinkSpec where +module System.Directory.AFP.CreateSymlinkSpec where import Test.Hspec @@ -41,31 +41,31 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.createSymlink" $ do + describe "System.Posix.PosixFilePath.Directory.createSymlink" $ do -- successes -- it "createSymlink, all fine" $ do - createSymlink' "newSymL" "alreadyExists/" + createSymlink' "newSymL" "alreadyExists/" False removeFileIfExists "newSymL" -- posix failures -- it "createSymlink, parent directories do not exist" $ - createSymlink' "some/thing/dada" "lala" + createSymlink' "some/thing/dada" "lala" False `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) it "createSymlink, can't write to destination directory" $ - createSymlink' "noWritePerms/newDir" "lala" + createSymlink' "noWritePerms/newDir" "lala" True `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createSymlink, can't write to destination directory" $ - createSymlink' "noPerms/newDir" "lala" + createSymlink' "noPerms/newDir" "lala" True `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "createSymlink, destination file already exists" $ - createSymlink' "alreadyExists" "lala" + createSymlink' "alreadyExists" "lala" False `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirRecursiveSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs similarity index 85% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirRecursiveSpec.hs rename to hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs index 0759518..e65aaa5 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirRecursiveSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteDirRecursiveSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.DeleteDirRecursiveSpec where +module System.Directory.AFP.DeleteDirRecursiveSpec where import Test.Hspec @@ -8,10 +8,6 @@ import System.IO.Error ( ioeGetErrorType ) -import System.Posix.Files.ByteString - ( - getSymbolicLinkStatus - ) import GHC.IO.Exception ( IOErrorType(..) @@ -31,7 +27,7 @@ setupFiles = do createRegularFile' "file" createDir' "dir" createRegularFile' "dir/.keep" - createSymlink' "dirSym" "dir/" + createSymlink' "dirSym" "dir/" True createDir' "noPerms" createRegularFile' "noPerms/.keep" createDir' "noWritable" @@ -52,15 +48,13 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.deleteDirRecursive" $ do + describe "System.Posix.PosixFilePath.Directory.deleteDirRecursive" $ do -- successes -- it "deleteDirRecursive, empty directory, all fine" $ do createDir' "testDir" deleteDirRecursive' "testDir" - getSymbolicLinkStatus "testDir" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testDir" >>= (`shouldBe` False) it "deleteDirRecursive, empty directory with null permissions, all fine" $ do createDir' "noPerms/testDir" @@ -75,9 +69,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ createRegularFile' "nonEmpty/file1" createRegularFile' "nonEmpty/dir1/file2" deleteDirRecursive' "nonEmpty" - getSymbolicLinkStatus "nonEmpty" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "nonEmpty" >>= (`shouldBe` False) -- posix failures -- it "deleteDirRecursive, can't open parent directory" $ do diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs similarity index 84% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirSpec.hs rename to hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs index 245b874..3b48a33 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteDirSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteDirSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.DeleteDirSpec where +module System.Directory.AFP.DeleteDirSpec where import Test.Hspec @@ -8,10 +8,6 @@ import System.IO.Error ( ioeGetErrorType ) -import System.Posix.Files.ByteString - ( - getSymbolicLinkStatus - ) import GHC.IO.Exception ( IOErrorType(..) @@ -32,7 +28,7 @@ setupFiles = do createRegularFile' "file" createDir' "dir" createRegularFile' "dir/.keep" - createSymlink' "dirSym" "dir/" + createSymlink' "dirSym" "dir/" True createDir' "noPerms" createRegularFile' "noPerms/.keep" createDir' "noWritable" @@ -53,23 +49,19 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.deleteDir" $ do + describe "System.Posix.PosixFilePath.Directory.deleteDir" $ do -- successes -- it "deleteDir, empty directory, all fine" $ do createDir' "testDir" deleteDir' "testDir" - getSymbolicLinkStatus "testDir" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testDir" >>= (`shouldBe` False) it "deleteDir, directory with null permissions, all fine" $ do createDir' "noPerms/testDir" noPerms "noPerms/testDir" deleteDir' "noPerms/testDir" - getSymbolicLinkStatus "testDir" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testDir" >>= (`shouldBe` False) -- posix failures -- it "deleteDir, wrong file type (symlink to directory)" $ diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs similarity index 73% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs index 0a15e71..d3c6833 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/DeleteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/DeleteFileSpec.hs @@ -1,18 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.DeleteFileSpec where +module System.Directory.AFP.DeleteFileSpec where +import System.Directory.OsPath import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory import System.IO.Error ( ioeGetErrorType ) -import System.Posix.Files.ByteString - ( - getSymbolicLinkStatus - ) import GHC.IO.Exception ( IOErrorType(..) @@ -29,7 +25,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "foo" - createSymlink' "syml" "foo" + createSymlink' "syml" "foo" False createDir' "dir" createDir' "noPerms" noPerms "noPerms" @@ -47,24 +43,20 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.deleteFile" $ do + describe "System.Posix.PosixFilePath.Directory.deleteFile" $ do -- successes -- it "deleteFile, regular file, all fine" $ do createRegularFile' "testFile" deleteFile' "testFile" - getSymbolicLinkStatus "testFile" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testFile" >>= (`shouldBe` False) it "deleteFile, symlink, all fine" $ do recreateSymlink' "syml" "testFile" Strict deleteFile' "testFile" - getSymbolicLinkStatus "testFile" - `shouldThrow` - (\e -> ioeGetErrorType e == NoSuchThing) + dirExists "testFile" >>= (`shouldBe` False) -- posix failures -- it "deleteFile, wrong file type (directory)" $ diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/GetDirsFilesSpec.hs b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs similarity index 86% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/GetDirsFilesSpec.hs rename to hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs index 200b739..6668952 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/GetDirsFilesSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/GetDirsFilesSpec.hs @@ -1,14 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.GetDirsFilesSpec where +module System.Directory.AFP.GetDirsFilesSpec where import Data.List ( sort ) -import "hpath-directory" System.Posix.RawFilePath.Directory hiding (getDirsFiles') -import System.Posix.FilePath +import System.Directory.OsPath hiding (getDirsFiles') import Test.Hspec import System.IO.Error ( @@ -19,6 +18,7 @@ import GHC.IO.Exception IOErrorType(..) ) import Utils +import System.OsPath upTmpDir :: IO () @@ -32,9 +32,9 @@ setupFiles = do createRegularFile' "file" createRegularFile' "Lala" createRegularFile' ".hidden" - createSymlink' "syml" "Lala" + createSymlink' "syml" "Lala" False createDir' "dir" - createSymlink' "dirsym" "dir" + createSymlink' "dirsym" "dir" True createDir' "noPerms" noPerms "noPerms" @@ -54,7 +54,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.getDirsFiles" $ do + describe "System.Posix.PosixFilePath.Directory.getDirsFiles" $ do -- successes -- it "getDirsFiles, all fine" $ diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs similarity index 90% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileOverwriteSpec.hs rename to hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs index ad0f4ba..ae31996 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileOverwriteSpec.hs @@ -1,11 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.MoveFileOverwriteSpec where +module System.Directory.AFP.MoveFileOverwriteSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -27,7 +26,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createDir' "alreadyExistsD" createDir' "dir" createDir' "noPerms" @@ -52,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.moveFile" $ do + describe "System.Posix.PosixFilePath.Directory.moveFile" $ do -- successes -- it "moveFile (Overwrite), all fine" $ @@ -123,4 +122,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "myFile" Overwrite `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileSpec.hs b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs similarity index 90% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs index 66e239c..801282c 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/MoveFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/MoveFileSpec.hs @@ -1,11 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.MoveFileSpec where +module System.Directory.AFP.MoveFileSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -27,7 +26,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createRegularFile' "alreadyExists" createDir' "alreadyExistsD" createDir' "dir" @@ -54,7 +53,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.moveFile" $ do + describe "System.Posix.PosixFilePath.Directory.moveFile" $ do -- successes -- it "moveFile (Strict), all fine" $ @@ -126,4 +125,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "myFile" Strict `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) + diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/ReadFileSpec.hs b/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/ReadFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs index c6ce6e9..e2892e3 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/ReadFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/ReadFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.ReadFileSpec where +module System.Directory.AFP.ReadFileSpec where import Test.Hspec @@ -26,7 +26,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "fileWithContent" createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" + createSymlink' "inputFileSymL" "fileWithContent" False createDir' "alreadyExistsD" createRegularFile' "noPerms" noPerms "noPerms" @@ -51,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.readFile" $ do + describe "System.Posix.PosixFilePath.Directory.readFile" $ do -- successes -- it "readFile file with content, everything clear" $ do @@ -81,7 +81,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "readFile file, no such file" $ do - readFileL "lalala" + readExistingFileL "lalala" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) @@ -113,6 +113,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "readFile (Strict) file, no such file" $ do - readFile' "lalala" + readExistingFile' "lalala" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkOverwriteSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs similarity index 92% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkOverwriteSpec.hs rename to hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs index 85d289c..8d7ad35 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkOverwriteSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkOverwriteSpec.hs @@ -1,14 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.RecreateSymlinkOverwriteSpec where +module System.Directory.AFP.RecreateSymlinkOverwriteSpec where -- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -29,7 +28,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createRegularFile' "alreadyExists" createDir' "alreadyExistsD" createDir' "dir" @@ -59,7 +58,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.recreateSymlink" $ do + describe "System.Posix.PosixFilePath.Directory.recreateSymlink" $ do -- successes -- it "recreateSymLink (Overwrite), all fine" $ do @@ -135,5 +134,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "myFileL" Overwrite `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkSpec.hs b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs similarity index 91% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkSpec.hs rename to hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs index d51badf..de8e4ac 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/RecreateSymlinkSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RecreateSymlinkSpec.hs @@ -1,13 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.RecreateSymlinkSpec where +module System.Directory.AFP.RecreateSymlinkSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.OsPath hiding (writeFile') import System.IO.Error ( ioeGetErrorType @@ -29,7 +28,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createRegularFile' "alreadyExists" createDir' "alreadyExistsD" createDir' "dir" @@ -55,7 +54,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.recreateSymlink" $ do + describe "System.Posix.PosixFilePath.Directory.recreateSymlink" $ do -- successes -- it "recreateSymLink (Strict), all fine" $ do @@ -126,5 +125,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ "myFileL" Strict `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/RenameFileSpec.hs b/hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs similarity index 90% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/RenameFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs index e9af40b..62021e5 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/RenameFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/RenameFileSpec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.RenameFileSpec where +module System.Directory.AFP.RenameFileSpec where import Test.Hspec -import System.Posix.RawFilePath.Directory.Errors +import System.Directory.Types import System.IO.Error ( ioeGetErrorType @@ -26,7 +26,7 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "myFile" - createSymlink' "myFileL" "myFile" + createSymlink' "myFileL" "myFile" False createRegularFile' "alreadyExists" createDir' "alreadyExistsD" createDir' "dir" @@ -52,7 +52,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.renameFile" $ do + describe "System.Posix.PosixFilePath.Directory.renameFile" $ do -- successes -- it "renameFile, all fine" $ @@ -113,5 +113,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ renameFile' "myFile" "myFile" `shouldThrow` - isSameFile + (\e -> case e of + SameFile{} -> True + _ -> False) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/ToAbsSpec.hs b/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs similarity index 56% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/ToAbsSpec.hs rename to hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs index 22d54f5..2683f9a 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/ToAbsSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/ToAbsSpec.hs @@ -1,25 +1,26 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.ToAbsSpec where +module System.Directory.AFP.ToAbsSpec where import Test.Hspec -import "hpath-directory" System.Posix.RawFilePath.Directory +import System.Directory.OsPath +import System.OsPath (encodeFS) spec :: Spec -spec = describe "System.Posix.RawFilePath.Directory.toAbs" $ do +spec = describe "System.Posix.PosixFilePath.Directory.toAbs" $ do -- successes -- it "toAbs returns absolute paths unchanged" $ do - let p1 = "/a/b/c/d" + p1 <- encodeFS "/a/b/c/d" to <- toAbs p1 p1 `shouldBe` to it "toAbs returns even existing absolute paths unchanged" $ do - let p1 = "/home" + p1 <- encodeFS "/home" to <- toAbs p1 p1 `shouldBe` to diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileLSpec.hs b/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileLSpec.hs rename to hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs index 897f9e1..35f5a85 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileLSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/WriteFileLSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.WriteFileLSpec where +module System.Directory.AFP.WriteFileLSpec where import Test.Hspec @@ -26,7 +26,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "fileWithContent" createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" + createSymlink' "inputFileSymL" "fileWithContent" False createDir' "alreadyExistsD" createRegularFile' "noPerms" noPerms "noPerms" @@ -51,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.WriteFileL" $ do + describe "System.Posix.PosixFilePath.Directory.WriteFileL" $ do -- successes -- it "WriteFileL file with content, everything clear" $ do @@ -104,5 +104,5 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "WriteFileL, file does not exist" $ do - writeFileL' "gaga" "" + writeExistingFileL' "gaga" "" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileSpec.hs b/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs similarity index 93% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileSpec.hs rename to hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs index cc8687e..a9b75e7 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/WriteFileSpec.hs +++ b/hpath-directory/test/System/Directory/AFP/WriteFileSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -module System.Posix.RawFilePath.Directory.WriteFileSpec where +module System.Directory.AFP.WriteFileSpec where import Test.Hspec @@ -26,7 +26,7 @@ setupFiles :: IO () setupFiles = do createRegularFile' "fileWithContent" createRegularFile' "fileWithoutContent" - createSymlink' "inputFileSymL" "fileWithContent" + createSymlink' "inputFileSymL" "fileWithContent" False createDir' "alreadyExistsD" createRegularFile' "noPerms" noPerms "noPerms" @@ -51,7 +51,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.writeFile" $ do + describe "System.Posix.PosixFilePath.Directory.writeFile" $ do -- successes -- it "writeFile file with content, everything clear" $ do @@ -104,5 +104,5 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) it "writeFile, file does not exist" $ do - writeFile' "gaga" "" + writeExistingFile' "gaga" "" `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) diff --git a/hpath-directory/test/System/Posix/RawFilePath/Directory/GetFileTypeSpec.hs b/hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs similarity index 78% rename from hpath-directory/test/System/Posix/RawFilePath/Directory/GetFileTypeSpec.hs rename to hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs index fb242cc..8eba941 100644 --- a/hpath-directory/test/System/Posix/RawFilePath/Directory/GetFileTypeSpec.hs +++ b/hpath-directory/test/System/Directory/Posix/PosixFilePath/Directory/GetFileTypeSpec.hs @@ -1,10 +1,15 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} -module System.Posix.RawFilePath.Directory.GetFileTypeSpec where +module System.Directory.Posix.PosixFilePath.Directory.GetFileTypeSpec where - -import "hpath-directory" System.Posix.RawFilePath.Directory import Test.Hspec + +#ifndef WINDOWS + +import System.OsPath +import "hpath-directory" System.Posix.PosixPath.Directory import System.IO.Error ( ioeGetErrorType @@ -26,10 +31,10 @@ upTmpDir = do setupFiles :: IO () setupFiles = do createRegularFile' "regularfile" - createSymlink' "symlink" "regularfile" - createSymlink' "brokenSymlink" "broken" + createSymlink' "symlink" "regularfile" False + createSymlink' "brokenSymlink" "broken" False createDir' "directory" - createSymlink' "symlinkD" "directory" + createSymlink' "symlinkD" "directory" True createDir' "noPerms" noPerms "noPerms" @@ -48,7 +53,7 @@ cleanupFiles = do spec :: Spec spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ - describe "System.Posix.RawFilePath.Directory.getFileType" $ do + describe "System.Posix.PosixFilePath.Directory.getFileType" $ do -- successes -- it "getFileType, regular file" $ @@ -86,3 +91,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) +#else +spec :: Spec +spec = pure () +#endif diff --git a/hpath-directory/test/Utils.hs b/hpath-directory/test/Utils.hs index 88275b0..a92c650 100644 --- a/hpath-directory/test/Utils.hs +++ b/hpath-directory/test/Utils.hs @@ -1,13 +1,12 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Utils where -import Control.Applicative - ( - (<$>) - ) import Control.Monad ( forM_ @@ -17,7 +16,6 @@ import Control.Monad.IfElse ( whenM ) -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.IORef ( @@ -26,7 +24,6 @@ import Data.IORef , writeIORef , IORef ) -import "hpath-directory" System.Posix.RawFilePath.Directory import Prelude hiding (appendFile, readFile, writeFile) import Data.Maybe ( @@ -36,31 +33,40 @@ import System.IO.Unsafe ( unsafePerformIO ) -import qualified System.Posix.RawFilePath.Directory.Traversals as DT -import Data.ByteString +#ifdef WINDOWS +#else +import System.Posix.PosixPath.Directory ( - ByteString + getFileType ) -import System.Posix.FilePath -import System.Posix.Files.ByteString +import System.OsPath.Posix (PosixPath) +#endif +import Data.ByteString ( - groupExecuteMode - , groupReadMode - , nullFileMode - , otherExecuteMode - , otherReadMode - , ownerExecuteMode - , ownerReadMode - , setFileMode - , unionFileModes + ByteString ) +import System.OsPath +import System.OsString.Internal.Types +import qualified System.OsPath as AFP +import qualified System.OsPath.Posix as P + +import System.Directory.OsPath hiding ( getFileType ) +import System.File.OsPath +import Data.String (IsString (fromString)) + -baseTmpDir :: IORef (Maybe ByteString) +instance IsString OsString where + fromString = either (error . show) id . AFP.encodeUtf + +instance IsString PosixString where + fromString = either (error . show) id . P.encodeUtf + +baseTmpDir :: IORef (Maybe OsPath) {-# NOINLINE baseTmpDir #-} baseTmpDir = unsafePerformIO (newIORef Nothing) -tmpDir :: IORef (Maybe ByteString) +tmpDir :: IORef (Maybe OsPath) {-# NOINLINE tmpDir #-} tmpDir = unsafePerformIO (newIORef Nothing) @@ -71,18 +77,18 @@ tmpDir = unsafePerformIO (newIORef Nothing) ----------------- -setTmpDir :: ByteString -> IO () +setTmpDir :: OsPath -> IO () {-# NOINLINE setTmpDir #-} setTmpDir bs = do tmp <- fromJust <$> readIORef baseTmpDir - writeIORef tmpDir (Just (tmp `BS.append` bs)) + writeIORef tmpDir (Just (tmp AFP. bs)) createTmpDir :: IO () {-# NOINLINE createTmpDir #-} createTmpDir = do tmp <- fromJust <$> readIORef tmpDir - void $ createDir newDirPerms tmp + void $ createDir tmp deleteTmpDir :: IO () @@ -101,29 +107,29 @@ deleteBaseTmpDir = do void $ deleteDir tmp -withRawTmpDir :: (ByteString -> IO a) -> IO a +withRawTmpDir :: (OsPath -> IO a) -> IO a {-# NOINLINE withRawTmpDir #-} withRawTmpDir f = do tmp <- fromJust <$> readIORef tmpDir f tmp -getRawTmpDir :: IO ByteString +getRawTmpDir :: IO OsPath {-# NOINLINE getRawTmpDir #-} -getRawTmpDir = withRawTmpDir (return . flip BS.append "/") +getRawTmpDir = withRawTmpDir (return . pack . (++ [unsafeFromChar '/']) . unpack) -withTmpDir :: ByteString -> (ByteString -> IO a) -> IO a +withTmpDir :: OsPath -> (OsPath -> IO a) -> IO a {-# NOINLINE withTmpDir #-} withTmpDir ip f = do tmp <- fromJust <$> readIORef tmpDir - let p = tmp ip + let p = tmp AFP. ip f p -withTmpDir' :: ByteString - -> ByteString - -> (ByteString -> ByteString -> IO a) +withTmpDir' :: OsPath + -> OsPath + -> (OsPath -> OsPath -> IO a) -> IO a {-# NOINLINE withTmpDir' #-} withTmpDir' ip1 ip2 f = do @@ -133,55 +139,55 @@ withTmpDir' ip1 ip2 f = do f p1 p2 -removeFileIfExists :: ByteString -> IO () +removeFileIfExists :: OsPath -> IO () {-# NOINLINE removeFileIfExists #-} removeFileIfExists bs = withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) -removeDirIfExists :: ByteString -> IO () +removeDirIfExists :: OsPath -> IO () {-# NOINLINE removeDirIfExists #-} removeDirIfExists bs = withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) -copyFile' :: ByteString -> ByteString -> CopyMode -> IO () +copyFile' :: OsPath -> OsPath -> CopyMode -> IO () {-# NOINLINE copyFile' #-} copyFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) -copyDirRecursive' :: ByteString -> ByteString +copyDirRecursive' :: OsPath -> OsPath -> CopyMode -> RecursiveErrorMode -> IO () {-# NOINLINE copyDirRecursive' #-} copyDirRecursive' inputDirP outputDirP cm rm = withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm) -createDir' :: ByteString -> IO () +createDir' :: OsPath -> IO () {-# NOINLINE createDir' #-} -createDir' dest = withTmpDir dest (createDir newDirPerms) +createDir' dest = withTmpDir dest createDir -createDirIfMissing' :: ByteString -> IO () +createDirIfMissing' :: OsPath -> IO () {-# NOINLINE createDirIfMissing' #-} -createDirIfMissing' dest = withTmpDir dest (createDirIfMissing newDirPerms) +createDirIfMissing' dest = withTmpDir dest createDirIfMissing -createDirRecursive' :: ByteString -> IO () +createDirRecursive' :: OsPath -> IO () {-# NOINLINE createDirRecursive' #-} -createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms) +createDirRecursive' dest = withTmpDir dest createDirRecursive -createRegularFile' :: ByteString -> IO () +createRegularFile' :: OsPath -> IO () {-# NOINLINE createRegularFile' #-} -createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms) +createRegularFile' dest = withTmpDir dest createRegularFile -createSymlink' :: ByteString -> ByteString -> IO () +createSymlink' :: OsPath -> OsPath -> Bool -> IO () {-# NOINLINE createSymlink' #-} -createSymlink' dest sympoint = withTmpDir dest - (\x -> createSymlink x sympoint) +createSymlink' dest sympoint b = withTmpDir dest + (\x -> createSymlink x sympoint b) -renameFile' :: ByteString -> ByteString -> IO () +renameFile' :: OsPath -> OsPath -> IO () {-# NOINLINE renameFile' #-} renameFile' inputFileP outputFileP = withTmpDir' inputFileP outputFileP $ \i o -> do @@ -189,7 +195,7 @@ renameFile' inputFileP outputFileP = renameFile o i -moveFile' :: ByteString -> ByteString -> CopyMode -> IO () +moveFile' :: OsPath -> OsPath -> CopyMode -> IO () {-# NOINLINE moveFile' #-} moveFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do @@ -197,100 +203,123 @@ moveFile' inputFileP outputFileP cm = moveFile o i Strict -recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () +recreateSymlink' :: OsPath -> OsPath -> CopyMode -> IO () {-# NOINLINE recreateSymlink' #-} recreateSymlink' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) -noWritableDirPerms :: ByteString -> IO () +noWritableDirPerms :: OsPath -> IO () {-# NOINLINE noWritableDirPerms #-} noWritableDirPerms path = withTmpDir path $ \p -> - setFileMode p perms - where - perms = ownerReadMode - `unionFileModes` ownerExecuteMode - `unionFileModes` groupReadMode - `unionFileModes` groupExecuteMode - `unionFileModes` otherReadMode - `unionFileModes` otherExecuteMode + setPermissions p (setOwnerWritable False newDirPerms) -noPerms :: ByteString -> IO () +noPerms :: OsPath -> IO () {-# NOINLINE noPerms #-} -noPerms path = withTmpDir path $ \p -> setFileMode p nullFileMode +noPerms path = withTmpDir path $ \p -> + setPermissions p emptyPermissions -normalDirPerms :: ByteString -> IO () +normalDirPerms :: OsPath -> IO () {-# NOINLINE normalDirPerms #-} normalDirPerms path = - withTmpDir path $ \p -> setFileMode p newDirPerms + withTmpDir path $ \p -> + setPermissions p newDirPerms -normalFilePerms :: ByteString -> IO () +normalFilePerms :: OsPath -> IO () {-# NOINLINE normalFilePerms #-} normalFilePerms path = - withTmpDir path $ \p -> setFileMode p newFilePerms + withTmpDir path $ \p -> + setPermissions p newFilePerms - -getFileType' :: ByteString -> IO FileType +#ifndef WINDOWS +getFileType' :: PosixPath -> IO FileType {-# NOINLINE getFileType' #-} -getFileType' path = withTmpDir path getFileType +getFileType' path = withTmpDir (OsString path) $ \(OsString p) -> getFileType p +#endif -getDirsFiles' :: ByteString -> IO [ByteString] +getDirsFiles' :: OsPath -> IO [OsPath] {-# NOINLINE getDirsFiles' #-} getDirsFiles' path = withTmpDir path getDirsFiles -deleteFile' :: ByteString -> IO () +deleteFile' :: OsPath -> IO () {-# NOINLINE deleteFile' #-} deleteFile' p = withTmpDir p deleteFile -deleteDir' :: ByteString -> IO () +deleteDir' :: OsPath -> IO () {-# NOINLINE deleteDir' #-} deleteDir' p = withTmpDir p deleteDir -deleteDirRecursive' :: ByteString -> IO () +deleteDirRecursive' :: OsPath -> IO () {-# NOINLINE deleteDirRecursive' #-} deleteDirRecursive' p = withTmpDir p deleteDirRecursive -canonicalizePath' :: ByteString -> IO ByteString +canonicalizePath' :: OsPath -> IO OsPath {-# NOINLINE canonicalizePath' #-} canonicalizePath' p = withTmpDir p canonicalizePath -writeFile' :: ByteString -> ByteString -> IO () +writeFile' :: OsPath -> ByteString -> IO () {-# NOINLINE writeFile' #-} writeFile' ip bs = - withTmpDir ip $ \p -> writeFile p Nothing bs + withTmpDir ip $ \p -> System.File.OsPath.writeFile' p bs -writeFileL' :: ByteString -> BSL.ByteString -> IO () +writeFileL' :: OsPath -> BSL.ByteString -> IO () {-# NOINLINE writeFileL' #-} writeFileL' ip bs = - withTmpDir ip $ \p -> writeFileL p Nothing bs + withTmpDir ip $ \p -> writeFile p bs + +writeExistingFile' :: OsPath -> ByteString -> IO () +{-# NOINLINE writeExistingFile' #-} +writeExistingFile' ip bs = + withTmpDir ip $ \p -> System.Directory.OsPath.writeExistingFile' p bs +writeExistingFileL' :: OsPath -> BSL.ByteString -> IO () +{-# NOINLINE writeExistingFileL' #-} +writeExistingFileL' ip bs = + withTmpDir ip $ \p -> writeExistingFile p bs -appendFile' :: ByteString -> ByteString -> IO () +appendFile' :: OsPath -> ByteString -> IO () {-# NOINLINE appendFile' #-} appendFile' ip bs = - withTmpDir ip $ \p -> appendFile p bs + withTmpDir ip $ \p -> System.File.OsPath.appendFile' p bs + +appendExistingFile' :: OsPath -> ByteString -> IO () +{-# NOINLINE appendExistingFile' #-} +appendExistingFile' ip bs = + withTmpDir ip $ \p -> System.Directory.OsPath.appendExistingFile' p bs -allDirectoryContents' :: ByteString -> IO [ByteString] {-# NOINLINE allDirectoryContents' #-} +allDirectoryContents' :: OsPath -> IO [OsPath] allDirectoryContents' ip = - withTmpDir ip $ \p -> DT.allDirectoryContents' p + withTmpDir ip $ \p -> getDirsFilesRec p -readFile' :: ByteString -> IO ByteString +readFile' :: OsPath -> IO ByteString {-# NOINLINE readFile' #-} -readFile' p = withTmpDir p readFileStrict +readFile' p = withTmpDir p System.File.OsPath.readFile' +readExistingFile' :: OsPath -> IO ByteString +{-# NOINLINE readExistingFile' #-} +readExistingFile' p = withTmpDir p System.Directory.OsPath.readExistingFile' -readFileL :: ByteString -> IO BSL.ByteString +readFileL :: OsPath -> IO BSL.ByteString {-# NOINLINE readFileL #-} readFileL p = withTmpDir p readFile + +readExistingFileL :: OsPath -> IO BSL.ByteString +{-# NOINLINE readExistingFileL #-} +readExistingFileL p = withTmpDir p System.Directory.OsPath.readExistingFile + +dirExists :: OsPath -> IO Bool +{-# NOINLINE dirExists #-} +dirExists fp = doesDirectoryExist fp + diff --git a/hpath-filepath/CHANGELOG.md b/hpath-filepath/CHANGELOG.md deleted file mode 100644 index e37eb7f..0000000 --- a/hpath-filepath/CHANGELOG.md +++ /dev/null @@ -1,14 +0,0 @@ -# Revision history for hpath-filepath - -## 0.10.4 -- 2020-01-26 - -* Add `takeAllParents` - - -## 0.10.2 -- 2020-01-18 - -* Add `isSpecialDirectoryEntry` - -## 0.10.0 -- 2020-01-04 - -* First version. Split from 'hpath', contains only the filepath ByteString manipulation parts. diff --git a/hpath-filepath/README.md b/hpath-filepath/README.md deleted file mode 100644 index 81ea1ee..0000000 --- a/hpath-filepath/README.md +++ /dev/null @@ -1,29 +0,0 @@ -# HPath-filepath - -[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-filepath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-filepath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-filepath.svg)](http://packdeps.haskellers.com/feed?needle=hpath-filepath) - -Support for bytestring based filepath manipulation, similar to 'filepath'. - -This package is part of the HPath suite, also check out: - -* [hpath](https://hackage.haskell.org/package/hpath) -* [hpath-directory](https://hackage.haskell.org/package/hpath-directory) -* [hpath-io](https://hackage.haskell.org/package/hpath-io) - -## Motivation - -This is basically a fork of [posix-paths](https://github.com/JohnLato/posix-paths), which seemed to have stalled development. - -There is also a similar library [filepath-bytestring](https://hackage.haskell.org/package/filepath-bytestring), but it doesn't follow an open development model and is cross-platform, which this library is not interested in. - -## Differences to 'posix-paths' - -* uses the `word8` package for save word8 literals instead of `OverloadedStrings` -* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart -* has some additional functions - -## Differences to 'filepath-bytestring' - -* uses the `word8` package for save word8 literals instead of `OverloadedStrings` -* is not cross-platform (less odd code to maintain) -* has some additional functions diff --git a/hpath-filepath/hpath-filepath.cabal b/hpath-filepath/hpath-filepath.cabal deleted file mode 100644 index a971c94..0000000 --- a/hpath-filepath/hpath-filepath.cabal +++ /dev/null @@ -1,39 +0,0 @@ -name: hpath-filepath -version: 0.10.4 -synopsis: ByteString based filepath manipulation -description: ByteString based filepath manipulation, similar to 'filepath' package. This is POSIX only. --- bug-reports: -license: BSD3 -license-file: LICENSE -author: Julian Ospald -maintainer: Julian Ospald -copyright: Julian Ospald 2016 -category: Filesystem -build-type: Simple -cabal-version: 1.14 -tested-with: GHC==7.10.3 - , GHC==8.0.2 - , GHC==8.2.2 - , GHC==8.4.4 - , GHC==8.6.5 - , GHC==8.8.1 -extra-source-files: README.md - CHANGELOG.md - -library - if os(windows) - build-depends: unbuildable<0 - buildable: False - exposed-modules: System.Posix.FilePath - -- other-modules: - -- other-extensions: - build-depends: base >=4.8 && <5 - , bytestring >= 0.10.0.0 - , unix >= 2.5 - , word8 - hs-source-dirs: src - default-language: Haskell2010 - -source-repository head - type: git - location: https://github.com/hasufell/hpath diff --git a/hpath-filepath/run-doctests.sh b/hpath-filepath/run-doctests.sh deleted file mode 100755 index ad714f8..0000000 --- a/hpath-filepath/run-doctests.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -set -e - -if [ -n "${SKIP_DOCTESTS}" ] ; then - echo "Skipping doctests" - exit 0 -fi - -if ! command -v doctest >/dev/null ; then - tempdir="$(mktemp -d)" - ( - cd "${tempdir}" - cabal install --installdir="${tempdir}" doctest - ) - export PATH="${tempdir}:$PATH" -fi - -set -x - -cd "$(CDPATH= cd -- "$(dirname -- "$0")" && pwd -P)" - -cabal exec doctest -- -isrc -XOverloadedStrings System.Posix.FilePath diff --git a/hpath-filepath/src/System/Posix/FilePath.hs b/hpath-filepath/src/System/Posix/FilePath.hs deleted file mode 100644 index 9a41802..0000000 --- a/hpath-filepath/src/System/Posix/FilePath.hs +++ /dev/null @@ -1,859 +0,0 @@ --- | --- Module : System.Posix.FilePath --- Copyright : © 2016 Julian Ospald --- License : BSD3 --- --- Maintainer : Julian Ospald --- Stability : experimental --- Portability : portable --- --- The equivalent of "System.FilePath" on raw (byte string) file paths. --- --- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute! - - -{-# LANGUAGE CPP #-} -{-# LANGUAGE TupleSections #-} - -{-# OPTIONS_GHC -Wall #-} - - -module System.Posix.FilePath ( - - -- * Separator predicates - pathSeparator -, isPathSeparator -, searchPathSeparator -, isSearchPathSeparator -, extSeparator -, isExtSeparator - - -- * $PATH methods -, splitSearchPath -, getSearchPath - - -- * Extension functions -, splitExtension -, takeExtension -, replaceExtension -, dropExtension -, addExtension -, hasExtension -, (<.>) -, splitExtensions -, dropExtensions -, takeExtensions -, stripExtension - - -- * Filename\/directory functions -, splitFileName -, takeFileName -, replaceFileName -, dropFileName -, takeBaseName -, replaceBaseName -, takeDirectory -, replaceDirectory -, combine -, () -, splitPath -, joinPath -, splitDirectories -, takeAllParents - - -- * Trailing slash functions -, hasTrailingPathSeparator -, addTrailingPathSeparator -, dropTrailingPathSeparator - - -- * File name manipulations -, normalise -, makeRelative -, equalFilePath -, isRelative -, isAbsolute -, isValid -, makeValid -, isSpecialDirectoryEntry -, isFileName -, hasParentDir -, hiddenFile - -, module System.Posix.ByteString.FilePath -) where - -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.String (fromString) -import System.Posix.ByteString.FilePath -import qualified System.Posix.Env.ByteString as PE - -import Data.Maybe (isJust) -import Data.Word8 -#if !MIN_VERSION_bytestring(0,10,8) -import qualified Data.List as L -#endif -import Control.Arrow (second) - --- $setup --- >>> import Data.Char --- >>> import Data.Maybe --- >>> import Data.Word8 --- >>> import Test.QuickCheck --- >>> import Control.Applicative --- >>> import qualified Data.ByteString as BS --- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary --- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack --- --- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral - - - ------------------------- --- Separator predicates - - --- | Path separator character -pathSeparator :: Word8 -pathSeparator = _slash - - --- | Check if a character is the path separator --- --- prop> \n -> (_chr n == '/') == isPathSeparator n -isPathSeparator :: Word8 -> Bool -isPathSeparator = (== pathSeparator) - - --- | Search path separator -searchPathSeparator :: Word8 -searchPathSeparator = _colon - - --- | Check if a character is the search path separator --- --- prop> \n -> (_chr n == ':') == isSearchPathSeparator n -isSearchPathSeparator :: Word8 -> Bool -isSearchPathSeparator = (== searchPathSeparator) - - --- | File extension separator -extSeparator :: Word8 -extSeparator = _period - - --- | Check if a character is the file extension separator --- --- prop> \n -> (_chr n == '.') == isExtSeparator n -isExtSeparator :: Word8 -> Bool -isExtSeparator = (== extSeparator) - - - ------------------------- --- $PATH methods - - --- | Take a ByteString, split it on the 'searchPathSeparator'. --- Blank items are converted to @.@. --- --- Follows the recommendations in --- --- --- >>> splitSearchPath "File1:File2:File3" --- ["File1","File2","File3"] --- >>> splitSearchPath "File1::File2:File3" --- ["File1",".","File2","File3"] --- >>> splitSearchPath "" --- ["."] -splitSearchPath :: ByteString -> [RawFilePath] -splitSearchPath = f - where - f bs = let (pre, post) = BS.break isSearchPathSeparator bs - in if BS.null post - then g pre - else g pre ++ f (BS.tail post) - g x - | BS.null x = [BS.singleton _period] - | otherwise = [x] - - --- | Get a list of 'RawFilePath's in the $PATH variable. -getSearchPath :: IO [RawFilePath] -getSearchPath = fmap (maybe [] splitSearchPath) (PE.getEnv $ fromString "PATH") - - - ------------------------- --- Extension functions - --- | Split a 'RawFilePath' into a path+filename and extension --- --- >>> splitExtension "file.exe" --- ("file",".exe") --- >>> splitExtension "file" --- ("file","") --- >>> splitExtension "/path/file.tar.gz" --- ("/path/file.tar",".gz") --- --- prop> \path -> uncurry (BS.append) (splitExtension path) == path -splitExtension :: RawFilePath -> (RawFilePath, ByteString) -splitExtension x = if BS.null basename - then (x,BS.empty) - else (BS.append path (BS.init basename),BS.cons extSeparator fileExt) - where - (path,file) = splitFileNameRaw x - (basename,fileExt) = BS.breakEnd isExtSeparator file - - --- | Get the final extension from a 'RawFilePath' --- --- >>> takeExtension "file.exe" --- ".exe" --- >>> takeExtension "file" --- "" --- >>> takeExtension "/path/file.tar.gz" --- ".gz" -takeExtension :: RawFilePath -> ByteString -takeExtension = snd . splitExtension - - --- | Change a file's extension --- --- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path -replaceExtension :: RawFilePath -> ByteString -> RawFilePath -replaceExtension path ext = dropExtension path <.> ext - - --- | Drop the final extension from a 'RawFilePath' --- --- >>> dropExtension "file.exe" --- "file" --- >>> dropExtension "file" --- "file" --- >>> dropExtension "/path/file.tar.gz" --- "/path/file.tar" -dropExtension :: RawFilePath -> RawFilePath -dropExtension = fst . splitExtension - - --- | Add an extension to a 'RawFilePath' --- --- >>> addExtension "file" ".exe" --- "file.exe" --- >>> addExtension "file.tar" ".gz" --- "file.tar.gz" --- >>> addExtension "/path/" ".ext" --- "/path/.ext" -addExtension :: RawFilePath -> ByteString -> RawFilePath -addExtension file ext - | BS.null ext = file - | isExtSeparator (BS.head ext) = BS.append file ext - | otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext] - - --- | Check if a 'RawFilePath' has an extension --- --- >>> hasExtension "file" --- False --- >>> hasExtension "file.tar" --- True --- >>> hasExtension "/path.part1/" --- False -hasExtension :: RawFilePath -> Bool -hasExtension = isJust . BS.elemIndex extSeparator . takeFileName - - --- | Operator version of 'addExtension' -(<.>) :: RawFilePath -> ByteString -> RawFilePath -(<.>) = addExtension - - --- | Split a 'RawFilePath' on the first extension. --- --- >>> splitExtensions "/path/file.tar.gz" --- ("/path/file",".tar.gz") --- --- prop> \path -> uncurry addExtension (splitExtensions path) == path -splitExtensions :: RawFilePath -> (RawFilePath, ByteString) -splitExtensions x = if BS.null basename - then (path,fileExt) - else (BS.append path basename,fileExt) - where - (path,file) = splitFileNameRaw x - (basename,fileExt) = BS.break isExtSeparator file - - --- | Remove all extensions from a 'RawFilePath' --- --- >>> dropExtensions "/path/file.tar.gz" --- "/path/file" -dropExtensions :: RawFilePath -> RawFilePath -dropExtensions = fst . splitExtensions - - --- | Take all extensions from a 'RawFilePath' --- --- >>> takeExtensions "/path/file.tar.gz" --- ".tar.gz" -takeExtensions :: RawFilePath -> ByteString -takeExtensions = snd . splitExtensions - - --- | Drop the given extension from a FilePath, and the @\".\"@ preceding it. --- Returns 'Nothing' if the FilePath does not have the given extension, or --- 'Just' and the part before the extension if it does. --- --- This function can be more predictable than 'dropExtensions', --- especially if the filename might itself contain @.@ characters. --- --- >>> stripExtension "hs.o" "foo.x.hs.o" --- Just "foo.x" --- >>> stripExtension "hi.o" "foo.x.hs.o" --- Nothing --- >>> stripExtension ".c.d" "a.b.c.d" --- Just "a.b" --- >>> stripExtension ".c.d" "a.b..c.d" --- Just "a.b." --- >>> stripExtension "baz" "foo.bar" --- Nothing --- >>> stripExtension "bar" "foobar" --- Nothing --- --- prop> \path -> stripExtension "" path == Just path --- prop> \path -> dropExtension path == fromJust (stripExtension (takeExtension path) path) --- prop> \path -> dropExtensions path == fromJust (stripExtension (takeExtensions path) path) -stripExtension :: ByteString -> RawFilePath -> Maybe RawFilePath -stripExtension bs path - | BS.null bs = Just path - | otherwise = stripSuffix' dotExt path - where - dotExt = if isExtSeparator $ BS.head bs - then bs - else extSeparator `BS.cons` bs -#if MIN_VERSION_bytestring(0,10,8) - stripSuffix' = BS.stripSuffix -#else - stripSuffix' xs ys = fmap (BS.pack . reverse) $ L.stripPrefix (reverse $ BS.unpack xs) (reverse $ BS.unpack ys) -#endif - - ------------------------- --- Filename/directory functions - - --- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse --- --- >>> splitFileName "path/file.txt" --- ("path/","file.txt") --- >>> splitFileName "path/" --- ("path/","") --- >>> splitFileName "file.txt" --- ("./","file.txt") --- --- prop> \path -> uncurry combine (splitFileName path) == path || fst (splitFileName path) == "./" -splitFileName :: RawFilePath -> (RawFilePath, RawFilePath) -splitFileName x = if BS.null path - then (dotSlash, file) - else (path,file) - where - (path,file) = splitFileNameRaw x - dotSlash = _period `BS.cons` (BS.singleton pathSeparator) - - --- | Get the file name --- --- >>> takeFileName "path/file.txt" --- "file.txt" --- >>> takeFileName "path/" --- "" -takeFileName :: RawFilePath -> RawFilePath -takeFileName = snd . splitFileName - - --- | Change the file name --- --- prop> \path -> replaceFileName path (takeFileName path) == path -replaceFileName :: RawFilePath -> ByteString -> RawFilePath -replaceFileName x y = fst (splitFileNameRaw x) y - - --- | Drop the file name --- --- >>> dropFileName "path/file.txt" --- "path/" --- >>> dropFileName "file.txt" --- "./" -dropFileName :: RawFilePath -> RawFilePath -dropFileName = fst . splitFileName - - --- | Get the file name, without a trailing extension --- --- >>> takeBaseName "path/file.tar.gz" --- "file.tar" --- >>> takeBaseName "" --- "" -takeBaseName :: RawFilePath -> ByteString -takeBaseName = dropExtension . takeFileName - - --- | Change the base name --- --- >>> replaceBaseName "path/file.tar.gz" "bob" --- "path/bob.gz" --- --- prop> \path -> replaceBaseName path (takeBaseName path) == path -replaceBaseName :: RawFilePath -> ByteString -> RawFilePath -replaceBaseName path name = combineRaw dir (name <.> ext) - where - (dir,file) = splitFileNameRaw path - ext = takeExtension file - - --- | Get the directory, moving up one level if it's already a directory --- --- >>> takeDirectory "path/file.txt" --- "path" --- >>> takeDirectory "file" --- "." --- >>> takeDirectory "/path/to/" --- "/path/to" --- >>> takeDirectory "/path/to" --- "/path" -takeDirectory :: RawFilePath -> RawFilePath -takeDirectory x = case () of - () | x == BS.singleton pathSeparator -> x - | BS.null res && not (BS.null file) -> file - | otherwise -> res - where - res = fst $ BS.spanEnd isPathSeparator file - file = dropFileName x - - --- | Change the directory component of a 'RawFilePath' --- --- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "." -replaceDirectory :: RawFilePath -> ByteString -> RawFilePath -replaceDirectory file dir = combineRaw dir (takeFileName file) - - --- | Join two paths together --- --- >>> combine "/" "file" --- "/file" --- >>> combine "/path/to" "file" --- "/path/to/file" --- >>> combine "file" "/absolute/path" --- "/absolute/path" -combine :: RawFilePath -> RawFilePath -> RawFilePath -combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b - | otherwise = combineRaw a b - - --- | Operator version of combine -() :: RawFilePath -> RawFilePath -> RawFilePath -() = combine - --- | Split a path into a list of components: --- --- >>> splitPath "/path/to/file.txt" --- ["/","path/","to/","file.txt"] --- --- prop> \path -> BS.concat (splitPath path) == path -splitPath :: RawFilePath -> [RawFilePath] -splitPath = splitter - where - splitter x - | BS.null x = [] - | otherwise = case BS.elemIndex pathSeparator x of - Nothing -> [x] - Just ix -> case BS.findIndex (not . isPathSeparator) $ BS.drop (ix+1) x of - Nothing -> [x] - Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x - - --- | Join a split path back together --- --- prop> \path -> joinPath (splitPath path) == path --- --- >>> joinPath ["path","to","file.txt"] --- "path/to/file.txt" -joinPath :: [RawFilePath] -> RawFilePath -joinPath = foldr () BS.empty - - --- | Like 'splitPath', but without trailing slashes --- --- >>> splitDirectories "/path/to/file.txt" --- ["/","path","to","file.txt"] --- >>> splitDirectories "path/to/file.txt" --- ["path","to","file.txt"] --- >>> splitDirectories "" --- [] -splitDirectories :: RawFilePath -> [RawFilePath] -splitDirectories x - | BS.null x = [] - | isPathSeparator (BS.head x) = let (root,rest) = BS.splitAt 1 x - in root : splitter rest - | otherwise = splitter x - where - splitter = filter (not . BS.null) . BS.split pathSeparator - - --- |Get all parents of a path. --- --- >>> takeAllParents "/abs/def/dod" --- ["/abs/def","/abs","/"] --- >>> takeAllParents "/foo" --- ["/"] --- >>> takeAllParents "/" --- [] -takeAllParents :: RawFilePath -> [RawFilePath] -takeAllParents p - | np == BS.singleton pathSeparator = [] - | otherwise = takeDirectory np : takeAllParents (takeDirectory np) - where - np = normalise p - - ------------------------- --- Trailing slash functions - --- | Check if the last character of a 'RawFilePath' is '/'. --- --- >>> hasTrailingPathSeparator "/path/" --- True --- >>> hasTrailingPathSeparator "/" --- True --- >>> hasTrailingPathSeparator "/path" --- False -hasTrailingPathSeparator :: RawFilePath -> Bool -hasTrailingPathSeparator x - | BS.null x = False - | otherwise = isPathSeparator $ BS.last x - - --- | Add a trailing path separator. --- --- >>> addTrailingPathSeparator "/path" --- "/path/" --- >>> addTrailingPathSeparator "/path/" --- "/path/" --- >>> addTrailingPathSeparator "/" --- "/" -addTrailingPathSeparator :: RawFilePath -> RawFilePath -addTrailingPathSeparator x = if hasTrailingPathSeparator x - then x - else x `BS.snoc` pathSeparator - - --- | Remove a trailing path separator --- --- >>> dropTrailingPathSeparator "/path/" --- "/path" --- >>> dropTrailingPathSeparator "/path////" --- "/path" --- >>> dropTrailingPathSeparator "/" --- "/" --- >>> dropTrailingPathSeparator "//" --- "/" -dropTrailingPathSeparator :: RawFilePath -> RawFilePath -dropTrailingPathSeparator x - | x == BS.singleton pathSeparator = x - | otherwise = if hasTrailingPathSeparator x - then dropTrailingPathSeparator $ BS.init x - else x - - - ------------------------- --- File name manipulations - - --- |Normalise a file. --- --- >>> normalise "/file/\\test////" --- "/file/\\test/" --- >>> normalise "/file/./test" --- "/file/test" --- >>> normalise "/test/file/../bob/fred/" --- "/test/file/../bob/fred/" --- >>> normalise "../bob/fred/" --- "../bob/fred/" --- >>> normalise "./bob/fred/" --- "bob/fred/" --- >>> normalise "./bob////.fred/./...///./..///#." --- "bob/.fred/.../../#." --- >>> normalise "." --- "." --- >>> normalise "./" --- "./" --- >>> normalise "./." --- "./" --- >>> normalise "/./" --- "/" --- >>> normalise "/" --- "/" --- >>> normalise "bob/fred/." --- "bob/fred/" --- >>> normalise "//home" --- "/home" -normalise :: RawFilePath -> RawFilePath -normalise filepath = - result `BS.append` - (if addPathSeparator - then BS.singleton pathSeparator - else BS.empty) - where - result = let n = f filepath - in if BS.null n - then BS.singleton _period - else n - addPathSeparator = isDirPath filepath && - not (hasTrailingPathSeparator result) - isDirPath xs = hasTrailingPathSeparator xs - || not (BS.null xs) && BS.last xs == _period - && hasTrailingPathSeparator (BS.init xs) - f = joinPath . dropDots . propSep . splitDirectories - propSep :: [ByteString] -> [ByteString] - propSep (x:xs) - | BS.all (== pathSeparator) x = BS.singleton pathSeparator : xs - | otherwise = x : xs - propSep [] = [] - dropDots :: [ByteString] -> [ByteString] - dropDots = filter (BS.singleton _period /=) - - - --- | Contract a filename, based on a relative path. Note that the resulting --- path will never introduce @..@ paths, as the presence of symlinks --- means @..\/b@ may not reach @a\/b@ if it starts from @a\/c@. For a --- worked example see --- . --- --- >>> makeRelative "/directory" "/directory/file.ext" --- "file.ext" --- >>> makeRelative "/Home" "/home/bob" --- "/home/bob" --- >>> makeRelative "/home/" "/home/bob/foo/bar" --- "bob/foo/bar" --- >>> makeRelative "/fred" "bob" --- "bob" --- >>> makeRelative "/file/test" "/file/test/fred" --- "fred" --- >>> makeRelative "/file/test" "/file/test/fred/" --- "fred/" --- >>> makeRelative "some/path" "some/path/a/b/c" --- "a/b/c" --- --- prop> \p -> makeRelative p p == "." --- prop> \p -> makeRelative (takeDirectory p) p `equalFilePath` takeFileName p --- prop \x y -> equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y makeRelative y x) x -makeRelative :: RawFilePath -> RawFilePath -> RawFilePath -makeRelative root path - | equalFilePath root path = BS.singleton _period - | takeAbs root /= takeAbs path = path - | otherwise = f (dropAbs root) (dropAbs path) - where - f x y - | BS.null x = BS.dropWhile isPathSeparator y - | otherwise = let (x1,x2) = g x - (y1,y2) = g y - in if equalFilePath x1 y1 then f x2 y2 else path - g x = (BS.dropWhile isPathSeparator a, BS.dropWhile isPathSeparator b) - where (a, b) = BS.break isPathSeparator $ BS.dropWhile isPathSeparator x - dropAbs x = snd $ BS.span (== _slash) x - takeAbs x = fst $ BS.span (== _slash) x - - --- |Equality of two filepaths. The filepaths are normalised --- and trailing path separators are dropped. --- --- >>> equalFilePath "foo" "foo" --- True --- >>> equalFilePath "foo" "foo/" --- True --- >>> equalFilePath "foo" "./foo" --- True --- >>> equalFilePath "" "" --- True --- >>> equalFilePath "foo" "/foo" --- False --- >>> equalFilePath "foo" "FOO" --- False --- >>> equalFilePath "foo" "../foo" --- False --- --- prop> \p -> equalFilePath p p -equalFilePath :: RawFilePath -> RawFilePath -> Bool -equalFilePath p1 p2 = f p1 == f p2 - where - f x = dropTrailingPathSeparator $ normalise x - - --- | Check if a path is relative --- --- prop> \path -> isRelative path /= isAbsolute path -isRelative :: RawFilePath -> Bool -isRelative = not . isAbsolute - - --- | Check if a path is absolute --- --- >>> isAbsolute "/path" --- True --- >>> isAbsolute "path" --- False --- >>> isAbsolute "" --- False -isAbsolute :: RawFilePath -> Bool -isAbsolute x - | BS.length x > 0 = isPathSeparator (BS.head x) - | otherwise = False - - --- | Is a FilePath valid, i.e. could you create a file like it? --- --- >>> isValid "" --- False --- >>> isValid "\0" --- False --- >>> isValid "/random_ path:*" --- True -isValid :: RawFilePath -> Bool -isValid filepath - | BS.null filepath = False - | _nul `BS.elem` filepath = False - | otherwise = True - - --- | Take a FilePath and make it valid; does not change already valid FilePaths. --- --- >>> makeValid "" --- "_" --- >>> makeValid "file\0name" --- "file_name" --- --- prop> \p -> if isValid p then makeValid p == p else makeValid p /= p --- prop> \p -> isValid (makeValid p) -makeValid :: RawFilePath -> RawFilePath -makeValid path - | BS.null path = BS.singleton _underscore - | otherwise = BS.map (\x -> if x == _nul then _underscore else x) path - - --- | Whether the filename is a special directory entry --- (. and ..). Does not normalise filepaths. --- --- >>> isSpecialDirectoryEntry "." --- True --- >>> isSpecialDirectoryEntry ".." --- True --- >>> isSpecialDirectoryEntry "/random_ path:*" --- False -isSpecialDirectoryEntry :: RawFilePath -> Bool -isSpecialDirectoryEntry filepath - | BS.pack [_period, _period] == filepath = True - | BS.pack [_period] == filepath = True - | otherwise = False - - --- | Is the given path a valid filename? This includes --- "." and "..". --- --- >>> isFileName "lal" --- True --- >>> isFileName "." --- True --- >>> isFileName ".." --- True --- >>> isFileName "" --- False --- >>> isFileName "\0" --- False --- >>> isFileName "/random_ path:*" --- False -isFileName :: RawFilePath -> Bool -isFileName filepath = - not (BS.singleton pathSeparator `BS.isInfixOf` filepath) && - not (BS.null filepath) && - not (_nul `BS.elem` filepath) - - --- | Check if the filepath has any parent directories in it. --- --- >>> hasParentDir "/.." --- True --- >>> hasParentDir "foo/bar/.." --- True --- >>> hasParentDir "foo/../bar/." --- True --- >>> hasParentDir "foo/bar" --- False --- >>> hasParentDir "foo" --- False --- >>> hasParentDir "" --- False --- >>> hasParentDir ".." --- False -hasParentDir :: RawFilePath -> Bool -hasParentDir filepath = - (pathSeparator `BS.cons` pathDoubleDot) - `BS.isSuffixOf` filepath - || - (BS.singleton pathSeparator - `BS.append` pathDoubleDot - `BS.append` BS.singleton pathSeparator) - `BS.isInfixOf` filepath - || - (pathDoubleDot `BS.append` BS.singleton pathSeparator) - `BS.isPrefixOf` filepath - where - pathDoubleDot = BS.pack [_period, _period] - - --- | Whether the file is a hidden file. --- --- >>> hiddenFile ".foo" --- True --- >>> hiddenFile "..foo.bar" --- True --- >>> hiddenFile "some/path/.bar" --- True --- >>> hiddenFile "..." --- True --- >>> hiddenFile "dod.bar" --- False --- >>> hiddenFile "." --- False --- >>> hiddenFile ".." --- False --- >>> hiddenFile "" --- False -hiddenFile :: RawFilePath -> Bool -hiddenFile fp - | fn == BS.pack [_period, _period] = False - | fn == BS.pack [_period] = False - | otherwise = BS.pack [extSeparator] - `BS.isPrefixOf` fn - where - fn = takeFileName fp - - - ------------------------- --- internal stuff - --- Just split the input FileName without adding/normalizing or changing --- anything. -splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath) -splitFileNameRaw = BS.breakEnd isPathSeparator - --- | Combine two paths, assuming rhs is NOT absolute. -combineRaw :: RawFilePath -> RawFilePath -> RawFilePath -combineRaw a b | BS.null a = b - | BS.null b = a - | isPathSeparator (BS.last a) = BS.append a b - | otherwise = BS.intercalate (BS.singleton pathSeparator) [a, b] - diff --git a/hpath-io/CHANGELOG.md b/hpath-io/CHANGELOG.md deleted file mode 100644 index c79200b..0000000 --- a/hpath-io/CHANGELOG.md +++ /dev/null @@ -1,55 +0,0 @@ -# Revision history for hpath-io - -## 0.14.1 -- ????-??-?? - -- add `readFileStrict` - -## 0.14.0 -- 2020-07-04 - -* Use hpath-directory-0.14.0 - -## 0.13.2 -- 2020-05-08 - -* Add getDirsFilesStream and use streamly-posix for dircontents (#34) - -## 0.13.0 -- 2020-01-26 - -* switch to using 'hpath-bytestring' for the implementation (this is now just a wrapper module, mostly) - -## 0.12.0 -- 2020-01-20 - -* breaking API changes - * RelC and Fn were removed from `hpath` - * further changes to `parseAny` - - -## 0.11.0 -- 2020-01-18 - -* `writeFile` not allows to set file mode and create file if it does not exist (this broke API) -* added various new functions: - * createDirIfMissing - * writeFileL (for lazy bytestring) - * isReadable - * isExecutable - * getModificationTime - * setModificationTime - * setModificationTimeHiRes - * getDirsFiles' (returns filenames instead of paths) - * withRawFilePath - * withHandle - -## 0.10.1 -- 2020-01-13 - -* Move file check functions to HPath.IO -* Add 'doesExist' -* Exception handling of `doesExist`, `doesFileExist`, `doesDirectoryExist` has changed: only eNOENT is catched -* Exception handling of `isWritable` has changed: just a wrapper around `access` now -* switch exception handling to `safe-exceptions` -* Redo file reading API (readFileEOF dropped and now using streamly under the hood, added `readFileStream`) - - -## 0.10.0 -- 2020-01-04 - -* First version. Split from 'hpath', contains only the IO parts. -* Now uses streamly for 'copyFile' -* Fixed tmpdir in hspec diff --git a/hpath-io/LICENSE b/hpath-io/LICENSE deleted file mode 100644 index 7ecfe24..0000000 --- a/hpath-io/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) 2020, Julian Ospald - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Julian Ospald nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/hpath-io/README.md b/hpath-io/README.md deleted file mode 100644 index 90c7b6c..0000000 --- a/hpath-io/README.md +++ /dev/null @@ -1,27 +0,0 @@ -# HPath-IO - -[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-io.svg)](http://packdeps.haskellers.com/feed?needle=hpath-io) - -High-level IO operations on files/directories, utilizing type-safe Paths. This uses [hpath-directory](https://hackage.haskell.org/package/hpath-directory) under the hood. - -This package is part of the HPath suite, also check out: - -* [hpath](https://hackage.haskell.org/package/hpath) -* [hpath-directory](https://hackage.haskell.org/package/hpath-directory) -* [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath) - -## Motivation - -The motivation came during development of -[hsfm](https://github.com/hasufell/hsfm) -in order to have a proper high-level API of file related operations, -while utilizing type-safe Paths. - -## Goals - -* high-level API to file operations like recursive directory copy -* still allowing sufficient control to interact with the underlying low-level calls -* unit-testing exceptions (because yes, people may rely on them) - -Note: this library was written for __posix__ systems and it will probably not support other systems. - diff --git a/hpath-io/Setup.hs b/hpath-io/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/hpath-io/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/hpath-io/TODO.md b/hpath-io/TODO.md deleted file mode 100644 index 1a0301e..0000000 --- a/hpath-io/TODO.md +++ /dev/null @@ -1,6 +0,0 @@ -# TODO - -## Tests - -* `doesExist` not tested -* `readFileStream` only implicitly tested by `readFile` diff --git a/hpath-io/hpath-io.cabal b/hpath-io/hpath-io.cabal deleted file mode 100644 index 49849ad..0000000 --- a/hpath-io/hpath-io.cabal +++ /dev/null @@ -1,46 +0,0 @@ -name: hpath-io -version: 0.14.2 -synopsis: High-level IO operations on files/directories -description: High-level IO operations on files/directories, utilizing type-safe Paths --- bug-reports: -license: BSD3 -license-file: LICENSE -author: Julian Ospald -maintainer: Julian Ospald -copyright: Julian Ospald 2016 -category: Filesystem -build-type: Simple -cabal-version: 1.14 -tested-with: GHC==7.10.3 - , GHC==8.0.2 - , GHC==8.2.2 - , GHC==8.4.4 - , GHC==8.6.5 - , GHC==8.8.1 -extra-source-files: README.md - CHANGELOG.md - -library - if os(windows) - build-depends: unbuildable<0 - buildable: False - exposed-modules: HPath.IO - build-depends: base >= 4.8 && <5 - , bytestring >= 0.10.0.0 - , exceptions - , hpath >= 0.12 && < 0.13 - , hpath-directory >= 0.14.2 && < 0.15 - , hpath-posix >= 0.13.3 && < 0.14 - , safe-exceptions >= 0.1 - , streamly >= 0.7 - , time >= 1.8 - , unix >= 2.5 - if !impl(ghc>=7.11) - build-depends: transformers - hs-source-dirs: src - default-language: Haskell2010 - - -source-repository head - type: git - location: https://github.com/hasufell/hpath diff --git a/hpath-posix/hpath-posix.cabal b/hpath-posix/hpath-posix.cabal index e3524e2..c0fcb21 100644 --- a/hpath-posix/hpath-posix.cabal +++ b/hpath-posix/hpath-posix.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.10 name: hpath-posix -version: 0.13.3 +version: 0.14.3 synopsis: Some low-level POSIX glue code, that is not in 'unix' homepage: https://github.com/hasufell/hpath bug-reports: https://github.com/hasufell/hpath/issues @@ -25,16 +25,17 @@ library if os(windows) build-depends: unbuildable<0 buildable: False - exposed-modules: System.Posix.RawFilePath.Directory.Traversals + exposed-modules: System.Posix.PosixFilePath.Directory.Traversals System.Posix.Foreign System.Posix.FD -- other-modules: -- other-extensions: c-sources: cbits/dirutils.c - build-depends: base >= 4.8 && <5 - , bytestring >= 0.10 - , hpath-filepath >= 0.10.4 - , unix >= 2.5 + build-depends: filepath >=1.4.99.5 + , base >= 4.8 && <5 + , bytestring >= 0.10 + , hpath-filepath >= 0.10.4 + , unix >= 2.5 if impl(ghc < 8.0) build-depends: fail >= 4.9 diff --git a/hpath-posix/src/System/Posix/FD.hs b/hpath-posix/src/System/Posix/FD.hs index 6dbc458..e266b23 100644 --- a/hpath-posix/src/System/Posix/FD.hs +++ b/hpath-posix/src/System/Posix/FD.hs @@ -28,7 +28,8 @@ import Foreign.C.String import Foreign.C.Types import System.Posix.Foreign import qualified System.Posix as Posix -import System.Posix.ByteString.FilePath +import System.Posix.PosixPath.FilePath +import System.OsPath.Types foreign import ccall unsafe "open" @@ -63,7 +64,7 @@ open_ str how optional_flags maybe_mode = do -- Note that passing @Just x@ as the 4th argument triggers the -- `oCreat` status flag, which must be set when you pass in `oExcl` -- to the status flags. Also see the manpage for @open(2)@. -openFd :: RawFilePath +openFd :: PosixPath -> Posix.OpenMode -> [Flags] -- ^ status flags of @open(2)@ -> Maybe Posix.FileMode -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist. diff --git a/hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs b/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs similarity index 78% rename from hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs rename to hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs index bdb3ece..6b4b1c1 100644 --- a/hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs +++ b/hpath-posix/src/System/Posix/PosixFilePath/Directory/Traversals.hs @@ -1,5 +1,5 @@ -- | --- Module : System.Posix.RawFilePath.Directory.Traversals +-- Module : System.Posix.PosixFilePath.Directory.Traversals -- Copyright : © 2016 Julian Ospald -- License : BSD3 -- @@ -16,11 +16,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -Wall #-} -module System.Posix.RawFilePath.Directory.Traversals ( +module System.Posix.PosixFilePath.Directory.Traversals ( getDirectoryContents , getDirectoryContents' @@ -43,16 +44,16 @@ module System.Posix.RawFilePath.Directory.Traversals ( import Control.Applicative ((<$>)) #endif import Control.Monad -import System.Posix.FilePath (()) +import System.OsPath.Posix ((), decodeFS, pstr) +import qualified System.OsPath.Posix as AFP import System.Posix.Foreign import qualified System.Posix as Posix import System.IO.Error import Control.Exception -import qualified Data.ByteString.Char8 as BS -import System.Posix.ByteString.FilePath -import System.Posix.Directory.ByteString as PosixBS -import System.Posix.Files.ByteString +import System.Posix.PosixPath.FilePath +import System.Posix.Directory.PosixPath as PosixBS +import System.Posix.Files.PosixString import System.IO.Unsafe import "unix" System.Posix.IO.ByteString (closeFd) @@ -64,6 +65,12 @@ import Foreign.Marshal.Alloc (alloca,allocaBytes) import Foreign.Ptr import Foreign.Storable +import System.OsPath.Types +import qualified System.OsString.Internal.Types as T + +import qualified Data.ByteString.Short as SBS + + @@ -76,10 +83,10 @@ import Foreign.Storable -- be accessed on demand. -- -- Follows symbolic links for the input dir. -allDirectoryContents :: RawFilePath -> IO [RawFilePath] +allDirectoryContents :: PosixPath -> IO [PosixPath] allDirectoryContents topdir = do namesAndTypes <- getDirectoryContents topdir - let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes + let properNames = filter ((`notElem` [[pstr|.|], [pstr|..|]]) . snd) namesAndTypes paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do let path = topdir name case () of @@ -95,7 +102,7 @@ allDirectoryContents topdir = do -- | Get all files from a directory and its subdirectories strictly. -- -- Follows symbolic links for the input dir. -allDirectoryContents' :: RawFilePath -> IO [RawFilePath] +allDirectoryContents' :: PosixPath -> IO [PosixPath] allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] -- this uses traverseDirectory because it's more efficient than forcing the -- lazy version. @@ -106,7 +113,7 @@ allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp: -- This function allows for memory-efficient traversals. -- -- Follows symbolic links for the input dir. -traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s +traverseDirectory :: (s -> PosixPath -> IO s) -> s -> PosixPath -> IO s traverseDirectory act s0 topdir = toploop where toploop = do @@ -123,12 +130,13 @@ traverseDirectory act s0 topdir = toploop then act acc path >>= \acc' -> actOnDirContents path acc' loop else act acc path -actOnDirContents :: RawFilePath +actOnDirContents :: PosixPath -> b - -> (DirType -> RawFilePath -> b -> IO b) + -> (DirType -> PosixPath -> b -> IO b) -> IO b -actOnDirContents pathRelToTop b f = - modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) . +actOnDirContents pathRelToTop b f = do + locstr <- decodeFS pathRelToTop + modifyIOError ((`ioeSetFileName` locstr) . (`ioeSetLocation` "findBSTypRel")) $ bracket (openDirStream pathRelToTop) @@ -137,10 +145,10 @@ actOnDirContents pathRelToTop b f = where loop dirp b' = do (typ,e) <- readDirEnt dirp - if (e == "") + if e == AFP.pack [] then return b' else - if (e == "." || e == "..") + if e == [pstr|.|] || e == [pstr|..|] then loop dirp b' else f typ (pathRelToTop e) b' >>= loop dirp @@ -188,18 +196,18 @@ foreign import capi unsafe "dirent.h fdopendir" -- less dodgy but still lower-level -readDirEnt :: DirStream -> IO (DirType, RawFilePath) +readDirEnt :: DirStream -> IO (DirType, PosixPath) readDirEnt (unpackDirStream -> dirp) = alloca $ \ptr_dEnt -> loop ptr_dEnt where loop ptr_dEnt = do resetErrno r <- c_readdir dirp ptr_dEnt - if (r == 0) + if r == 0 then do dEnt <- peek ptr_dEnt - if (dEnt == nullPtr) - then return (dtUnknown,BS.empty) + if dEnt == nullPtr + then return (dtUnknown, mempty) else do dName <- c_name dEnt >>= peekFilePath dType <- c_type dEnt @@ -207,19 +215,20 @@ readDirEnt (unpackDirStream -> dirp) = return (dType, dName) else do errno <- getErrno - if (errno == eINTR) + if errno == eINTR then loop ptr_dEnt else do let (Errno eo) = errno - if (eo == 0) - then return (dtUnknown,BS.empty) + if eo == 0 + then return (dtUnknown, mempty) else throwErrno "readDirEnt" -- |Gets all directory contents (not recursively). -getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] -getDirectoryContents path = - modifyIOError ((`ioeSetFileName` (BS.unpack path)) . +getDirectoryContents :: PosixPath -> IO [(DirType, PosixPath)] +getDirectoryContents path = do + locstr <- decodeFS path + modifyIOError ((`ioeSetFileName` locstr) . (`ioeSetLocation` "System.Posix.RawFilePath.Directory.Traversals.getDirectoryContents")) $ bracket (PosixBS.openDirStream path) @@ -240,7 +249,7 @@ fdOpendir fd = -- only happens on successful `fdOpendir` and after the directory -- stream is closed. Also see the manpage of @fdopendir(3)@ for -- more details. -getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)] +getDirectoryContents' :: Posix.Fd -> IO [(DirType, PosixPath)] getDirectoryContents' fd = do dirstream <- fdOpendir fd `catchIOError` \e -> do closeFd fd @@ -249,11 +258,11 @@ getDirectoryContents' fd = do finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream) -_dirloop :: DirStream -> IO [(DirType, RawFilePath)] +_dirloop :: DirStream -> IO [(DirType, PosixPath)] {-# INLINE _dirloop #-} _dirloop dirp = do - t@(_typ,e) <- readDirEnt dirp - if BS.null e then return [] else do + t@(_typ, e) <- readDirEnt dirp + if e == mempty then return [] else do es <- _dirloop dirp return (t:es) @@ -261,8 +270,8 @@ _dirloop dirp = do -- | return the canonicalized absolute pathname -- -- like canonicalizePath, but uses @realpath(3)@ -realpath :: RawFilePath -> IO RawFilePath -realpath inp = +realpath :: PosixPath -> IO PosixPath +realpath (T.PS inp) = fmap T.PS $ allocaBytes pathMax $ \tmp -> do - void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp - BS.packCString tmp + void $ SBS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp + SBS.packCString tmp diff --git a/hpath/hpath.cabal b/hpath/hpath.cabal index e1373d1..58d3bbb 100644 --- a/hpath/hpath.cabal +++ b/hpath/hpath.cabal @@ -1,5 +1,5 @@ name: hpath -version: 0.12.1 +version: 0.13.1 synopsis: Support for well-typed paths description: Support for well-typed paths, utilizing ByteString under the hood. license: BSD3 @@ -20,9 +20,6 @@ extra-source-files: README.md CHANGELOG library - if os(windows) - build-depends: unbuildable<0 - buildable: False hs-source-dirs: src/ default-language: Haskell2010 if impl(ghc >= 8.0) @@ -30,12 +27,12 @@ library else ghc-options: -Wall exposed-modules: HPath - other-modules: HPath.Internal - build-depends: base >= 4.8 && <5 + HPath.Internal + build-depends: filepath >=1.4.99.5 + , base >= 4.8 && <5 , bytestring >= 0.10.0.0 , deepseq , exceptions - , hpath-filepath >= 0.10 && < 0.11 , template-haskell , utf8-string , word8 diff --git a/hpath/src/HPath.hs b/hpath/src/HPath.hs index 7ec8bd8..e258b70 100644 --- a/hpath/src/HPath.hs +++ b/hpath/src/HPath.hs @@ -19,6 +19,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiWayIf #-} module HPath ( @@ -34,9 +35,11 @@ module HPath #endif -- * Path Construction ,parseAbs + ,parseAbs' ,parseRel + ,parseRel' ,parseAny - ,rootPath + ,parseAny' ,pwdPath -- * Path Conversion ,fromAbs @@ -54,7 +57,6 @@ module HPath ,stripDir -- * Path Examination ,isParentOf - ,isRootPath ,isPwdPath -- * Path IO helpers ,withAbsPath @@ -65,26 +67,35 @@ module HPath ) where +import System.OsPath hiding (()) +import qualified System.OsPath as AFP import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow(..)) -#if MIN_VERSION_bytestring(0,10,8) -import Data.ByteString(ByteString, stripPrefix) -#else -import Data.ByteString(ByteString) import qualified Data.List as L -#endif -import qualified Data.ByteString as BS -import Data.ByteString.UTF8 import Data.Data import Data.Maybe -import Data.Word8 import HPath.Internal import Language.Haskell.TH import Language.Haskell.TH.Syntax (Lift(..), lift) -import qualified Language.Haskell.TH.Syntax as TH import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Prelude hiding (abs, any) -import System.Posix.FilePath hiding (()) +import System.OsString.Internal.Types +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +import qualified System.OsPath.Windows.Internal as Raw +import qualified System.OsPath.Data.ByteString.Short.Word16 as BS +#else +import qualified System.OsPath.Posix.Internal as Raw +import qualified System.OsPath.Data.ByteString.Short as BS +#endif + +-- $setup +-- >>> :set -XQuasiQuotes +-- >>> :set -XOverloadedStrings +-- >>> import Prelude hiding (abs, any) +-- >>> import HPath +-- >>> import qualified System.OsPath as AFP +-- >>> import Data.String +-- >>> instance IsString OsString where fromString = either (error . show) id . AFP.encodeUtf -------------------------------------------------------------------------------- @@ -93,14 +104,14 @@ import System.Posix.FilePath hiding (()) -- | An absolute path. data Abs deriving (Typeable) --- | A relative path; one without a root. +-- | A relative path; one without a drive. data Rel deriving (Typeable) -- | Exception when parsing a location. data PathParseException - = InvalidAbs ByteString - | InvalidRel ByteString - | Couldn'tStripPrefixTPS ByteString ByteString + = InvalidAbs OsPath + | InvalidRel OsPath + | Couldn'tStripPrefixTPS OsPath OsPath deriving (Show,Typeable) instance Exception PathParseException @@ -113,7 +124,7 @@ instance Exception PathException -- PatternSynonyms #if __GLASGOW_HASKELL__ >= 710 -pattern Path :: ByteString -> Path a +pattern Path :: OsPath -> Path a #endif #if __GLASGOW_HASKELL__ >= 708 pattern Path x <- (MkPath x) @@ -143,13 +154,20 @@ pattern Path x <- (MkPath x) -- >>> parseAbs "/abc/../foo" -- *** Exception: InvalidAbs "/abc/../foo" parseAbs :: MonadThrow m - => ByteString -> m (Path Abs) -parseAbs filepath = - if isAbsolute filepath && - isValid filepath && - not (hasParentDir filepath) - then return (MkPath . dropTrailingPathSeparator . normalise $ filepath) - else throwM (InvalidAbs filepath) + => OsPath -> m (Path Abs) +parseAbs filepath = do + if | isAbsolute filepath + , hasDrive filepath + , isValid filepath + , not (hasParentDir filepath) -> pure . MkPath . dropTrailingPathSeparator . normalise $ filepath + | otherwise -> throwM (InvalidAbs filepath) + + +parseAbs' :: MonadThrow m + => String -> m (Path Abs) +parseAbs' str = do + fp <- AFP.encodeUtf str + parseAbs fp -- | Get a location for a relative path. Produces a normalised @@ -183,15 +201,22 @@ parseAbs filepath = -- >>> parseRel ".." -- *** Exception: InvalidRel ".." parseRel :: MonadThrow m - => ByteString -> m (Path Rel) -parseRel filepath = - if not (isAbsolute filepath) && - filepath /= BS.pack [_period, _period] && - not (hasParentDir filepath) && - isValid filepath - then return (MkPath . dropTrailingPathSeparator . normalise $ filepath) - else throwM (InvalidRel filepath) - + => OsPath -> m (Path Rel) +parseRel filepath = do + if | not (isAbsolute filepath) + , not (hasDrive filepath) + , filepath /= [osp|..|] + , not (hasParentDir filepath) + , isValid filepath + -> return . MkPath . dropTrailingPathSeparator . normalise $ filepath + | otherwise + -> throwM (InvalidRel filepath) + +parseRel' :: MonadThrow m + => String -> m (Path Rel) +parseRel' str = do + fp <- AFP.encodeUtf str + parseRel fp -- | Parses a path, whether it's relative or absolute. @@ -216,39 +241,41 @@ parseRel filepath = -- Right "." -- >>> parseAny ".." -- *** Exception: InvalidRel ".." -parseAny :: MonadThrow m => ByteString -> m (Either (Path Abs) (Path Rel)) +parseAny :: MonadThrow m => OsPath -> m (Either (Path Abs) (Path Rel)) parseAny filepath = case parseAbs filepath of Just p -> pure $ Left p Nothing -> case parseRel filepath of Just p -> pure $ Right p Nothing -> throwM (InvalidRel filepath) +parseAny' :: MonadThrow m + => String -> m (Either (Path Abs) (Path Rel)) +parseAny' str = do + fp <- AFP.encodeUtf str + parseAny fp --- | The @"/"@ root path. -rootPath :: Path Abs -rootPath = (MkPath (BS.singleton _slash)) -- | The @"."@ pwd path. pwdPath :: Path Rel -pwdPath = (MkPath (BS.singleton _period)) +pwdPath = MkPath [osp|.|] -------------------------------------------------------------------------------- -- Path Conversion --- | Convert any Path to a ByteString type. -toFilePath :: Path b -> ByteString +-- | Convert any Path to an OsPath type. +toFilePath :: Path b -> OsPath toFilePath (MkPath l) = l --- | Convert an absolute Path to a ByteString type. -fromAbs :: Path Abs -> ByteString +-- | Convert an absolute Path to a OsPath type. +fromAbs :: Path Abs -> OsPath fromAbs = toFilePath --- | Convert a relative Path to a ByteString type. -fromRel :: Path Rel -> ByteString +-- | Convert a relative Path to a OsPath type. +fromRel :: Path Rel -> OsPath fromRel = toFilePath -fromAny :: Either (Path Abs) (Path Rel) -> ByteString +fromAny :: Either (Path Abs) (Path Rel) -> OsPath fromAny = either toFilePath toFilePath @@ -276,7 +303,7 @@ fromAny = either toFilePath toFilePath -- "." () :: Path b -> Path Rel -> Path b () (MkPath a) (MkPath b) = - MkPath (dropTrailingPathSeparator $ normalise (addTrailingPathSeparator a `BS.append` b)) + MkPath (dropTrailingPathSeparator $ normalise (a AFP. b)) -- | Strip directory from path, making it relative to that directory. @@ -303,9 +330,9 @@ fromAny = either toFilePath toFilePath stripDir :: MonadThrow m => Path b -> Path b -> m (Path Rel) stripDir (MkPath p) (MkPath l) | p == l = return pwdPath - | otherwise = case stripPrefix (addTrailingPathSeparator p) l of - Nothing -> throwM (Couldn'tStripPrefixTPS p l) - Just ok -> return (MkPath ok) + | otherwise = case L.stripPrefix (AFP.unpack $ addTrailingPathSeparator p) (AFP.unpack l) of + Nothing -> throwM (Couldn'tStripPrefixTPS p l) + Just ok -> return (MkPath $ AFP.pack ok) -- |Get all parents of a path. @@ -318,7 +345,7 @@ stripDir (MkPath p) (MkPath l) -- [] getAllParents :: Path Abs -> [Path Abs] getAllParents (MkPath p) - | np == BS.singleton pathSeparator = [] + | np == [osp|/|] = [] | otherwise = dirname (MkPath np) : getAllParents (dirname $ MkPath np) where np = normalise p @@ -336,14 +363,14 @@ getAllComponents :: Path Rel -> [Path Rel] getAllComponents (MkPath p) = fmap MkPath . splitDirectories $ p --- | Gets all path components after the "/" root directory. +-- | Gets all path components after the drive. -- -- >>> getAllComponentsAfterRoot [abs|/abs/def/dod|] -- ["abs","def","dod"] -- >>> getAllComponentsAfterRoot [abs|/abs|] -- ["abs"] getAllComponentsAfterRoot :: Path Abs -> [Path Rel] -getAllComponentsAfterRoot p = getAllComponents (fromJust $ stripDir rootPath p) +getAllComponentsAfterRoot (MkPath p) = getAllComponents (MkPath $ dropDrive p) -- | Extract the directory name of a path. @@ -362,7 +389,7 @@ dirname (MkPath fp) = MkPath (takeDirectory fp) -- -- @basename (p \<\/> a) == basename a@ -- --- Throws: `PathException` if given the root path "/" +-- Throws: `PathException` if given a drive (e.g. "/") -- -- >>> basename [abs|/abc/def/dod|] -- "dod" @@ -423,15 +450,6 @@ isParentOf p l = case stripDir p l :: Maybe (Path Rel) of | otherwise -> True --- | Check whether the given Path is the root "/" path. --- --- >>> isRootPath [abs|/lal/lad|] --- False --- >>> isRootPath [abs|/|] --- True -isRootPath :: Path Abs -> Bool -isRootPath = (== rootPath) - -- | Check whether the given Path is the pwd "." path. -- -- >>> isPwdPath [rel|lal/lad|] @@ -446,11 +464,11 @@ isPwdPath = (== pwdPath) -- Path IO helpers -withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a +withAbsPath :: Path Abs -> (OsPath -> IO a) -> IO a withAbsPath (MkPath p) action = action p -withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a +withRelPath :: Path Rel -> (OsPath -> IO a) -> IO a withRelPath (MkPath p) action = action p @@ -468,20 +486,10 @@ stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b) ------------------------ -- QuasiQuoters -instance Typeable a => Lift (Path a) where - lift (MkPath bs) = [| MkPath (BS.pack $(lift $ BS.unpack bs)) :: Path $(pure a) |] - where - a = TH.ConT $ TH.Name occ flav - where - tc = typeRepTyCon (typeRep (Proxy :: Proxy a)) - occ = TH.OccName (tyConName tc) - flav = TH.NameG TH.TcClsName (TH.PkgName (tyConPackage tc)) (TH.ModName (tyConModule tc)) - - -qq :: (ByteString -> Q Exp) -> QuasiQuoter +qq :: (String -> Q Exp) -> QuasiQuoter qq quoteExp' = QuasiQuoter - { quoteExp = (\s -> quoteExp' . fromString $ s) + { quoteExp = quoteExp' , quotePat = \_ -> fail "illegal QuasiQuote (allowed as expression only, used as a pattern)" , quoteType = \_ -> @@ -490,11 +498,11 @@ qq quoteExp' = fail "illegal QuasiQuote (allowed as expression only, used as a declaration)" } -mkAbs :: ByteString -> Q Exp -mkAbs = either (error . show) lift . parseAbs +mkAbs :: String -> Q Exp +mkAbs = either (fail . show) lift . parseAbs' -mkRel :: ByteString -> Q Exp -mkRel = either (error . show) lift . parseRel +mkRel :: String -> Q Exp +mkRel = either (fail . show) lift . parseRel' -- | Quasiquote an absolute Path. This accepts Unicode Chars and will encode as UTF-8. -- @@ -502,8 +510,8 @@ mkRel = either (error . show) lift . parseRel -- "/etc/profile" -- >>> [abs|/|] :: Path Abs -- "/" --- >>> [abs|/|] :: Path Abs --- "/\239\131\144" +-- >>> (\(MkPath p) -> decodeUtf p) ([abs|/ƛ|] :: Path Abs) +-- "/\411" abs :: QuasiQuoter abs = qq mkAbs @@ -513,8 +521,32 @@ abs = qq mkAbs -- "etc" -- >>> [rel|bar/baz|] :: Path Rel -- "bar/baz" --- >>> [rel||] :: Path Rel --- "\239\131\144" +-- >>> (\(MkPath p) -> decodeUtf p) ([rel|ƛ|] :: Path Rel) +-- "\411" rel :: QuasiQuoter rel = qq mkRel + +hasParentDir :: OsPath -> Bool +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +hasParentDir (OsString (WS fp)) = +#else +hasParentDir (OsString (PS fp)) = +#endif + predicate (`BS.cons` pathDoubleDot) + BS.isSuffixOf + || + predicate (\sep -> BS.singleton sep + `BS.append` pathDoubleDot + `BS.append` BS.singleton sep) + BS.isInfixOf + || + predicate (BS.snoc pathDoubleDot) + BS.isPrefixOf + where + pathDoubleDot = BS.pack [0x2e, 0x2e] + predicate f p = + foldr (\a b -> f a + `p` fp || b) + False + Raw.pathSeparators diff --git a/hpath/src/HPath/Internal.hs b/hpath/src/HPath/Internal.hs index 2d5077e..fbca932 100644 --- a/hpath/src/HPath/Internal.hs +++ b/hpath/src/HPath/Internal.hs @@ -1,4 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Internal types and functions. @@ -6,9 +10,12 @@ module HPath.Internal (Path(..)) where +import System.OsPath import Control.DeepSeq (NFData (..)) -import Data.ByteString (ByteString) import Data.Data +import GHC.Generics (Generic) +import Language.Haskell.TH.Syntax (Lift(..), lift) +import qualified Language.Haskell.TH.Syntax as TH -- | The main Path type. -- @@ -31,8 +38,8 @@ import Data.Data -- -- The constructor is not exposed. Instead, use the smart constructors -- 'HPath.parseAbs', 'HPath.parseRel' and 'HPath.parseAny'. -data Path b = MkPath ByteString - deriving (Typeable) +data Path b = MkPath OsPath + deriving (Typeable, Generic, NFData) -- | ByteString equality. -- @@ -58,6 +65,12 @@ instance Ord (Path b) where instance Show (Path b) where show (MkPath x) = show x -instance NFData (Path b) where - rnf (MkPath x) = rnf x +instance Typeable a => Lift (Path a) where + lift (MkPath bs) = [| MkPath bs :: Path $(pure a) |] + where + a = TH.ConT $ TH.Name occ flav + where + tc = typeRepTyCon (typeRep (Proxy :: Proxy a)) + occ = TH.OccName (tyConName tc) + flav = TH.NameG TH.TcClsName (TH.PkgName (tyConPackage tc)) (TH.ModName (tyConModule tc)) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..7f9d28e --- /dev/null +++ b/stack.yaml @@ -0,0 +1,27 @@ +resolver: lts-18.14 + +packages: + - ./hpath + - ./hpath-directory + - ./hpath-io + - ./hpath-posix + +extra-deps: + - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445 + - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269 + - streamly-bytestring-0.1.3@sha256:a13ddf464ead0f4d66a8ca7f8cd60e3a8198067a2e7ff98d662023bc220ebdd2,2477 + - streamly-0.8.0@sha256:9784c80ee1ada51477520cabc4e92a0c76a6bb265f968a188f2fce818e7398e0,19654 + - shortbytestring-0.1.0.0@sha256:b65a534f03eee496efaccc8ef5ba00e966589662c2ce6a0ba38e2112f025a09c,2403 + - word16-0.1.0.0@sha256:b15315a8572aafa05cdccecbe17b22cd89d33d7bbd7a86ac2003ae58686d99af,1549 + + - git: https://github.com/hasufell/abstract-filepath.git + commit: 535133eb0eda91c55e96832bcede4b65f74e3fb9 + subdirs: + - abstract-filepath + - abstract-filepath-types + - abstract-filepath-unix + - abstract-filepath-Win32 + + - git: https://github.com/hasufell/streamly-posix.git + commit: e14e5e877c584f7d7bf2fb10cb80bc331126fd5d + diff --git a/streamly-posix/.gitignore b/streamly-posix/.gitignore new file mode 100644 index 0000000..a1f77f5 --- /dev/null +++ b/streamly-posix/.gitignore @@ -0,0 +1,4 @@ +dist/ +dist-newstyle/ +.ghci +cabal.project.local diff --git a/streamly-posix/CHANGELOG.md b/streamly-posix/CHANGELOG.md new file mode 100644 index 0000000..b9b7f43 --- /dev/null +++ b/streamly-posix/CHANGELOG.md @@ -0,0 +1,14 @@ +# Revision history for streamly-posix + +## 0.1.0.2 -- 2021-08-12 + +* Make compatible with streamly 0.8.0 +* Update bounds + +## 0.1.0.1 -- 2020-05-09 + +* fix build with older GHCs + +## 0.1.0.0 -- 2020-02-16 + +* First version. Released on an unsuspecting world. diff --git a/hpath-filepath/LICENSE b/streamly-posix/LICENSE similarity index 100% rename from hpath-filepath/LICENSE rename to streamly-posix/LICENSE diff --git a/streamly-posix/README.md b/streamly-posix/README.md new file mode 100644 index 0000000..ddff0de --- /dev/null +++ b/streamly-posix/README.md @@ -0,0 +1,14 @@ +# streamly-posix + +[![Build Status](https://api.travis-ci.org/hasufell/streamly-posix.png?branch=master)](http://travis-ci.org/hasufell/streamly-posix) + +POSIX related streaming APIs. + +## Motivation + +Since upstream wants to stay cross-platform, this library provides +strictly POSIX only API. + +## TODO + +* [ ] Fd based streaming (some is in internal modules of streamly) diff --git a/hpath-filepath/Setup.hs b/streamly-posix/Setup.hs similarity index 100% rename from hpath-filepath/Setup.hs rename to streamly-posix/Setup.hs diff --git a/streamly-posix/cabal.project b/streamly-posix/cabal.project new file mode 100644 index 0000000..aa3d7dd --- /dev/null +++ b/streamly-posix/cabal.project @@ -0,0 +1,14 @@ +packages: ./streamly-posix.cabal + https://hackage.haskell.org/package/filepath-2.0.0.0/candidate/filepath-2.0.0.0.tar.gz + +source-repository-package + type: git + location: https://github.com/hasufell/unix.git + tag: 4d7bce9d85f077908f699532673e12ae66b178b0 + +source-repository-package + type: git + location: https://github.com/hasufell/Win32.git + tag: a2ab9bc501614c48c62f9508488e87f0c2924b7b + +allow-newer: filepath diff --git a/streamly-posix/src/Streamly/External/Posix/DirStream.hs b/streamly-posix/src/Streamly/External/Posix/DirStream.hs new file mode 100644 index 0000000..fcc00e7 --- /dev/null +++ b/streamly-posix/src/Streamly/External/Posix/DirStream.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiWayIf #-} + +-- | +-- Module : Streamly.External.Posix.DirStream +-- Copyright : © 2020 Julian Ospald +-- License : BSD3 +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- This module provides high-level file streaming API, +-- working with directory streams (POSIX). +module Streamly.External.Posix.DirStream + ( + -- * Directory listing + unfoldDirContents + , dirContentsStream + , dirContents + ) +where + +import Control.Exception.Safe +import Control.Monad.IO.Class ( liftIO + , MonadIO + ) +import Prelude hiding ( readFile ) +import System.Posix.ByteString +import System.Posix.Directory.ByteString + as PosixBS +import System.Posix.Foreign ( DirType ) +import System.Posix.PosixFilePath.Directory.Traversals + hiding ( getDirectoryContents ) +import qualified Streamly.Internal.Data.Stream.StreamD.Type + as D +#if MIN_VERSION_streamly(0,7,1) +import qualified Streamly.Internal.Data.Unfold as SIU +#endif +#if MIN_VERSION_streamly(0,8,0) +import Streamly.Prelude +import Streamly.Internal.Data.Unfold.Type +#else +import Streamly +import Streamly.Internal.Data.Unfold.Types +import qualified Streamly.Internal.Prelude as S +#endif + +import System.OsPath.Posix + + +-- | Create an 'Unfold' of directory contents. +unfoldDirContents :: MonadIO m => Unfold m DirStream (DirType, PosixPath) +unfoldDirContents = Unfold step return + where + {-# INLINE [0] step #-} + step dirstream = do + (typ, e) <- liftIO $ readDirEnt dirstream + return $ if + | e == mempty -> D.Stop + | [unsafeFromChar '.'] == unpack e -> D.Skip dirstream + | [unsafeFromChar '.', unsafeFromChar '.'] + == unpack e -> D.Skip dirstream + | otherwise -> D.Yield (typ, e) dirstream + + +-- | Read the directory contents as a stream. +-- +-- The DirStream is closed automatically, when the streamly stream exits +-- normally, aborts or gets garbage collected. +-- The stream must not be used after the dirstream is closed. +dirContentsStream :: (MonadCatch m, MonadAsync m, MonadMask m) + => DirStream + -> SerialT m (DirType, PosixPath) +dirContentsStream ds = +#if MIN_VERSION_streamly(0,8,0) + unfold (SIU.finally (liftIO . PosixBS.closeDirStream) unfoldDirContents) $ ds +#else +#if MIN_VERSION_streamly(0,7,1) + S.unfold (SIU.finallyIO (liftIO . PosixBS.closeDirStream) unfoldDirContents) $ ds +#else + S.finally (liftIO . PosixBS.closeDirStream $ ds) . S.unfold unfoldDirContents $ ds +#endif +#endif + + +-- | Read the directory contents strictly as a list. +-- +-- The DirStream is closed automatically. +dirContents :: (MonadCatch m, MonadAsync m, MonadMask m) + => DirStream + -> m [(DirType, PosixPath)] +#if MIN_VERSION_streamly(0,8,0) +dirContents = toList . dirContentsStream +#else +dirContents = S.toList . dirContentsStream +#endif + diff --git a/streamly-posix/streamly-posix.cabal b/streamly-posix/streamly-posix.cabal new file mode 100644 index 0000000..b3d98f6 --- /dev/null +++ b/streamly-posix/streamly-posix.cabal @@ -0,0 +1,59 @@ +cabal-version: >=1.10 +name: streamly-posix +version: 0.2.0.0 +license: BSD3 +license-file: LICENSE +copyright: Julian Ospald 2020 +maintainer: Julian Ospald +author: Julian Ospald +bug-reports: https://github.com/hasufell/streamly-posix/issues +synopsis: Posix related streaming APIs +description: Posix related streaming APIs (such as file reading/writing) +category: Streaming +build-type: Simple +extra-source-files: CHANGELOG.md + +source-repository head + type: git + location: https://github.com/hasufell/streamly-posix + +library + exposed-modules: Streamly.External.Posix.DirStream + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: + -Wall -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 + + build-depends: + base >=4.8 && <5 + , hpath-posix >=0.14 && <0.15 + , filepath >=1.4.99.5 + , safe-exceptions >=0.1 && <0.2 + , streamly >=0.7 && <0.9 + , streamly-bytestring >=0.1.0.1 && <0.2 + , transformers >=0.5.6.2 && <0.6 + , unix >=2.8 + + if os(windows) + buildable: False + build-depends: unbuildable <0 + +test-suite sf-test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.8 && <5 + , filepath >=1.4.2.1 && <1.5 + , hpath-posix >=0.14 && <0.15 + , hspec >=2.7.10 && <2.9 + , hspec-discover >=2.7.10 && <2.9 + , streamly-posix + , temporary >=1.3 && <1.4 + , unix >=2.8 + + if os(windows) + buildable: False + build-depends: unbuildable <0 diff --git a/streamly-posix/test/Main.hs b/streamly-posix/test/Main.hs new file mode 100644 index 0000000..b847684 --- /dev/null +++ b/streamly-posix/test/Main.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Main where + +import Data.Foldable +import Data.List ( sortBy ) +import Streamly.External.Posix.DirStream +import System.FilePath +import System.IO +import System.IO.Temp +import System.Posix.Directory as Posix +import System.Posix.Foreign +import Test.Hspec +import System.OsString.Internal.Types +import qualified System.OsPath.Posix as P +import Data.String + +instance IsString PosixString where + fromString = either (error . show) id . P.encodeUtf + + +checkDirContents :: FilePath -> IO () +checkDirContents fp = do + let f1 = fp "f1" + let f2 = fp "f2" + let f3 = fp "f3" + let f4 = fp "f4" + for_ [f1, f2, f3, f4] $ \f -> openFile f ReadWriteMode + ds <- Posix.openDirStream fp + contents <- fmap (sortBy (\(_, y) (_, z) -> compare y z)) $ dirContents ds + contents + `shouldBe` [ (DirType 8, "f1") + , (DirType 8, "f2") + , (DirType 8, "f3") + , (DirType 8, "f4") + ] + + + + +main :: IO () +main = hspec $ do + describe "Streamly.External.FileSystem.DirStream.Posix" $ do + it "dirContents" $ withSystemTempDirectory "y" checkDirContents