{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.UTF8
   Copyright   : Copyright (C) 2010-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

UTF-8 aware string IO functions that will work with GHC 6.10, 6.12, or 7.
-}
module Text.Pandoc.UTF8 ( readFile
                        , getContents
                        , writeFileWith
                        , writeFile
                        , putStrWith
                        , putStr
                        , putStrLnWith
                        , putStrLn
                        , hPutStrWith
                        , hPutStr
                        , hPutStrLnWith
                        , hPutStrLn
                        , hGetContents
                        , toString
                        , toText
                        , fromString
                        , fromText
                        , toStringLazy
                        , fromTextLazy
                        , toTextLazy
                        , fromStringLazy
                        , encodePath
                        , decodeArg
                        )

where

import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Prelude hiding (getContents, putStr, putStrLn, readFile, writeFile)
import System.IO hiding (getContents, hGetContents, hPutStr, hPutStrLn, putStr,
                  putStrLn, readFile, writeFile)
import qualified System.IO as IO

readFile :: FilePath -> IO String
readFile :: FilePath -> IO FilePath
readFile FilePath
f = do
  Handle
h <- FilePath -> IOMode -> IO Handle
openFile (FilePath -> FilePath
encodePath FilePath
f) IOMode
ReadMode
  Handle -> IO FilePath
hGetContents Handle
h

getContents :: IO String
getContents :: IO FilePath
getContents = Handle -> IO FilePath
hGetContents Handle
stdin

writeFileWith :: Newline -> FilePath -> String -> IO ()
writeFileWith :: Newline -> FilePath -> FilePath -> IO ()
writeFileWith Newline
eol FilePath
f FilePath
s =
  FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (FilePath -> FilePath
encodePath FilePath
f) IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Newline -> Handle -> FilePath -> IO ()
hPutStrWith Newline
eol Handle
h FilePath
s

writeFile :: FilePath -> String -> IO ()
writeFile :: FilePath -> FilePath -> IO ()
writeFile = Newline -> FilePath -> FilePath -> IO ()
writeFileWith Newline
nativeNewline

putStrWith :: Newline -> String -> IO ()
putStrWith :: Newline -> FilePath -> IO ()
putStrWith Newline
eol FilePath
s = Newline -> Handle -> FilePath -> IO ()
hPutStrWith Newline
eol Handle
stdout FilePath
s

putStr :: String -> IO ()
putStr :: FilePath -> IO ()
putStr = Newline -> FilePath -> IO ()
putStrWith Newline
nativeNewline

putStrLnWith :: Newline -> String -> IO ()
putStrLnWith :: Newline -> FilePath -> IO ()
putStrLnWith Newline
eol FilePath
s = Newline -> Handle -> FilePath -> IO ()
hPutStrLnWith Newline
eol Handle
stdout FilePath
s

putStrLn :: String -> IO ()
putStrLn :: FilePath -> IO ()
putStrLn = Newline -> FilePath -> IO ()
putStrLnWith Newline
nativeNewline

hPutStrWith :: Newline -> Handle -> String -> IO ()
hPutStrWith :: Newline -> Handle -> FilePath -> IO ()
hPutStrWith Newline
eol Handle
h FilePath
s =
  Handle -> NewlineMode -> IO ()
hSetNewlineMode Handle
h (Newline -> Newline -> NewlineMode
NewlineMode Newline
eol Newline
eol) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> FilePath -> IO ()
IO.hPutStr Handle
h FilePath
s

hPutStr :: Handle -> String -> IO ()
hPutStr :: Handle -> FilePath -> IO ()
hPutStr = Newline -> Handle -> FilePath -> IO ()
hPutStrWith Newline
nativeNewline

hPutStrLnWith :: Newline -> Handle -> String -> IO ()
hPutStrLnWith :: Newline -> Handle -> FilePath -> IO ()
hPutStrLnWith Newline
eol Handle
h FilePath
s =
  Handle -> NewlineMode -> IO ()
hSetNewlineMode Handle
h (Newline -> Newline -> NewlineMode
NewlineMode Newline
eol Newline
eol) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
h FilePath
s

hPutStrLn :: Handle -> String -> IO ()
hPutStrLn :: Handle -> FilePath -> IO ()
hPutStrLn = Newline -> Handle -> FilePath -> IO ()
hPutStrLnWith Newline
nativeNewline

hGetContents :: Handle -> IO String
hGetContents :: Handle -> IO FilePath
hGetContents = (ByteString -> FilePath) -> IO ByteString -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FilePath
toString (IO ByteString -> IO FilePath)
-> (Handle -> IO ByteString) -> Handle -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
B.hGetContents
-- hGetContents h = hSetEncoding h utf8_bom
--                   >> hSetNewlineMode h universalNewlineMode
--                   >> IO.hGetContents h

-- | Convert UTF8-encoded ByteString to Text, also
-- removing '\r' characters.
toText :: B.ByteString -> T.Text
toText :: ByteString -> Text
toText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
filterCRs (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropBOM
  where dropBOM :: ByteString -> ByteString
dropBOM ByteString
bs =
         if ByteString
"\xEF\xBB\xBF" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
bs
            then Int -> ByteString -> ByteString
B.drop Int
3 ByteString
bs
            else ByteString
bs
        filterCRs :: ByteString -> ByteString
filterCRs = (Char -> Bool) -> ByteString -> ByteString
B.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\r')

-- | Convert UTF8-encoded ByteString to String, also
-- removing '\r' characters.
toString :: B.ByteString -> String
toString :: ByteString -> FilePath
toString = Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
toText

-- | Convert UTF8-encoded ByteString to Text, also
-- removing '\r' characters.
toTextLazy :: BL.ByteString -> TL.Text
toTextLazy :: ByteString -> Text
toTextLazy = ByteString -> Text
TL.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
filterCRs (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropBOM
  where dropBOM :: ByteString -> ByteString
dropBOM ByteString
bs =
         if ByteString
"\xEF\xBB\xBF" ByteString -> ByteString -> Bool
`BL.isPrefixOf` ByteString
bs
            then Int64 -> ByteString -> ByteString
BL.drop Int64
3 ByteString
bs
            else ByteString
bs
        filterCRs :: ByteString -> ByteString
filterCRs = (Char -> Bool) -> ByteString -> ByteString
BL.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\r')

-- | Convert UTF8-encoded ByteString to String, also
-- removing '\r' characters.
toStringLazy :: BL.ByteString -> String
toStringLazy :: ByteString -> FilePath
toStringLazy = Text -> FilePath
TL.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
toTextLazy

fromText :: T.Text -> B.ByteString
fromText :: Text -> ByteString
fromText = Text -> ByteString
T.encodeUtf8

fromTextLazy :: TL.Text -> BL.ByteString
fromTextLazy :: Text -> ByteString
fromTextLazy = Text -> ByteString
TL.encodeUtf8

fromString :: String -> B.ByteString
fromString :: FilePath -> ByteString
fromString = Text -> ByteString
fromText (Text -> ByteString)
-> (FilePath -> Text) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack

fromStringLazy :: String -> BL.ByteString
fromStringLazy :: FilePath -> ByteString
fromStringLazy = Text -> ByteString
fromTextLazy (Text -> ByteString)
-> (FilePath -> Text) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
TL.pack

encodePath :: FilePath -> FilePath
encodePath :: FilePath -> FilePath
encodePath = FilePath -> FilePath
forall a. a -> a
id

decodeArg :: String -> String
decodeArg :: FilePath -> FilePath
decodeArg = FilePath -> FilePath
forall a. a -> a
id