{-# 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 { Format a b -> (Text -> a) -> b
(>>-) :: (Text -> a) -> b }

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

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

-- | Concatenate two `Format` strings
(%) :: Format b c -> Format a b -> Format a c
% :: Format b c -> Format a b -> Format a c
(%) = 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 = ((Text -> a) -> a) -> Format a a
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 :: Format Text r -> r
format Format Text r
fmt = Format Text r
fmt Format Text r -> (Text -> Text) -> r
forall a b. Format a b -> (Text -> a) -> b
>>- Text -> Text
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 :: Format (io ()) r -> r
printf Format (io ()) r
fmt = Format (io ()) r
fmt Format (io ()) r -> (Text -> io ()) -> r
forall a b. Format a b -> (Text -> a) -> b
>>- (IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> (Text -> IO ()) -> Text -> io ()
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 :: Format (io ()) r -> r
eprintf Format (io ()) r
fmt = Format (io ()) r
fmt Format (io ()) r -> (Text -> io ()) -> r
forall a b. Format a b -> (Text -> a) -> b
>>- (IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> (Text -> IO ()) -> Text -> io ()
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 :: (a -> Text) -> Format r (a -> r)
makeFormat a -> Text
k = ((Text -> r) -> a -> r) -> Format r (a -> r)
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 :: Format r (a -> r)
w = (a -> Text) -> Format r (a -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
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 :: Format r (n -> r)
d = (n -> Text) -> Format r (n -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (String -> Text
pack (String -> Text) -> (n -> String) -> n -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (n -> Integer) -> n -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. n -> Integer
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 :: Format r (Word -> r)
u = Format r (Word -> r)
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 :: Format r (Word -> r)
o = (Word -> Text) -> Format r (Word -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Word
n -> String -> Text
pack (Word -> ShowS
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 :: Format r (Word -> r)
x = (Word -> Text) -> Format r (Word -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Word
n -> String -> Text
pack (Word -> ShowS
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 :: Format r (Double -> r)
f = (Double -> Text) -> Format r (Double -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Double
n -> String -> Text
pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
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 :: Format r (Double -> r)
e = (Double -> Text) -> Format r (Double -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Double
n -> String -> Text
pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
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 :: Format r (Double -> r)
g = (Double -> Text) -> Format r (Double -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\Double
n -> String -> Text
pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showGFloat (Int -> Maybe Int
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 :: Format r (Text -> r)
s = (Text -> Text) -> Format r (Text -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat Text -> Text
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 :: Format r (Line -> r)
l = (Line -> Text) -> Format r (Line -> r)
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 :: Format r (String -> r)
fp = (String -> Text) -> Format r (String -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat String -> Text
pack

-- | `Format` a `UTCTime` into `Text`
utc :: Format r (UTCTime -> r)
utc :: Format r (UTCTime -> r)
utc = Format r (UTCTime -> r)
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 :: a -> text
repr = String -> text
forall a. IsString a => String -> a
fromString (String -> text) -> (a -> String) -> a -> text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Show a => a -> String
show