{-# LANGUAGE OverloadedStrings #-}

module Jacinda.Backend.Printf ( sprintf
                              ) where

import           A
import qualified Data.ByteString                   as BS
import           Data.ByteString.Builder           (toLazyByteString)
import           Data.ByteString.Builder.RealFloat (doubleDec)
import qualified Data.ByteString.Lazy              as BSL
import qualified Data.Text                         as T
import           Data.Text.Encoding                (decodeUtf8, encodeUtf8)

sprintf :: BS.ByteString -- ^ Format string
        -> E a
        -> BS.ByteString
sprintf :: forall a. ByteString -> E a -> ByteString
sprintf ByteString
fmt E a
e = Text -> ByteString
encodeUtf8 (Text -> E a -> Text
forall a. Text -> E a -> Text
sprintf' (ByteString -> Text
decodeUtf8 ByteString
fmt) E a
e)

pf :: Double -> T.Text
pf :: Double -> Text
pf = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Double -> ByteString) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (Double -> LazyByteString) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString (Builder -> LazyByteString)
-> (Double -> Builder) -> Double -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
doubleDec

-- TODO: interpret precision, like %0.6f %.6

-- FIXME: if next is, say %i and encounter an int in the tuple, that should be an error
sprintf' :: T.Text -> E a -> T.Text
sprintf' :: forall a. Text -> E a -> Text
sprintf' Text
fmt (Lit a
_ (FLit Double
f)) =
    let (Text
prefix, Text
fmt') = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"%f" Text
fmt
        in Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
pf Double
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
2 Text
fmt'
sprintf' Text
fmt (Lit a
_ (ILit Integer
i)) =
    let (Text
prefix, Text
fmt') = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"%i" Text
fmt
        in Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
2 Text
fmt'
sprintf' Text
fmt (Lit a
_ (StrLit ByteString
bs)) =
    let (Text
prefix, Text
fmt') = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"%s" Text
fmt
        in Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 ByteString
bs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
2 Text
fmt'
sprintf' Text
fmt (Tup a
_ [E a
e]) = Text -> E a -> Text
forall a. Text -> E a -> Text
sprintf' Text
fmt E a
e
sprintf' Text
fmt (Tup a
l (E a
e:[E a]
es)) =
    let nextFmt :: Text
nextFmt = Text -> E a -> Text
forall a. Text -> E a -> Text
sprintf' Text
fmt E a
e
        in Text -> E a -> Text
forall a. Text -> E a -> Text
sprintf' Text
nextFmt (a -> [E a] -> E a
forall a. a -> [E a] -> E a
Tup a
l [E a]
es)
sprintf' Text
fmt (Lit a
_ (BLit Bool
b)) =
    let (Text
prefix, Text
fmt') = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"%b" Text
fmt
        in Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall {a}. IsString a => Bool -> a
showBool Bool
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
2 Text
fmt'
    where showBool :: Bool -> a
showBool Bool
True  = a
"true"
          showBool Bool
False = a
"false"