#!/bin/sh

# This script generates:
# ../../libraries:
#	copies of the heirarchical libraries suitable for
#	use with Hugs.  Note that some of the libraries require extensions
#	to Haskell 98 and have to be run with the -98 flag.
# ../../oldlib:
#	compatibility stubs for old Hugs libraries
#
# A HUGSPATH consisting of both of these should approximate the old libs,
# and be fairly compatible with GHC.  If you're completely switched over,
# delete the second one.
#
# Usage:
#
#   ./convert_libraries  <directory where libraries lives>

cpp_flags='-D__HUGS__'
cpp="gcc -P -E -traditional -xc $cpp_flags"
cc="gcc -xc $cpp_flags"

hugs_src=../../lib
dst=../../libraries
compat=../../oldlib

case $# in
1)	;;
*)	echo "usage: $0 <directory where libraries lives>"
	exit 1 ;;
esac

src=$1/libraries
if [ ! -d $src ]; then
	echo "Can't find libraries in directory '$1'" >&2
	exit 1
fi

hs_src=$1/hslibs
if [ ! -d $hs_src ]; then
	echo "Can't find hslibs in directory '$1'" >&2
	exit 1
fi

# Convert a hierarchical library module for use with Hugs

cvt() {
	case $# in
	2)	;;
	*)	echo "usage: cvt package file" >&2
		exit 1 ;;
	esac

	echo "Converting $1/$2"
	dstdir=`dirname $dst/$2`
	mkdir -p $dstdir

	includes="-I. -I.. -I$src/$1/include"

	case "$2" in
	*.lhs|*.hs)
		$cpp $includes $src/$1/$2 | cat -s >$dst/$2
		;;
	*.hsc)
		# with a hack to extract the -#include directives
		stem="`basename $2 .hsc`"
		target="$dstdir/$stem.hs"
		header="${stem}_aux.h"
		# don't run hsc2hs if its output is already present
		c_file="`dirname $src/$1/$2`/${stem}_hsc_make.c"
		if [ -f "$c_file" ]
		then
			hsc_make="$dstdir/${stem}_hsc_make"
			$cc $includes -o "$hsc_make" "$c_file"
			$hsc_make | sed '/^foreign.*"[^ ]*"/ s/"/"'"$header /" >$target
			rm "$hsc_make"
		else
			copy="$dstdir/`basename $2`"
			sed '/^foreign.*"[^ ]*"/ s/"/"'"$header /" "$src/$1/$2" >$copy
			hsc2hs $cpp_flags $includes "$copy"
			rm "$copy"
		fi
		sed -n 's/^{-# OPTIONS -\(#include .*\) #-}/\1/p' $target >"$dstdir/$header"
		;;
	*.y|*.ly)
		inname=`basename $2`
		case $2 in
		*.ly)	outname="`basename $2 .ly`.hs" ;;
		*)	outname="`basename $2 .y`.hs" ;;
		esac

		target="`dirname $dst/$2`/$outname"

		# don't run happy if the happy output is already present
		hs_file="`dirname $src/$1/$2`/$outname"
		if [ -f "$hs_file" ]
		then
			$cpp "$hs_file" | cat -s >$target
		else
			tmpdir=/tmp/cvt.$$
			mkdir $tmpdir
			cp $src/$1/$2 $tmpdir/$inname
			(
				cd $tmpdir
				happy $inname
			)
			$cpp $tmpdir/$outname | cat -s >$target
			rm -r $tmpdir
		fi 
		;;
	*)	echo "cvt: don't know how to handle $1/$2" >&2
		exit 1 ;;
	esac
}

# For when we cannot use the new module yet: use a Hugs file as a
# stopgap replacement.

