{-# 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 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
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 (Text -> String) -> (ByteString -> Text) -> ByteString -> String
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 (String -> ByteString)
-> (String -> String) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
encodeNewlines

decodeText :: B.ByteString -> String
decodeText :: ByteString -> String
decodeText = String -> String
decodeNewlines (String -> String)
-> (ByteString -> String) -> ByteString -> String
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 -> String -> String
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' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
        Char
y : String
ys -> Char
y Char -> String -> String
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' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
ys
      Char
y : String
ys -> Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
ys
      [] -> []

readFile :: FilePath -> IO String
readFile :: String -> IO String
readFile = (ByteString -> String) -> IO ByteString -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
decodeText (IO ByteString -> IO String)
-> (String -> IO ByteString) -> String -> IO String
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
  IO String -> IO (Either IOException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
readFile String
name) IO (Either IOException String)
-> (Either IOException String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
    Left (IOException
_ :: IOException) -> do
      String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
name IOMode
WriteMode (Handle -> String -> IO ()
`hPutStr` String
new)
    Right String
old -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
old String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
new) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      String -> IOMode -> (Handle -> IO ()) -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 (ByteString -> IO ()) -> (String -> ByteString) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
encodeText