{-# LANGUAGE CPP #-}

{-|
Module:      System.IO.CodePage.Internal
Copyright:   (C) 2018 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Experimental
Portability: Portable

Various internals used by "System.IO.CodePage".

Note that this is an internal module, and as such, the API presented here is
not guaranteed to be stable, even between minor releases of this library.
-}
module System.IO.CodePage.Internal where

import           System.IO (TextEncoding, latin1, utf8, utf16le, utf16be, utf32le, utf32be)

#ifdef WINDOWS
import qualified System.Win32.CodePage as Win32 (CodePage)
#else
import           Data.Word (Word32)
#endif

-- | A numeric type representing Windows code pages.
type CodePage =
#ifdef WINDOWS
  Win32.CodePage
#else
  Word32
#endif

-- | The UTF-8 code page.
cp65001 :: CodePage
cp65001 :: CodePage
cp65001 = CodePage
65001

-- | The UTF-16LE code page.
cp1200 :: CodePage
cp1200 :: CodePage
cp1200 = CodePage
1200

-- | The UTF-16BE code page.
cp1201 :: CodePage
cp1201 :: CodePage
cp1201 = CodePage
1201

-- | The UTF-32LE code page.
cp12000 :: CodePage
cp12000 :: CodePage
cp12000 = CodePage
12000

-- | The UTF-32BE code page.
cp12001 :: CodePage
cp12001 :: CodePage
cp12001 = CodePage
12001

-- | The Latin1 code page.
cp1252 :: CodePage
cp1252 :: CodePage
cp1252 = CodePage
1252

-- | Options that specify how 'withCodePage' and friends should work.
data Options = Options
  { Options -> Bool
chatty :: Bool
    -- ^ If 'True', emit a warning to @stderr@ indicating that the code page has
    -- been changed. If 'False', don't emit any warnings.
  , Options -> NonWindowsBehavior
nonWindowsBehavior :: NonWindowsBehavior
    -- ^ Configures how 'withCodePage' and friends should work on non-Windows
    --   operating systems.
  }

-- | The default 'Options':
--
-- @
-- 'Options'
-- { 'chatty' = 'False'
-- , 'nonWindowsBehavior' =
--     'nonWindowsFallbackCodePageEncoding' 'defaultFallbackCodePageEncoding'
-- }
-- @
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: Bool -> NonWindowsBehavior -> Options
Options
  { chatty :: Bool
chatty = Bool
False
  , nonWindowsBehavior :: NonWindowsBehavior
nonWindowsBehavior =
      (CodePage -> TextEncoding) -> NonWindowsBehavior
nonWindowsFallbackCodePageEncoding CodePage -> TextEncoding
defaultFallbackCodePageEncoding
  }

-- | Specifies how 'withCodePage' and friends should work on operating systems
-- other than Windows.
data NonWindowsBehavior
 = NonWindowsDoNothing
   -- ^ Don't do anything at all on non-Windows OSes.
 | NonWindowsFallbackCodePageEncoding (CodePage -> TextEncoding)
   -- ^ On non-Windows OSes, change the 'TextEncoding' by converting the
   --   'CodePage' argument to a 'TextEncoding' using the supplied function.

-- | Don't do anything at all on non-Windows OSes.
nonWindowsDoNothing :: NonWindowsBehavior
nonWindowsDoNothing :: NonWindowsBehavior
nonWindowsDoNothing = NonWindowsBehavior
NonWindowsDoNothing

-- | On non-Windows OSes, change the 'TextEncoding' by converting the
-- 'CodePage' argument to a 'TextEncoding' using the supplied function.
nonWindowsFallbackCodePageEncoding
  :: (CodePage -> TextEncoding) -> NonWindowsBehavior
nonWindowsFallbackCodePageEncoding :: (CodePage -> TextEncoding) -> NonWindowsBehavior
nonWindowsFallbackCodePageEncoding = (CodePage -> TextEncoding) -> NonWindowsBehavior
NonWindowsFallbackCodePageEncoding

-- | Provides a best-effort attempt to convert a 'CodePage' to a 'TextEncoding'
-- on non-Windows OSes. Errors if given a 'CodePage' that it doesn't know how
-- to convert.
defaultFallbackCodePageEncoding :: CodePage -> TextEncoding
defaultFallbackCodePageEncoding :: CodePage -> TextEncoding
defaultFallbackCodePageEncoding CodePage
cp
  | CodePage
cp CodePage -> CodePage -> Bool
forall a. Eq a => a -> a -> Bool
== CodePage
cp65001
  = TextEncoding
utf8
  | CodePage
cp CodePage -> CodePage -> Bool
forall a. Eq a => a -> a -> Bool
== CodePage
cp1200
  = TextEncoding
utf16le
  | CodePage
cp CodePage -> CodePage -> Bool
forall a. Eq a => a -> a -> Bool
== CodePage
cp1201
  = TextEncoding
utf16be
  | CodePage
cp CodePage -> CodePage -> Bool
forall a. Eq a => a -> a -> Bool
== CodePage
cp12000
  = TextEncoding
utf32le
  | CodePage
cp CodePage -> CodePage -> Bool
forall a. Eq a => a -> a -> Bool
== CodePage
cp12001
  = TextEncoding
utf32be
  | CodePage
cp CodePage -> CodePage -> Bool
forall a. Eq a => a -> a -> Bool
== CodePage
cp1252
  = TextEncoding
latin1
  | Bool
otherwise
  = [Char] -> TextEncoding
forall a. HasCallStack => [Char] -> a
error ([Char] -> TextEncoding) -> [Char] -> TextEncoding
forall a b. (a -> b) -> a -> b
$ [Char]
"Don't know fallback text encoding for CP" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CodePage -> [Char]
forall a. Show a => a -> [Char]
show CodePage
cp