nocvt() {
	case $# in
	3)	;;
	*)	echo "usage: nocvt package file hugslib" >&2
		exit 1 ;;
	esac

	echo "Replacing $1/$2 with $3"
	dstdir=`dirname $dst/$2`
	mkdir -p $dstdir

	new_stem=`echo $2 | sed 's/\..*//'`
	new_module=`echo $2 | sed 's/\..*//' | tr / .`
	old_extension=`echo $3 | sed 's/[^.]*//'`
	old_module=`basename $3 $old_extension`
	sed "	s/module[ 	][ 	]*$old_module\$/module $new_module/g
		s/module[ 	][ 	]*$old_module\\([ (]\\)/module $new_module\\1/g
		s/import IOExts/import Hugs.IOExts/
		s/import Array/import Hugs.Array/
		s/import Char/import Data.Char/
		s/import List/import Data.List/
		s/import Ratio/import Data.Ratio/
		s/import Locale/import System.Locale/
		s/import Time/import System.Time/
		s/import Ptr/import Foreign.Ptr/
		s/import CTypes/import Foreign.C.Types/
		s/import Marshal/import Foreign.Marshal./
		s/import Exception/import Control.Exception/
		s/import Storable/import Foreign.Storable/
		s/import ForeignPtr/import Foreign.ForeignPtr/
		s/import ST/import Hugs.ST/
		s/import Dynamic/import Data.Dynamic/
		/hiding (print/!s/import Prelude/import Hugs.Prelude/
		s/import HugsInternals/import Hugs.Internals/
		" $hugs_src/$3 >$dst/$new_stem$old_extension
}

# Create a compatibility stub for a Hugs extension module

stub() {
	case $# in
	0)	echo "usage: stub module [module ...]" >&2
		exit 1 ;;
	esac

	stub_module=$1
	shift
	echo "Stub $stub_module -> $*"
	(
		echo "module $stub_module("
		for real
		do	echo "	module $real,"
		done
		echo '    ) where'
		echo
		if [ $stub_module = Exception ]		# gross kludge
		then	echo "import Prelude hiding (catch)"
		fi
		for real
		do	echo "import $real"
		done
	) >$compat/$stub_module.hs
}

# Copy the Hugs version to the compatibility lib

libexts() {
	case $# in
	1)	;;
	*)	echo "usage: libexts module" >&2
		exit 1 ;;
	esac

	name="`ls ../../lib/exts/$1.*hs`"
	echo "Copy `basename $name`"
	sed 's/import Prelude/import Hugs.Prelude/' $name >$compat/`basename $name`
}

libhugs() {
	case $# in
	1)	;;
	*)	echo "usage: libhugs module" >&2
		exit 1 ;;
	esac

	name="`ls ../../lib/hugs/$1.*hs`"
	echo "Copy `basename $name`"
	sed 's/import Prelude/import Hugs.Prelude/' $name >$compat/`basename $name`
}

# Convert the hslibs version to the compatibility lib

hslibs() {
	case $# in
	2)	;;
	*)	echo "usage: hslibs dir file" >&2
		exit 1 ;;
	esac

	echo "Converting $2"
	$cpp $hs_src/$1/$2 >$compat/$2
}

# Modules to convert

# Those with an extra arg simply use a Hugs module instead. (to be fixed)

  cvt base Control/Arrow.hs
# cvt base Control/Concurrent.hs	# Hugs lacks ThreadId
  cvt base Control/Concurrent/Chan.hs
  cvt base Control/Concurrent/MVar.hs
  cvt base Control/Concurrent/QSem.hs
  cvt base Control/Concurrent/QSemN.hs
  cvt base Control/Concurrent/SampleVar.hs
  cvt base Control/Exception.hs
  cvt base Control/Monad.hs
  cvt base Control/Monad/Cont.hs
  cvt base Control/Monad/Error.hs
  cvt base Control/Monad/Fix.hs
  cvt base Control/Monad/Identity.hs
  cvt base Control/Monad/List.hs
  cvt base Control/Monad/Monoid.hs
  cvt base Control/Monad/RWS.hs
  cvt base Control/Monad/Reader.hs
  cvt base Control/Monad/ST.hs
  cvt base Control/Monad/ST/Lazy.hs
  cvt base Control/Monad/ST/Strict.hs
  cvt base Control/Monad/State.hs
  cvt base Control/Monad/Trans.hs
  cvt base Control/Monad/Writer.hs
  cvt base Control/Parallel.hs
