module Data.GI.CodeGen.Util
  ( prime
  , parenthesize

  , padTo
  , withComment

  , ucFirst
  , lcFirst

  , modifyQualified

  , tshow
  , terror

  , utf8ReadFile
  , utf8WriteFile

  , splitOn
  ) where

#if !MIN_VERSION_base(4,13,0)
import Data.Monoid ((<>))
#endif
import Data.Char (toLower, toUpper)

import qualified Data.ByteString as B
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE

padTo :: Int -> Text -> Text
padTo :: Int -> Text -> Text
padTo n :: Int
n s :: Text
s = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) " "

withComment :: Text -> Text -> Text
withComment :: Text -> Text -> Text
withComment a :: Text
a b :: Text
b = Int -> Text -> Text
padTo 40 Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b

prime :: Text -> Text
prime :: Text -> Text
prime = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'")

parenthesize :: Text -> Text
parenthesize :: Text -> Text
parenthesize s :: Text
s = "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"

-- | Construct the `Text` representation of a showable.
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Throw an error with the given `Text`.
terror :: Text -> a
terror :: Text -> a
terror = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | Capitalize the first character of the given string.
ucFirst :: Text -> Text
ucFirst :: Text -> Text
ucFirst "" = ""
ucFirst t :: Text
t = Char -> Text -> Text
T.cons (Char -> Char
toUpper (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t) (Text -> Text
T.tail Text
t)

-- | Make the first character of the given string lowercase.
lcFirst :: Text -> Text
lcFirst :: Text -> Text
lcFirst "" = ""
lcFirst t :: Text
t = Char -> Text -> Text
T.cons (Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t) (Text -> Text
T.tail Text
t)

-- | Apply the given modification function to the given symbol. If the
-- symbol is qualified the modification will only apply to the last
-- component.
modifyQualified :: (Text -> Text) -> Text -> Text
modifyQualified :: (Text -> Text) -> Text -> Text
modifyQualified f :: Text -> Text
f = Text -> [Text] -> Text
T.intercalate "." ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
modify ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn "."
    where modify :: [Text] -> [Text]
          modify :: [Text] -> [Text]
modify [] = []
          modify (a :: Text
a:[]) = Text -> Text
f Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: []
          modify (a :: Text
a:as :: [Text]
as) = Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
modify [Text]
as

-- | Split a list into sublists delimited by the given element.
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn :: a -> [a] -> [[a]]
splitOn x :: a
x xs :: [a]
xs = [a] -> [a] -> [[a]]
go [a]
xs []
    where go :: [a] -> [a] -> [[a]]
go [] acc :: [a]
acc = [[a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc]
          go (y :: a
y : ys :: [a]
ys) acc :: [a]
acc = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
                            then [a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [[a]]
go [a]
ys []
                            else [a] -> [a] -> [[a]]
go [a]
ys (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)

-- | Read a file assuming it is UTF-8 encoded. If decoding fails this
-- calls `error`.
utf8ReadFile :: FilePath -> IO T.Text
utf8ReadFile :: String -> IO Text
utf8ReadFile fname :: String
fname = do
  ByteString
bytes <- String -> IO ByteString
B.readFile String
fname
  case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bytes of
    Right text :: Text
text -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text
    Left error :: UnicodeException
error -> Text -> IO Text
forall a. Text -> a
terror ("Input file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
tshow String
fname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          " seems not to be valid UTF-8. Error was:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          UnicodeException -> Text
forall a. Show a => a -> Text
tshow UnicodeException
error)

-- | Write the given `Text` into an UTF-8 encoded file.
utf8WriteFile :: FilePath -> T.Text -> IO ()
utf8WriteFile :: String -> Text -> IO ()
utf8WriteFile fname :: String
fname text :: Text
text = String -> ByteString -> IO ()
B.writeFile String
fname (Text -> ByteString
TE.encodeUtf8 Text
text)