{-# LANGUAGE OverloadedStrings #-}

{-| Minimalist implementation of type-safe formatted strings, borrowing heavily
    from the implementation of the @formatting@ package.

    Example use of this module:

>>> :set -XOverloadedStrings
>>> import Turtle.Format
>>> format ("This is a "%s%" string that takes "%d%" arguments") "format" 2
"This is a format string that takes 2 arguments"

    A `Format` string that takes no arguments has this type:

> "I take 0 arguments" :: Format r r
>
> format "I take 0 arguments" :: Text

>>> format "I take 0 arguments"
"I take 0 arguments"

    A `Format` string that takes one argument has this type:

> "I take "%d%" arguments" :: Format r (Int -> r)
>
> format ("I take "%d%" argument") :: Int -> Text

>>> format ("I take "%d%" argument") 1
"I take 1 argument"

    A `Format` string that takes two arguments has this type:

> "I "%s%" "%d%" arguments" :: Format r (Text -> Int -> r)
>
> format ("I "%s%" "%d%" arguments") :: Text -> Int -> Text

>>> format ("I "%s%" "%d%" arguments") "take" 2
"I take 2 arguments"
-}

{-# LANGUAGE TypeFamilies #-}

module Turtle.Format (
    -- * Format
      Format (..)
    , (%)
    , format
    , printf
    , eprintf
    , makeFormat

    -- * Parameters
    , w
    , d
    , u
    , o
    , x
    , f
    , e
    , g
    , s
    , l
    , fp
    , utc

    -- * Utilities
    , repr
    ) where

import Control.Category (Category(..))
import Control.Monad.IO.Class (MonadIO(..))
import Data.Monoid ((<>))
import Data.String (IsString(..))
import Data.Text (Text, pack)
import Data.Time (UTCTime)
import Data.Word
import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct)
import Prelude hiding ((.), id)
import qualified System.IO as IO
import Turtle.Line (Line)

import qualified Data.Text.IO as Text
import qualified Turtle.Line

-- | A `Format` string
newtype Format a b = Format { forall a b. Format a b -> (Text -> a) -> b
(>>-) :: (Text -> a) -> b }

instance Category Format where
    id :: forall a. Format a a
id = forall a b. ((Text -> a) -> b) -> Format a b
Format (\Text -> a
return_ -> Text -> a
return_ Text
"")

    Format b c
fmt1 . :: forall b c a. Format b c -> Format a b -> Format a c
. Format a b
fmt2 = forall a b. ((Text -> a) -> b) -> Format a b
Format (\Text -> a
return_ ->
        Format b c
fmt1 forall a b. Format a b -> (Text -> a) -> b
>>- \Text
str1 ->
        Format a b
fmt2 forall a b. Format a b -> (Text -> a) -> b
>>- \Text
str2 ->
        Text -> a
return_ (Text
str1 forall a. Semigroup a => a -> a -> a
<> Text
str2) )

-- | Concatenate two `Format` strings
(%) :: Format b c -> Format a b -> Format a c
% :: forall b c a. Format b c -> Format a b -> Format a c
(%) = forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)

instance (a ~ b) => IsString (Format a b) where
    fromString :: String -> Format a b
fromString String
str = forall a b. ((Text -> a) -> b) -> Format a b
Format (\Text -> a
return_ -> Text -> a
return_ (String -> Text
pack String
str))

{-| Convert a `Format` string to a print function that takes zero or more typed
    arguments and returns a `Text` string
-}
format :: Format Text r -> r
format :: forall r. Format Text r -> r
format Format Text r
fmt = Format Text r
fmt forall a b. Format a b -> (Text -> a) -> b
>>- forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

{-| Print a `Format` string to standard output (without a trailing newline)

>>> printf ("Hello, "%s%"!\n") "world"
Hello, world!
-}
printf :: MonadIO io => Format (io ()) r -> r
printf :: forall (io :: * -> *) r. MonadIO io => Format (io ()) r -> r
printf Format (io ()) r
fmt = Format (io ()) r
fmt forall a b. Format a b -> (Text -> a) -> b
>>- (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> IO ()
Text.putStr)

