Printf.hs

{-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeFamilies #-}

module Control.Category.Printf 
       ( module Control.Category
       , Format
       , printfWith
       , sprintf
       , c
       , i
       , spliceWith
       , s
       , generalizeString
       , intAtBase
       , hex
       , oct
       , eFloat
       , fFloat
       , gFloat
       , push
       , dup
       , swap
       , skip
       , apply
       , apply2
       ) where

import Prelude hiding (id, (.))
import Control.Arrow
import Control.Category
import Data.Monoid
import Control.Comonad
import Numeric

import Data.String

-- | Handy type synonym for the things we're working with.
type Format m = Cokleisli ((->) m)

-- | You should regard a value of type @Format m a b@ as something which explains how to write
-- some element of the monoid @m@ (a "string" for our purposes), and which will change the type
-- of printf from @a@ to @b@. For instance, something which adds a responsibility to provide an
-- additional argument of type @t@ might have type @Format m a (t -> a)@, while a formatter which
-- somehow absolves you of that responsibility would have type @Format m (t -> a) a@.

-- | We can apply this to something like putStrLn to get a function for formatted printing.
-- Typically you'll have @r = IO ()@, but that needn't be the case.
printfWith :: (m -> r) -> Format m r b -> b
printfWith printer f = runCokleisli f printer

-- | If you just want to build a string / element of your monoid, we have @sprintf = printfWith id@
sprintf :: Format m m b -> b
sprintf = printfWith id

instance (a ~ b, IsString s, Monoid s) => IsString (Cokleisli ((->) s) a b) where
  fromString = c . fromString

-- | Formatter for a constant string.
c :: (Monoid m) => m -> Format m a a
c x = Cokleisli (\k -> k x)

-- | Inclusion of a string directly.
i :: Format m a (m -> a)
i = Cokleisli id

-- | Given a way to turn a value of type t into a string, this builds a
-- formatter which demands an additional argument of type t and splices it in.
spliceWith :: (Monoid m) => (t -> m) -> Format m a (t -> a)
spliceWith f = Cokleisli (\k n -> k (f n))

-- | Splice in anything showable.
s :: (Monoid s, IsString s, Show t) => Format s a (t -> a)
s = spliceWith (fromString . show)

-- | Generalizes the string type that a formatter uses by applying fromString internally.
generalizeString :: (IsString s, Monoid s) => Format String a b -> Format s a b
generalizeString f = Cokleisli (\k -> runCokleisli f (k . fromString))

-- | Show an integral value using the given base, and using the provided function to determine how
-- to display individual digits.
intAtBase :: (Real t, Integral t, Show t, Monoid s, IsString s)
          => t -> (Int -> Char) -> Format s a (t -> a)
intAtBase b showDigit = generalizeString $
  spliceWith (\n -> showSigned (showIntAtBase b showDigit) 0 n "")

-- | Show an integral value in hexadecimal.
hex :: (Integral t, Show t, Monoid s, IsString s) => Format s a (t -> a)
hex = generalizeString $
  spliceWith (\n -> showSigned showHex 0 n "")

-- | Show an integral value in octal.
oct :: (Integral t, Show t, Monoid s, IsString s) => Format s a (t -> a)
oct = generalizeString $
  spliceWith (\n -> showSigned showOct 0 n "")

-- | Show a floating point value in exponential format. (e.g. 2.45e2, -1.5e-3)
-- If `digs` is Nothing, the value is shown to full precision, if it is Just d then at most
-- d digits after the decimal point are shown.
eFloat :: (RealFloat t, Monoid s, IsString s) => Maybe Int -> Format s a (t -> a)
eFloat digs = generalizeString $ spliceWith (\n -> showEFloat digs n "")

-- | Show a floating point value in standard decimal format. (e.g. 245000, -0.0015)
-- If `digs` is Nothing, the value is shown to full precision, if it is Just d then at most
-- d digits after the decimal point are shown.
fFloat :: (RealFloat t, Monoid s, IsString s) => Maybe Int -> Format s a (t -> a)
fFloat digs = generalizeString $ spliceWith (\n -> showFFloat digs n "")

-- | Show a floating point value using standard decimal notation for arguments whose absolute
-- value lies between 0.1 and 9,999,999, and scientific notation otherwise. 
-- If `digs` is Nothing, the value is shown to full precision, if it is Just d then at most
-- d digits after the decimal point are shown.
gFloat :: (RealFloat t, Monoid s, IsString s) => Maybe Int -> Format s a (t -> a)
gFloat digs = generalizeString $ spliceWith (\n -> showGFloat digs n "")

-- | We can use `arr` from the Arrow instance for Cokleisli w to produce formatters
-- that manipulate the stack without printing. That is, we have
-- 
-- > arr :: (Monoid m) => (s -> s') -> Format m s s'

-- | Push an argument onto the stack to be consumed by subsequent formatters.
push :: Monoid m => t -> Format m (t -> a) a
push x = arr (\k -> k x)

-- | Duplicate an argument on the stack, making it available twice.
dup :: Monoid m => Format m (t -> t -> a) (t -> a)
dup = arr (\k x -> k x x)

-- | Swap the next two arguments on the stack.
swap :: Monoid m => Format m (t -> t' -> a) (t' -> t -> a)
swap = arr (\k x y -> k y x)

-- | Skip the next argument on the stack.
skip :: Monoid m => Format m (t -> a) (t' -> t -> a)
skip = arr (\k x -> k)

-- | Apply a function to the argument on the top of the stack.
apply :: Monoid m => (u -> v) -> Format m (v -> a) (u -> a)
apply f = arr (\k x -> k (f x))

-- | Apply a binary function to the top two arguments on the stack.
apply2 :: Monoid m => (u -> v -> w) -> Format m (w -> a) (u -> v -> a)
apply2 f = arr (\k x y -> k (f x y))