-- GENERATED by C->Haskell Compiler, version 0.20.1 The shapeless maps, 31 Oct 2014 (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
  succ SUCCESS = STRINGPREP_ERROR
  succ STRINGPREP_ERROR = PUNYCODE_ERROR
  succ PUNYCODE_ERROR = CONTAINS_NON_LDH
  succ CONTAINS_NON_LDH = CONTAINS_MINUS
  succ CONTAINS_LDH = CONTAINS_MINUS
  succ CONTAINS_MINUS = INVALID_LENGTH
  succ INVALID_LENGTH = NO_ACE_PREFIX
  succ NO_ACE_PREFIX = ROUNDTRIP_VERIFY_ERROR
  succ ROUNDTRIP_VERIFY_ERROR = CONTAINS_ACE_PREFIX
  succ CONTAINS_ACE_PREFIX = ICONV_ERROR
  succ ICONV_ERROR = MALLOC_ERROR
  succ MALLOC_ERROR = DLOPEN_ERROR
  succ DLOPEN_ERROR = error "Idna_rc.succ: DLOPEN_ERROR has no successor"

  pred STRINGPREP_ERROR = SUCCESS
  pred PUNYCODE_ERROR = STRINGPREP_ERROR
  pred CONTAINS_NON_LDH = PUNYCODE_ERROR
  pred CONTAINS_LDH = PUNYCODE_ERROR
  pred CONTAINS_MINUS = CONTAINS_NON_LDH
  pred INVALID_LENGTH = CONTAINS_MINUS
  pred NO_ACE_PREFIX = INVALID_LENGTH
  pred ROUNDTRIP_VERIFY_ERROR = NO_ACE_PREFIX
  pred CONTAINS_ACE_PREFIX = ROUNDTRIP_VERIFY_ERROR
  pred ICONV_ERROR = CONTAINS_ACE_PREFIX
  pred MALLOC_ERROR = ICONV_ERROR
  pred DLOPEN_ERROR = MALLOC_ERROR
  pred SUCCESS = error "Idna_rc.pred: SUCCESS has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from DLOPEN_ERROR

  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 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
  succ ALLOW_UNASSIGNED = USE_STD3_ASCII_RULES
  succ USE_STD3_ASCII_RULES = error "Idna_flags.succ: USE_STD3_ASCII_RULES has no successor"

  pred USE_STD3_ASCII_RULES = ALLOW_UNASSIGNED
  pred ALLOW_UNASSIGNED = error "Idna_flags.pred: ALLOW_UNASSIGNED has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from USE_STD3_ASCII_RULES

  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 fromIntegral (fromEnum e) else 0
	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)))