{-| Print a `Format` string to standard err (without a trailing newline)

>>> eprintf ("Hello, "%s%"!\n") "world"
Hello, world!
-}
eprintf :: MonadIO io => Format (io ()) r -> r
eprintf :: forall (io :: * -> *) r. MonadIO io => Format (io ()) r -> r
eprintf Format (io ()) r
fmt = Format (io ()) r
fmt forall a b. Format a b -> (Text -> a) -> b
>>- (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Handle -> Text -> IO ()
Text.hPutStr Handle
IO.stderr)

-- | Create your own format specifier
makeFormat :: (a -> Text) -> Format r (a -> r)
makeFormat :: forall a r. (a -> Text) -> Format r (a -> r)
makeFormat a -> Text
k = forall a b. ((Text -> a) -> b) -> Format a b
Format (\Text -> r
return_ -> \a
a -> Text -> r
return_ (a -> Text
k a
a))

{-| `Format` any `Show`able value

>>> format w True
"True"
-}
w :: Show a => Format r (a -> r)
w :: forall a r. Show a => Format r (a -> r)
w = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (String -> Text
pack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show)

{-| `Format` an `Integral` value as a signed decimal

>>> format d 25
"25"
>>> format d (-25)
"-25"
-}
d :: Integral n => Format r (n -> r)
d :: forall n r. Integral n => Format r (n -> r)
d = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (String -> Text
pack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Integral a => a -> Integer
toInteger)

{-| `Format` a `Word` value as an unsigned decimal

>>> format u 25
"25"
-}
u :: Format r (Word -> r)
u :: forall r. Format r (Word -> r)
u = forall a r. Show a => Format r (a -> r)
w

{-| `Format` a `Word` value as an unsigned octal number

>>> format o 25
"31"
-}
o :: Format r (Word -> r)
o :: forall r. Format r (Word -> r)
o = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Word
n -> String -> Text
pack (forall a. (Integral a, Show a) => a -> ShowS
showOct Word
n String
""))

{-| `Format` a `Word` value as an unsigned hexadecimal number (without a
    leading \"0x\")

>>> format x 25
"19"
-}
x :: Format r (Word -> r)
x :: forall r. Format r (Word -> r)
x = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Word
n -> String -> Text
pack (forall a. (Integral a, Show a) => a -> ShowS
showHex Word
n String
""))

{-| `Format` a `Double` using decimal notation with 6 digits of precision

>>> format f 25.1
"25.100000"
-}
f :: Format r (Double -> r)
f :: forall r. Format r (Double -> r)
f = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Double
n -> String -> Text
pack (forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (forall a. a -> Maybe a
Just Int
6) Double
n String
""))

{-| `Format` a `Double` using scientific notation with 6 digits of precision

>>> format e 25.1
"2.510000e1"
-}
e :: Format r (Double -> r)
e :: forall r. Format r (Double -> r)
e = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Double
n -> String -> Text
pack (forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (forall a. a -> Maybe a
Just Int
6) Double
n String
""))

{-| `Format` a `Double` using decimal notation for small exponents and
    scientific notation for large exponents

>>> format g 25.1
"25.100000"
>>> format g 123456789
"1.234568e8"
>>> format g 0.00000000001
"1.000000e-11"
-}
g :: Format r (Double -> r)
g :: forall r. Format r (Double -> r)
g = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Double
n -> String -> Text
pack (forall a. RealFloat a => Maybe Int -> a -> ShowS
showGFloat (forall a. a -> Maybe a
Just Int
6) Double
n String
""))

{-| `Format` that inserts `Text`

>>> format s "ABC"
"ABC"
-}
s :: Format r (Text -> r)
s :: forall r. Format r (Text -> r)
s = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

{-| `Format` that inserts a `Line`

>>> format l "ABC"
"ABC"
-}
l :: Format r (Line -> r)
l :: forall r. Format r (Line -> r)
l = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat Line -> Text
Turtle.Line.lineToText

-- | `Format` a `FilePath` into `Text`
fp :: Format r (FilePath -> r)
fp :: forall r. Format r (String -> r)
fp = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat String -> Text
pack

-- | `Format` a `UTCTime` into `Text`
utc :: Format r (UTCTime -> r)
utc :: forall r. Format r (UTCTime -> r)
utc = forall a r. Show a => Format r (a -> r)
w

{-| Convert a `Show`able value to any type that implements `IsString` (such as
    `Text`)

>>> repr (1,2)
"(1,2)"
-}
repr :: (Show a, IsString text) => a -> text
repr :: forall a text. (Show a, IsString text) => a -> text
repr = forall a. IsString a => String -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show