-- GENERATED by C->Haskell Compiler, version 0.16.5 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "lib/Data/Text/IDN/IDNA.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}

-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module Data.Text.IDN.IDNA
	( Flags (..)
	, Error
	, defaultFlags
	, toASCII
	, toUnicode
	) where

import Control.Exception (ErrorCall(..), throwIO)
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified System.IO.Unsafe as Unsafe

import Foreign
import Foreign.C

import Data.Text.IDN.Internal


data Idna_rc = SUCCESS
             | STRINGPREP_ERROR
             | PUNYCODE_ERROR
             | CONTAINS_NON_LDH
             | CONTAINS_LDH
             | CONTAINS_MINUS
             | INVALID_LENGTH
             | NO_ACE_PREFIX
             | ROUNDTRIP_VERIFY_ERROR
             | CONTAINS_ACE_PREFIX
             | ICONV_ERROR
             | MALLOC_ERROR
             | DLOPEN_ERROR
             
instance Enum Idna_rc where
  fromEnum SUCCESS = 0
  fromEnum STRINGPREP_ERROR = 1
  fromEnum PUNYCODE_ERROR = 2
  fromEnum CONTAINS_NON_LDH = 3
  fromEnum CONTAINS_LDH = 3
  fromEnum CONTAINS_MINUS = 4
  fromEnum INVALID_LENGTH = 5
  fromEnum NO_ACE_PREFIX = 6
  fromEnum ROUNDTRIP_VERIFY_ERROR = 7
  fromEnum CONTAINS_ACE_PREFIX = 8
  fromEnum ICONV_ERROR = 9
  fromEnum MALLOC_ERROR = 201
  fromEnum DLOPEN_ERROR = 202

  toEnum 0 = SUCCESS
  toEnum 1 = STRINGPREP_ERROR
  toEnum 2 = PUNYCODE_ERROR
  toEnum 3 = CONTAINS_NON_LDH
  toEnum 3 = CONTAINS_LDH
  toEnum 4 = CONTAINS_MINUS
  toEnum 5 = INVALID_LENGTH
  toEnum 6 = NO_ACE_PREFIX
  toEnum 7 = ROUNDTRIP_VERIFY_ERROR
  toEnum 8 = CONTAINS_ACE_PREFIX
  toEnum 9 = ICONV_ERROR
  toEnum 201 = MALLOC_ERROR
  toEnum 202 = DLOPEN_ERROR
  toEnum unmatched = error ("Idna_rc.toEnum: Cannot match " ++ show unmatched)

{-# LINE 39 "lib/Data/Text/IDN/IDNA.chs" #-}

data Idna_flags = ALLOW_UNASSIGNED
                | USE_STD3_ASCII_RULES
                
instance Enum Idna_flags where
  fromEnum ALLOW_UNASSIGNED = 1
  fromEnum USE_STD3_ASCII_RULES = 2

  toEnum 1 = ALLOW_UNASSIGNED
  toEnum 2 = USE_STD3_ASCII_RULES
  toEnum unmatched = error ("Idna_flags.toEnum: Cannot match " ++ show unmatched)

{-# LINE 41 "lib/Data/Text/IDN/IDNA.chs" #-}

data Flags = Flags
	{ verifySTD3 :: Bool
	-- ^ Check output to make sure it is a STD3-conforming host name
	
	, allowUnassigned :: Bool
	-- ^ Allow unassigned Unicode code points
	}
	deriving (Show, Eq)

-- | @defaultFlags = Flags True False@
defaultFlags :: Flags
defaultFlags = Flags True False

-- | Convert a Unicode domain name to an ASCII 'B.ByteString'. The domain
-- name may contain several labels, separated by periods.
--
-- @toASCII@ never alters a sequence of code points that are all in the
-- ASCII range to begin with (although it could fail). Applying @toASCII@
-- multiple times gives the same result as applying it once.
toASCII :: Flags -> T.Text -> Either Error B.ByteString
toASCII flags input =
	Unsafe.unsafePerformIO $
	withArray0 0 (toUCS4 input) $ \buf ->
	let c_flags = encodeFlags flags in
	alloca $ \outBufPtr -> do
		c_rc <- idna_to_ascii_4z
{-# LINE 68 "lib/Data/Text/IDN/IDNA.chs" #-}
			(castPtr buf) outBufPtr c_flags
		
		let rc = fromIntegral c_rc
		if rc /= fromEnum SUCCESS
			then return (Left (cToError c_rc))
			else do
				outBuf <- peek outBufPtr
				bytes <- B.packCString outBuf
				idn_free (castPtr outBuf)
				return (Right bytes)

-- | Convert a possibly ACE-encoded domain name to Unicode. The domain
-- name may contain several labels, separated by dots.
--
-- Aside from memory allocation failure, @toUnicode@ always succeeds.
-- If the input cannot be decoded, it is returned unchanged.
toUnicode :: Flags -> B.ByteString -> T.Text
toUnicode flags input =
	Unsafe.unsafePerformIO $
	B.useAsCString input $ \buf ->
	let c_flags = encodeFlags flags in
	alloca $ \outBufPtr -> do
		c_rc <- idna_to_unicode_8z4z
{-# LINE 91 "lib/Data/Text/IDN/IDNA.chs" #-}
			(castPtr buf) outBufPtr c_flags
		
		let rc = fromIntegral c_rc
		if rc == fromEnum MALLOC_ERROR
			then throwError c_rc
			else do
				outBuf <- peek outBufPtr
				ucs4 <- peekArray0 0 (castPtr outBuf)
				idn_free (castPtr outBuf)
				return (fromUCS4 ucs4)

encodeFlags :: Flags -> CInt
encodeFlags flags = foldr (.|.) 0 bits where
	bitAt f e = if f flags then 0 else fromIntegral (fromEnum e)
	bits = [ bitAt verifySTD3 USE_STD3_ASCII_RULES
	       , bitAt allowUnassigned ALLOW_UNASSIGNED
	       ]

cToError :: CInt -> Error
cToError rc = IDNAError (T.pack str) where
	c_strerror = idna_strerror
{-# LINE 112 "lib/Data/Text/IDN/IDNA.chs" #-}
	str = Unsafe.unsafePerformIO (c_strerror rc >>= peekCString)

throwError :: CInt -> IO a
throwError rc = do
	str <- peekCString =<< idna_strerror rc
	throwIO (ErrorCall str)

foreign import ccall safe "Data/Text/IDN/IDNA.chs.h idna_to_ascii_4z"
  idna_to_ascii_4z :: ((Ptr CUInt) -> ((Ptr (Ptr CChar)) -> (CInt -> (IO CInt))))

foreign import ccall safe "Data/Text/IDN/IDNA.chs.h idn_free"
  idn_free :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "Data/Text/IDN/IDNA.chs.h idna_to_unicode_8z4z"
  idna_to_unicode_8z4z :: ((Ptr CChar) -> ((Ptr (Ptr CUInt)) -> (CInt -> (IO CInt))))

foreign import ccall safe "Data/Text/IDN/IDNA.chs.h idna_strerror"
  idna_strerror :: (CInt -> (IO (Ptr CChar)))