# cvt base Control/Parallel/Strategies.hs	# unused by GHC
  cvt base Data/Array.hs
  cvt base Data/Array/Base.hs
# cvt base Data/Array/Diff.hs
  cvt base Data/Array/IArray.hs
  cvt base Data/Array/IO.hs
  cvt base Data/Array/MArray.hs
  cvt base Data/Array/ST.hs
  cvt base Data/Array/Storable.hs	
# cvt base Data/Array/Unboxed.hs	# GHC-specific
  cvt base Data/Bits.hs
  cvt base Data/Bool.hs
  cvt base Data/Char.hs
  cvt base Data/Complex.hs
  cvt base Data/Dynamic.hs
  cvt base Data/Either.hs
  cvt base Data/FiniteMap.hs
# cvt base Data/Generics.hs		# GHC-specific
  cvt base Data/IORef.hs
  cvt base Data/Int.hs
  cvt base Data/Ix.hs
  cvt base Data/List.hs
  cvt base Data/Maybe.hs
# cvt base Data/PackedString.hs		# uses Data.Array.Unboxed
  cvt base Data/Ratio.hs
  cvt base Data/STRef.hs
  cvt base Data/STRef/Lazy.hs
  cvt base Data/STRef/Strict.hs
  cvt base Data/Set.hs
  cvt base Data/Tuple.hs
  cvt base Data/Unique.hs
  cvt base Data/Word.hs
  cvt base Debug/QuickCheck.hs
# cvt base Debug/QuickCheck/Batch.hs	# needs Control.Concurrent.myThreadId
  cvt base Debug/QuickCheck/Poly.hs
  cvt base Debug/QuickCheck/Utils.hs
  cvt base Debug/Trace.hs
  cvt base Foreign.hs
  cvt base Foreign/C.hs
  cvt base Foreign/C/Error.hs
  cvt base Foreign/C/String.hs		
  cvt base Foreign/C/Types.hs
  cvt base Foreign/C/TypesISO.hs
nocvt base Foreign/ForeignPtr.hs        exts/ForeignPtr.hs
  cvt base Foreign/Marshal/Alloc.hs
  cvt base Foreign/Marshal/Array.hs
  cvt base Foreign/Marshal/Error.hs
  cvt base Foreign/Marshal/Utils.hs
nocvt base Foreign/Ptr.hs		exts/Ptr.hs	# incomplete
  cvt base Foreign/StablePtr.hs
  cvt base Foreign/Storable.hs		
  cvt base Numeric.hs
  cvt base Prelude.hs
nocvt base System/CPUTime.hsc		CPUTime.hs	# Hugs primitives
  cvt base System/Cmd.hs
  cvt base System/Console/GetOpt.hs
nocvt base System/Directory.hs		Directory.hs	# Hugs primitives
  cvt base System/Environment.hs
  cvt base System/Exit.hs
  cvt base System/IO.hs
  cvt base System/IO/Error.hs
  cvt base System/IO/Unsafe.hs
# cvt base System/Info.hs
  cvt base System/Locale.hs
  cvt base System/Mem.hs
  cvt base System/Mem/StableName.hs
  cvt base System/Mem/Weak.hs
  cvt base System/Random.hs
# cvt base System/Posix/Signals.hsc
  cvt base System/Posix/Types.hs
nocvt base System/Time.hsc		Time.hs		# Hugs primitives
  cvt base Text/Html.hs
  cvt base Text/Html/BlockTable.hs
  cvt base Text/ParserCombinators/Parsec.hs
  cvt base Text/ParserCombinators/Parsec/Char.hs
  cvt base Text/ParserCombinators/Parsec/Combinator.hs
  cvt base Text/ParserCombinators/Parsec/Error.hs
  cvt base Text/ParserCombinators/Parsec/Expr.hs
  cvt base Text/ParserCombinators/Parsec/Language.hs
  cvt base Text/ParserCombinators/Parsec/Perm.hs
  cvt base Text/ParserCombinators/Parsec/Pos.hs
  cvt base Text/ParserCombinators/Parsec/Prim.hs
  cvt base Text/ParserCombinators/Parsec/Token.hs
