Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
524 lines (395 sloc) 15.1 KB
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module : Text.XFormat.Show
-- Copyright : (c) 2009 Sean Leather
-- License : BSD3
--
-- Maintainer : leather@cs.uu.nl
-- Stability : experimental
-- Portability : non-portable
--
-- This module defines an extensible, type-indexed function for showing
-- well-typed values with a format descriptor. This may be considered a Haskell
-- variant of the C @printf@ function.
--
-- If you are primarily interested in using this library, you will want to see
-- 'showsf' and 'showf', the more user-friendly functions.
--
-- If you are also interested in extending this library with your own format
-- descriptors, you should read about the 'Format' class.
--------------------------------------------------------------------------------
module Text.XFormat.Show (
-- * The Classes
Format(..),
Apply(..),
-- * The Functions
showsf,
showf,
-- * Format Descriptors
-- | These are used to indicate which values and types to show.
-- ** Basic Format Descriptors
CharF(..),
IntF(..),
IntegerF(..),
FloatF(..),
DoubleF(..),
StringF(..),
-- ** Class-based Format Descriptors
ShowF(..),
NumF(..),
-- ** Recursive Format Descriptors
(:%:)(..),
(%),
WrapF(..),
AlignF(..),
AlignChopF(..),
Dir(..),
-- ** Other Format Descriptors
SpacesF(..),
-- * Utilities for Defining Instances
Id(..),
Arr(..),
(:.:)(..),
(<>),
) where
--------------------------------------------------------------------------------
-- | This class provides the signature for an extensible, type-indexed function
-- that uses a format descriptor to print a variable number of well-typed
-- arguments to a string. The type variable @d@ is the format descriptor, and
-- the 'Functor' variable @f@ determines the type of the value to be shown.
--
-- An instance of @Format@ adds a (type) case to the function. Before defining
-- an instance, you must first define a format descriptor for your specific type
-- and expected input. The descriptor is often very simple. See the descriptors
-- in this module for examples.
--
-- Here is the instance for types that are instances of 'Prelude.Show'.
--
-- @
-- data 'ShowF' a = 'Show' -- Format descriptor
-- @
--
-- @
-- instance ('Prelude.Show' a) => Format ('ShowF' a) ('Arr' a) where
-- 'showsf'' 'Show' = 'Arr' 'shows'
-- @
--
-- The 'Arr' type is one of several 'Functor' wrappers necessary for defining
-- these instances.
class (Functor f) => Format d f | d -> f where
-- | Given a format descriptor @d@, return a 'Functor' wrapping a @'String' ->
-- 'String'@ type. This function may not be very useful outside of defining an
-- instance for 'Format'. Instead, consider using 'showsf' or 'showf'.
showsf' :: d -> f ShowS
--------------------------------------------------------------------------------
-- | Given a format descriptor @d@, a variable number of arguments represented
-- by @a@ (and determined by @d@), and a 'String', return a 'String' result.
-- This function removes the 'Functor' wrappers from the output of 'showsf'' to
-- get the variable number of arguments.
showsf :: (Format d f, Apply f ShowS a) => d -> a
showsf d = apply (showsf' d)
-- | Given a format descriptor @d@ and a variable number of arguments
-- represented by @a@ (and determined by @d@), return a 'String' result. This
-- function is the same as 'showsf' but has already been applied to a 'String'
-- input.
showf :: (Format d f, Apply f String a) => d -> a
showf d = apply (fmap (\f -> f "") (showsf' d))
--------------------------------------------------------------------------------
--
-- Functor wrappers
--
-- | Wrapper for a format constant that does not take any arguments. Used in
-- @instance 'Format' 'String' Id@ for example.
newtype Id a = Id a
instance Functor Id where
fmap f (Id x) = Id (f x)
-- | Wrapper for a format descriptor that takes an argument. Used in @instance
-- ('Prelude.Show' a) => 'Format' ('ShowF' a) (Arr a)@ for example.
newtype Arr a b = Arr (a -> b)
instance Functor (Arr a) where
fmap f (Arr g) = Arr (f . g)
-- | Wrapper for a format descriptor that composes two descriptors. Used in
-- @instance ('Format' d1 f1, 'Format' d2 f2) => 'Format' (d1 :%: d2) (f1 :.:
-- f2)@ for example.
newtype (:.:) f g a = Comp (f (g a))
infixr 8 :.:
instance (Functor f, Functor g) => Functor (f :.: g) where
fmap f (Comp fga) = Comp (fmap (fmap f) fga)
-- | Helpful function for defining instances of composed format descriptors.
(<>) :: (Functor f, Functor g) => f (b -> c) -> g (a -> b) -> (:.:) f g (a -> c)
f <> g = Comp (fmap (\s -> fmap (\t -> s . t) g) f)
infixr 8 <>
--------------------------------------------------------------------------------
--
-- Functor wrapper removal
--
class (Functor f) => Apply f a b | f a -> b where
apply :: f a -> b
instance Apply Id a a where
apply (Id a) = a
instance Apply (Arr a) b (a -> b) where
apply (Arr f) = f
instance (Apply f b c, Apply g a b) => Apply (f :.: g) a c where
apply (Comp fga) = apply (fmap apply fga)
--------------------------------------------------------------------------------
--
-- Format constants
--
-- These are not descriptors in the traditional sense. These are constants that
-- are shown directly without taking arguments.
--
-- | Print the enclosed 'String'.
instance Format String Id where
showsf' s = Id (showString s)
-- | Print the enclosed 'Char'.
instance Format Char Id where
showsf' c = Id (showChar c)
--------------------------------------------------------------------------------
--
-- Basic format descriptors
--
-- | Print a character argument.
data CharF = Char
instance Format CharF (Arr Char) where
showsf' Char = Arr showChar
-- | Print a string argument.
data StringF = String
instance Format StringF (Arr String) where
showsf' String = Arr showString
-- | Print an 'Int' argument.
data IntF = Int
instance Format IntF (Arr Int) where
showsf' Int = Arr shows
-- | Print an 'Integer' argument.
data IntegerF = Integer
instance Format IntegerF (Arr Integer) where
showsf' Integer = Arr shows
-- | Print a 'Float' argument.
data FloatF = Float
instance Format FloatF (Arr Float) where
showsf' Float = Arr shows
-- | Print a 'Double' argument.
data DoubleF = Double
instance Format DoubleF (Arr Double) where
showsf' Double = Arr shows
--------------------------------------------------------------------------------
--
-- Class format descriptors
--
-- | Print an argument whose type is an instance of the class 'Prelude.Show'.
data ShowF a = Show
instance (Show a) => Format (ShowF a) (Arr a) where
showsf' Show = Arr shows
-- | Print an argument whose type is an instance of the class 'Prelude.Num'.
data NumF a = Num
instance (Num a, Show a) => Format (NumF a) (Arr a) where
showsf' Num = Arr shows
--------------------------------------------------------------------------------
--
-- Other format descriptors
--
-- | Print a specified number of spaces.
data SpacesF = Spaces Int
instance Format SpacesF Id where
showsf' (Spaces n) = Id (showString (replicate n ' '))
--------------------------------------------------------------------------------
--
-- Recursive format descriptors
--
-- | Right-associative pair. First print a @a@-type format and then a @b@-type
-- format.
data a :%: b = a :%: b
deriving (Eq, Show)
infixr 8 :%:
-- | Right-associative pair. This is a shorter, functional equivalent to the
-- type @(:%:)@.
(%) :: a -> b -> a :%: b
(%) = (:%:)
infixr 8 %
instance (Format d1 f1, Format d2 f2) => Format (d1 :%: d2) (f1 :.: f2) where
showsf' (d1 :%: d2) = showsf' d1 <> showsf' d2
-- | Print a format of one type wrapped by two other formats of a different
-- type.
data WrapF inner outer = Wrap outer inner outer
instance (Format din fin, Format dout fout)
=> Format (WrapF din dout) (fout :.: fin :.: fout) where
showsf' (Wrap doutl din doutr) = showsf' doutl <> showsf' din <> showsf' doutr
-- | Print a format aligned left or right within a column of the given width.
data AlignF a = Align Dir Int a
-- | Same as 'AlignF' but chop off the output if it extends past the column
-- width.
data AlignChopF a = AlignChop Dir Int a
-- | Direction (left or right) used for 'AlignF' and 'AlignChopF'.
data Dir = L | R
align :: Bool -> Dir -> Int -> ShowS -> ShowS
align doChop dir wid input =
case dir of
L -> chop (take wid) . input . addSpaces
R -> chop (drop (len - wid)) . addSpaces . input
where
len = length (input "")
spaces = replicate (wid - len) ' '
chop act = if doChop && len > wid then act else id
addSpaces = if len < wid then showString spaces else id
instance (Format d f) => Format (AlignF d) f where
showsf' (Align dir wid d) = fmap (align False dir wid) (showsf' d)
instance (Format d f) => Format (AlignChopF d) f where
showsf' (AlignChop dir wid d) = fmap (align True dir wid) (showsf' d)
--------------------------------------------------------------------------------
--
-- Tuple format descriptors: These all follow the same pattern.
--
instance
(Format d1 f1, Format d2 f2)
=> Format
(d1, d2)
(f1 :.: f2)
where
showsf' (d1, d2) =
showsf' d1 <> showsf' d2
instance
(Format d1 f1, Format d2 f2, Format d3 f3)
=> Format
(d1, d2, d3)
(f1 :.: f2 :.: f3)
where
showsf' (d1, d2, d3) =
showsf' d1 <> showsf' d2 <> showsf' d3
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4)
=> Format
(d1, d2, d3, d4)
(f1 :.: f2 :.: f3 :.: f4)
where
showsf' (d1, d2, d3, d4) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5)
=> Format
(d1, d2, d3, d4, d5)
(f1 :.: f2 :.: f3 :.: f4 :.: f5)
where
showsf' (d1, d2, d3, d4, d5) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6)
=> Format
(d1, d2, d3, d4, d5, d6)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6)
where
showsf' (d1, d2, d3, d4, d5, d6) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7)
=> Format
(d1, d2, d3, d4, d5, d6, d7)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7)
where
showsf' (d1, d2, d3, d4, d5, d6, d7) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7, Format d8 f8)
=> Format
(d1, d2, d3, d4, d5, d6, d7, d8)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7 :.: f8)
where
showsf' (d1, d2, d3, d4, d5, d6, d7, d8) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7 <> showsf' d8
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7, Format d8 f8, Format d9 f9)
=> Format
(d1, d2, d3, d4, d5, d6, d7, d8, d9)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7 :.: f8 :.: f9)
where
showsf' (d1, d2, d3, d4, d5, d6, d7, d8, d9) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7 <> showsf' d8 <> showsf' d9
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7, Format d8 f8, Format d9 f9, Format d10 f10)
=> Format
(d1, d2, d3, d4, d5, d6, d7, d8, d9, d10)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7 :.: f8 :.: f9 :.: f10)
where
showsf' (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7 <> showsf' d8 <> showsf' d9 <> showsf' d10
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7, Format d8 f8, Format d9 f9, Format d10 f10,
Format d11 f11)
=> Format
(d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7 :.: f8 :.: f9 :.: f10 :.: f11)
where
showsf' (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7 <> showsf' d8 <> showsf' d9 <> showsf' d10 <>
showsf' d11
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7, Format d8 f8, Format d9 f9, Format d10 f10,
Format d11 f11, Format d12 f12)
=> Format
(d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7 :.: f8 :.: f9 :.: f10 :.:
f11 :.: f12)
where
showsf' (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7 <> showsf' d8 <> showsf' d9 <> showsf' d10 <>
showsf' d11 <> showsf' d12
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7, Format d8 f8, Format d9 f9, Format d10 f10,
Format d11 f11, Format d12 f12, Format d13 f13)
=> Format
(d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7 :.: f8 :.: f9 :.: f10 :.:
f11 :.: f12 :.: f13)
where
showsf' (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7 <> showsf' d8 <> showsf' d9 <> showsf' d10 <>
showsf' d11 <> showsf' d12 <> showsf' d13
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7, Format d8 f8, Format d9 f9, Format d10 f10,
Format d11 f11, Format d12 f12, Format d13 f13, Format d14 f14)
=> Format
(d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7 :.: f8 :.: f9 :.: f10 :.:
f11 :.: f12 :.: f13 :.: f14)
where
showsf' (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7 <> showsf' d8 <> showsf' d9 <> showsf' d10 <>
showsf' d11 <> showsf' d12 <> showsf' d13 <> showsf' d14
instance
(Format d1 f1, Format d2 f2, Format d3 f3, Format d4 f4, Format d5 f5,
Format d6 f6, Format d7 f7, Format d8 f8, Format d9 f9, Format d10 f10,
Format d11 f11, Format d12 f12, Format d13 f13, Format d14 f14,
Format d15 f15)
=> Format
(d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14, d15)
(f1 :.: f2 :.: f3 :.: f4 :.: f5 :.: f6 :.: f7 :.: f8 :.: f9 :.: f10 :.:
f11 :.: f12 :.: f13 :.: f14 :.: f15)
where
showsf' (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14, d15) =
showsf' d1 <> showsf' d2 <> showsf' d3 <> showsf' d4 <> showsf' d5 <>
showsf' d6 <> showsf' d7 <> showsf' d8 <> showsf' d9 <> showsf' d10 <>
showsf' d11 <> showsf' d12 <> showsf' d13 <> showsf' d14 <> showsf' d15
Jump to Line
Something went wrong with that request. Please try again.