{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hpack.Utf8 (
  encodeUtf8
, readFile
, ensureFile
, putStr
, hPutStr
, hPutStrLn
) where

import           Prelude hiding (readFile, writeFile, putStr)

import           Control.Monad
import           Control.Exception (try, IOException)
import qualified Data.Text as T
import qualified Data.Text.Encoding as Encoding
import           Data.Text.Encoding.Error (lenientDecode)
import qualified Data.ByteString as B
import           System.IO (Handle, stdout, IOMode(..), withFile, Newline(..), nativeNewline)

encodeUtf8 :: String -> B.ByteString
encodeUtf8 :: String -> ByteString
encodeUtf8 = Text -> ByteString
Encoding.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

decodeUtf8 :: B.ByteString -> String
decodeUtf8 :: ByteString -> String
decodeUtf8 = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
Encoding.decodeUtf8With OnDecodeError
lenientDecode

encodeText :: String -> B.ByteString
encodeText :: String -> ByteString
encodeText = String -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
encodeNewlines

decodeText :: B.ByteString -> String
decodeText :: ByteString -> String
decodeText = String -> String
decodeNewlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
decodeUtf8

encodeNewlines :: String -> String
encodeNewlines :: String -> String
encodeNewlines = case Newline
nativeNewline of
  Newline
LF -> forall a. a -> a
id
  Newline
CRLF -> String -> String
go
    where
      go :: String -> String
go String
xs = case String
xs of
        Char
'\n' : String
ys -> Char
'\r' forall a. a -> [a] -> [a]
: Char
'\n' forall a. a -> [a] -> [a]
: String
ys
        Char
y : String
ys -> Char
y forall a. a -> [a] -> [a]
: String -> String
go String
ys
        [] -> []

decodeNewlines :: String -> String
decodeNewlines :: String -> String
decodeNewlines = String -> String
go
  where
    go :: String -> String
go String
xs = case String
xs of
      Char
'\r' : Char
'\n' : String
ys -> Char
'\n' forall a. a -> [a] -> [a]
: String -> String
go String
ys
      Char
y : String
ys -> Char
y forall a. a -> [a] -> [a]
: String -> String
go String
ys
      [] -> []

readFile :: FilePath -> IO String
readFile :: String -> IO String
readFile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
decodeText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
B.readFile

ensureFile :: FilePath -> String -> IO ()
ensureFile :: String -> String -> IO ()
ensureFile String
name String
new = do
  forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
readFile String
name) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
    Left (IOException
_ :: IOException) -> do
      forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
name IOMode
WriteMode (Handle -> String -> IO ()
`hPutStr` String
new)
    Right String
old -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
old forall a. Eq a => a -> a -> Bool
== String
new) forall a b. (a -> b) -> a -> b
$ do
      forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
name IOMode
WriteMode (Handle -> String -> IO ()
`hPutStr` String
new)

putStr :: String -> IO ()
putStr :: String -> IO ()
putStr = Handle -> String -> IO ()
hPutStr Handle
stdout

hPutStrLn :: Handle -> String -> IO ()
hPutStrLn :: Handle -> String -> IO ()
hPutStrLn Handle
h String
xs = Handle -> String -> IO ()
hPutStr Handle
h String
xs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h String
"\n"

hPutStr :: Handle -> String -> IO ()
hPutStr :: Handle -> String -> IO ()
hPutStr Handle
h = Handle -> ByteString -> IO ()
B.hPutStr Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
encodeText