# cvt base Text/ParserCombinators/ReadP.hs	# ReadS clashes with Prelude
# cvt base Text/ParserCombinators/ReadPrec.hs	# uses ReadP
  cvt base Text/PrettyPrint.hs
  cvt base Text/PrettyPrint/HughesPJ.hs
  cvt base Text/Read.hs
# cvt base Text/Read/Lex.hs		# uses ReadP
  cvt base Text/Regex.hs
  cvt base Text/Regex/Posix.hsc
  cvt base Text/Show.hs
  cvt base Text/Show/Functions.hs

  # Haskell 98 Library Report (minus Numeric, which is in base)

  cvt haskell98 Array.hs
  cvt haskell98 CPUTime.hs
  cvt haskell98 Char.hs
  cvt haskell98 Complex.hs
  cvt haskell98 Directory.hs
  cvt haskell98 IO.hs
  cvt haskell98 Ix.hs
  cvt haskell98 List.hs
  cvt haskell98 Locale.hs
  cvt haskell98 Maybe.hs
  cvt haskell98 Monad.hs
  cvt haskell98 Random.hs
  cvt haskell98 Ratio.hs
  cvt haskell98 System.hs
  cvt haskell98 Time.hs

  # FFI Addendum

  cvt haskell98 Bits.hs
  cvt haskell98 CError.hs
  cvt haskell98 CForeign.hs
  cvt haskell98 CString.hs
  cvt haskell98 CTypes.hs
  cvt haskell98 ForeignPtr.hs
# cvt haskell98 Int.hs		# not yet: lacks the deprecated stuff
  cvt haskell98 MarshalAlloc.hs
  cvt haskell98 MarshalArray.hs
  cvt haskell98 MarshalError.hs
  cvt haskell98 MarshalUtils.hs
  cvt haskell98 Ptr.hs
  cvt haskell98 StablePtr.hs
  cvt haskell98 Storable.hs
# cvt haskell98 Word.hs		# not yet: lacks the deprecated stuff

  cvt haskell-src Language/Haskell/Parser.ly
  cvt haskell-src Language/Haskell/Lexer.hs
  cvt haskell-src Language/Haskell/ParseMonad.hs
  cvt haskell-src Language/Haskell/ParseUtils.hs
  cvt haskell-src Language/Haskell/Pretty.hs
  cvt haskell-src Language/Haskell/Syntax.hs
  cvt haskell-src Language/Haskell/THSyntax.hs

# cvt network Network.hs
# cvt network Network/BSD.hsc
# cvt network Network/CGI.hs
# cvt network Network/Socket.hsc
  cvt network Network/URI.hs

# cvt readline System/Console/Readline.hsc

# cvt unix System/Posix.hs
# cvt unix System/Posix/Directory.hsc
# cvt unix System/Posix/Files.hsc
# cvt unix System/Posix/IO.hsc
# cvt unix System/Posix/Process.hsc
# cvt unix System/Posix/Unistd.hsc

# Hugs-only modules

nocvt hugs Hugs/CVHAssert.hs		hugs/CVHAssert.hs
nocvt hugs Hugs/GenericPrint.hs		hugs/GenericPrint.hs
nocvt hugs Hugs/Internals.hs		hugs/HugsInternals.hs
nocvt hugs Hugs/Memo.hs			exts/Memo.hs
nocvt hugs Hugs/Observe.lhs		exts/Observe.lhs
nocvt hugs Hugs/Quote.hs		hugs/Quote.hs
nocvt hugs Hugs/Trace.hs		hugs/Trace.hs
nocvt hugs Hugs/Trex.hs			hugs/Trex.hs

  echo Copying FFI support files
  cp ../../lib/exts/Storable_aux.[ch]   $dst/Hugs
  cp ../config.h                        $dst/Foreign/C
  cp $src/base/cbits/errno.c            $dst/Foreign/C
  cp $src/base/include/*.h              $dst/Foreign/C

# Compatibility with lib/exts:

mkdir -p $compat

# Hugs-only modules

  stub ConcBase		Hugs.ConcBase
  stub HugsStorable	Hugs.Storable
  stub Memo		Hugs.Memo	# hslibs module is different
  stub Observe		Hugs.Observe	# hslibs module is different

# Stuff from hslibs (many of these are stubs)

  hslibs concurrent CVar.lhs
  hslibs concurrent Chan.lhs
  hslibs concurrent Channel.lhs
  hslibs concurrent ChannelVar.lhs
# hslibs concurrent Concurrent.lhs	# -> Control.Concurrent
 libexts Concurrent
  hslibs concurrent MVar.lhs
# hslibs concurrent Merge.lhs
 libexts Merge				# deprecated Hugs lib
  hslibs concurrent Parallel.lhs
  hslibs concurrent QSem.lhs
  hslibs concurrent QSemN.lhs
  hslibs concurrent SampleVar.lhs
  hslibs concurrent Semaphore.lhs
# hslibs concurrent Strategies.lhs

  hslibs data FiniteMap.lhs
  hslibs data Set.lhs

  cp $hs_src/data/edison/COPYRIGHT $compat/COPYRIGHT.edison
  hslibs data/edison/Assoc Assoc.hs
  hslibs data/edison/Assoc AssocDefaults.hs
  hslibs data/edison/Assoc AssocList.hs
  hslibs data/edison/Assoc PatriciaLoMap.hs
  hslibs data/edison EdisonPrelude.hs
  hslibs data/edison/Coll Collection.hs
  hslibs data/edison/Coll CollectionDefaults.hs
  hslibs data/edison/Coll CollectionUtils.hs
  hslibs data/edison/Coll LazyPairingHeap.hs
  hslibs data/edison/Coll LeftistHeap.hs
  hslibs data/edison/Coll MinHeap.hs
  hslibs data/edison/Coll SkewHeap.hs
  hslibs data/edison/Coll SplayHeap.hs
  hslibs data/edison/Coll TestOrdBag.hs
  hslibs data/edison/Coll TestOrdSet.hs
  hslibs data/edison/Coll UnbalancedSet.hs
  hslibs data/edison/Seq BankersQueue.hs
  hslibs data/edison/Seq BinaryRandList.hs
  hslibs data/edison/Seq BraunSeq.hs
  hslibs data/edison/Seq JoinList.hs
  hslibs data/edison/Seq ListSeq.hs
  hslibs data/edison/Seq MyersStack.hs
  hslibs data/edison/Seq RandList.hs
  hslibs data/edison/Seq RevSeq.hs
  hslibs data/edison/Seq Sequence.hs
  hslibs data/edison/Seq SequenceDefaults.hs
  hslibs data/edison/Seq SimpleQueue.hs
  hslibs data/edison/Seq SizedSeq.hs
  hslibs data/edison/Seq TestSeq.hs

# hslibs lang Addr.lhs			# deprecated
 libexts Addr
  hslibs lang ArrayBase.hs		# -> Data.Array.Base
  hslibs lang Arrow.hs
# hslibs lang ByteArray.lhs		# deprecated
# hslibs lang CCall.lhs			# GHC-specific (and obsolete)
  hslibs lang CTypesISO.hs
# hslibs lang DiffArray.hs		# -> Data.Array.Diff
# hslibs lang DirectoryExts.hs
  hslibs lang Dynamic.hs
# hslibs lang Exception.hs
  stub Exception	Hugs.Exception Control.Exception
# hslibs lang ForeignObj.lhs		# deprecated
 libexts ForeignObj			# uses Hugs primitives
# hslibs lang Generics.hs		# GHC-specific
# hslibs lang GlaExts.lhs		# deprecated
  hslibs lang IArray.hs
# hslibs lang IOExts.hs
  stub IOExts		Hugs.IOExts Hugs.IORef Hugs.IOArray
  hslibs lang IORef.hs
# hslibs lang LazyST.hs
  stub LazyST		Hugs.LazyST
# hslibs lang MArray.hs			# lots of GHC stuff (and obsolete)
# hslibs lang MutableArray.lhs		# deprecated
# hslibs lang NativeInfo.hs		# -> System.Info
  hslibs lang NumExts.lhs
# hslibs lang PackedString.lhs		# GHC-specific
# hslibs lang PrelByteArr.lhs		# GHC-specific
# hslibs lang ST.hs			# GHC-specific
  stub ST		Hugs.ST
  hslibs lang ShowFunctions.hs
  hslibs lang Stable.hs
  hslibs lang StableName.hs
  hslibs lang StorableArray.hs		# -> Data.Array.Storable
# hslibs lang SystemExts.lhs		# GHC-specific
# hslibs lang TimeExts.lhs
  hslibs lang Weak.hs

  stub Int		Hugs.Int	# includes deprecated functions
  stub Word		Hugs.Word	# includes deprecated functions

  hslibs lang/monads MonadCont.lhs
  hslibs lang/monads MonadEither.lhs
  hslibs lang/monads MonadError.lhs
  hslibs lang/monads MonadFix.lhs
  hslibs lang/monads MonadIdentity.lhs
  hslibs lang/monads MonadList.lhs
  hslibs lang/monads MonadRWS.lhs
  hslibs lang/monads MonadReader.lhs
  hslibs lang/monads MonadState.lhs
  hslibs lang/monads MonadTrans.lhs
  hslibs lang/monads MonadWriter.lhs
  hslibs lang/monads Monoid.lhs

# hslibs text MatchPS.lhs
  hslibs text Pretty.lhs
# hslibs text Regex.lhs
# hslibs text RegexString.lhs

  hslibs text/html Html.lhs
  hslibs text/html HtmlBlockTable.lhs

  hslibs text/parsec Parsec.hs
  hslibs text/parsec ParsecChar.hs
  hslibs text/parsec ParsecCombinator.hs
  hslibs text/parsec ParsecError.hs
  hslibs text/parsec ParsecExpr.hs
  hslibs text/parsec ParsecLanguage.hs
  hslibs text/parsec ParsecPerm.hs
  hslibs text/parsec ParsecPos.hs
  hslibs text/parsec ParsecPrim.hs
  hslibs text/parsec ParsecToken.hs

  hslibs util GetOpt.lhs
# hslibs util MD5.lhs			# needs PackedString, etc
# hslibs util Memo.lhs			# Hugs module is different
# hslibs util Observe.lhs		# Hugs module is different
# hslibs util Select.lhs
  hslibs util Unique.lhs

  hslibs util/check QuickCheck.hs
# hslibs util/check QuickCheckBatch.hs	# -> Debug.QuickCheck.Batch
  hslibs util/check QuickCheckPoly.hs
  hslibs util/check QuickCheckUtils.hs

# Compatibility with lib/hugs:

  libhugs AnsiInteract
  libhugs AnsiScreen
     stub CVHAssert		Hugs.CVHAssert
     stub GenericPrint		Hugs.GenericPrint
  libhugs HugsDynamic				# temporary measure
     stub HugsInternals		Hugs.Internals
  libhugs HugsLibs				# only useful for testing
  libhugs IOExtensions
  libhugs Interact
  libhugs ListUtils
  libhugs Number
  libhugs ParseLib
     stub Quote			Hugs.Quote	# only hugs supports here docs
  libhugs StdLibs				# only useful for testing
     stub Trace			Hugs.Trace
     stub Trex			Hugs.Trex	# only hugs supports Trex
