xformat (empty) → 0.1
raw patch · 5 files changed
+1220/−0 lines, 5 filesdep +basebuild-type:Customsetup-changed
Dependencies added: base
Files
- LICENSE +28/−0
- Setup.lhs +55/−0
- src/Text/XFormat/Read.hs +571/−0
- src/Text/XFormat/Show.hs +512/−0
- xformat.cabal +54/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2009 Sean Leather+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of Universiteit Utrecht nor the names of its contributors+ may be used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.lhs view
@@ -0,0 +1,55 @@+#! /usr/bin/env runhaskell++\begin{code}+{-# OPTIONS -Wall #-}++-----------------------------------------------------------------------------+-- |+-- Module : Setup+-- Copyright : (c) 2009 Sean Leather+-- License : BSD3+--+-- Maintainer : leather@cs.uu.nl+-----------------------------------------------------------------------------++module Main (main) where++import System.Cmd+ ( system+ )++import System.FilePath+ ( (</>)+ )++import Distribution.Simple+ ( defaultMainWithHooks+ , simpleUserHooks+ , UserHooks(runTests)+ , Args+ )++import Distribution.Simple.LocalBuildInfo+ ( LocalBuildInfo+ )++import Distribution.PackageDescription+ ( PackageDescription+ )++main :: IO ()+main = defaultMainWithHooks hooks+ where+ hooks = simpleUserHooks+ { runTests = runTests'+ }++-- Run a 'test' binary that gets built when configured with '-ftest'.+runTests' :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()+runTests' _ _ _ _ = system cmd >> return ()+ where testdir = "dist" </> "build" </> "test"+ testcmd = "." </> "test"+ cmd = "cd " ++ testdir ++ " && " ++ testcmd++\end{code}+
+ src/Text/XFormat/Read.hs view
@@ -0,0 +1,571 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}++--------------------------------------------------------------------------------+-- |+-- Module : Text.XFormat.Read+-- 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 reading+-- well-typed values from a string with a format descriptor. This may be+-- considered a Haskell variant of the C @scanf@ function.+--+-- If you are primarily interested in using this library, you will want to see+-- 'readsf' and 'readf', 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.Read (++ -- * The Class++ Format(..),++ -- * The Functions++ readsf,+ readf,++ -- * Format Descriptors++ -- | These are used to indicate which values and types to read.++ -- ** Basic Format Descriptors++ CharF(..),+ IntF(..),+ IntegerF(..),+ FloatF(..),+ DoubleF(..),+ StringF(..),++ -- ** Class-based Format Descriptors++ ReadF(..),+ NumF(..),++ -- ** Recursive Format Descriptors++ (:%:)(..),+ (%),++ WrapF(..),+ MaybeF(..),+ ChoiceF(..),+ EitherF(..),+ EitherLF(..),++ -- ** Other Format Descriptors++ SpaceF(..),++) where++--------------------------------------------------------------------------------++import Text.ParserCombinators.ReadP+import Data.Char (isSpace)++--------------------------------------------------------------------------------++-- | This class provides the signature for an extensible, type-indexed function+-- that uses a format descriptor to parse a string input and return a well-typed+-- value. The type variable @d@ is the format descriptor, and the variable @a@+-- is the type of the value to be read from the input.+--+-- 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.Read'.+--+-- @+-- data 'ReadF' a = 'Read' -- Format descriptor+-- @+-- +-- @+-- instance ('Prelude.Read' a) => Format ('ReadF' a) a where+-- 'readpf' 'Read' = 'readS_to_P' 'reads'+-- @+--+-- Note that you will need some of the combinators (such as 'readS_to_P') in+-- "Text.ParserCombinators.ReadP".++class Format d a | d -> a where++ -- | Given a format descriptor @d@, return a 'ReadP' parser for a type @a@.+ -- This function may not be very useful outside of defining an instance for+ -- 'Format'. Instead, consider using 'readsf' or 'readf'.++ readpf :: d -> ReadP a++--------------------------------------------------------------------------------++-- | Given a format descriptor @d@ and a 'String', return a list of successes+-- for the type @a@, i.e. @[(a, 'String')]@. This function simply transforms the+-- 'ReadP' parser of 'readpf' to a 'ReadS' function.++readsf :: (Format d a) => d -> ReadS a+readsf fmt = readP_to_S (readpf fmt)++-- | Given a format descriptor @d@ and a 'String', return an optional result of+-- the type @a@. This function simply returns the head of the list from 'readsf'+-- if it was successful.++readf :: (Format d a) => d -> String -> Maybe a+readf fmt s = headfirst (readsf fmt s)+ where+ headfirst [] = Nothing+ headfirst ((a,_):_) = Just a++--------------------------------------------------------------------------------++--+-- Format constants+--+-- These are not descriptors in the traditional sense. These are constants that+-- are compared with parsed input.+--++-- | Parse a 'String' and return it if it is equal to the enclosed value.++instance Format String String where+ readpf = string++-- | Parse a 'Char' and return it if it is equal to the enclosed value.++instance Format Char Char where+ readpf = char++--------------------------------------------------------------------------------++--+-- Basic format descriptors+--++-- | Parse a character.++data CharF = Char++instance Format CharF Char where+ readpf Char = get++-- | Parse a string. Reads until the end of the input.++data StringF = String++instance Format StringF String where+ readpf String = munch (const True)++-- | Parse an 'Int'.++data IntF = Int++instance Format IntF Int where+ readpf Int = readS_to_P reads++-- | Parse an 'Integer'.++data IntegerF = Integer++instance Format IntegerF Integer where+ readpf Integer = readS_to_P reads++-- | Parse a 'Float'.++data FloatF = Float++instance Format FloatF Float where+ readpf Float = readS_to_P reads++-- | Parse a 'Double'.++data DoubleF = Double++instance Format DoubleF Double where+ readpf Double = readS_to_P reads++--------------------------------------------------------------------------------++--+-- Class format descriptors+--++-- | Parse a value whose type is an instance of the class 'Prelude.Read'.++data ReadF a = Read++instance (Read a) => Format (ReadF a) a where+ readpf Read = readS_to_P reads++-- | Parse a value whose type is an instance of the class 'Prelude.Num'.++data NumF a = Num++instance (Read a, Num a) => Format (NumF a) a where+ readpf Num = readS_to_P reads++--------------------------------------------------------------------------------++--+-- Other format descriptors+--++-- | Parse a @'ReadP' a@ value.++instance Format (ReadP a) a where+ readpf = id++-- | Parse zero or more whitespace characters. Stop when a non-whitespace+-- character is reached.++data SpaceF = Space++instance Format SpaceF String where+ readpf Space = munch isSpace++--------------------------------------------------------------------------------++--+-- Recursive format descriptors+--++-- | Right-associative pair. First parse 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 a1, Format d2 a2) => Format (d1 :%: d2) (a1 :%: a2) where+ readpf (d1 :%: d2) = do+ a1 <- readpf d1+ a2 <- readpf d2+ return (a1 :%: a2)++-- | Parse 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 ain, Format dout aout)+ => Format (WrapF din dout) (aout :%: ain :%: aout) where+ readpf (Wrap doutl din doutr) = do+ aoutl <- readpf doutl+ ain <- readpf din+ aoutr <- readpf doutr+ return (aoutl :%: ain :%: aoutr)++-- | Parse an optional value.++data MaybeF a = Maybe a++instance (Format d a) => Format (MaybeF d) (Maybe a) where+ readpf (Maybe d) = (readpf d >>= return . Just) <++ return Nothing++-- | Parse one of the optional formats in a list.++data ChoiceF a = Choice [a]++instance (Format d a) => Format (ChoiceF d) a where+ readpf (Choice ds) = choice (fmap readpf ds)++-- | Parse one of two formats in a fully symmetric choice.++data EitherF a b = Either a b++instance (Format d1 a1, Format d2 a2) => Format (EitherF d1 d2) (Either a1 a2) where+ readpf (Either d1 d2) =+ (readpf d1 >>= return . Left) +++ (readpf d2 >>= return . Right)++-- | Parse one of two formats, trying the left one first.++data EitherLF a b = EitherL a b++instance (Format d1 a1, Format d2 a2) => Format (EitherLF d1 d2) (Either a1 a2) where+ readpf (EitherL d1 d2) =+ (readpf d1 >>= return . Left) <++ (readpf d2 >>= return . Right)++--------------------------------------------------------------------------------++--+-- Tuple format descriptors: These all follow the same pattern.+--++instance (Format d1 a1, Format d2 a2) => Format (d1, d2) (a1, a2) where+ readpf (d1, d2) = do+ a1 <- readpf d1+ a2 <- readpf d2+ return (a1, a2)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3)+ => Format+ (d1, d2, d3)+ (a1, a2, a3)+ where+ readpf (d1, d2, d3) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ return (a1, a2, a3)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4)+ => Format+ (d1, d2, d3, d4)+ (a1, a2, a3, a4)+ where+ readpf (d1, d2, d3, d4) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ return (a1, a2, a3, a4)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5)+ => Format+ (d1, d2, d3, d4, d5)+ (a1, a2, a3, a4, a5)+ where+ readpf (d1, d2, d3, d4, d5) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ return (a1, a2, a3, a4, a5)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6)+ => Format+ (d1, d2, d3, d4, d5, d6)+ (a1, a2, a3, a4, a5, a6)+ where+ readpf (d1, d2, d3, d4, d5, d6) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ return (a1, a2, a3, a4, a5, a6)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7)+ => Format+ (d1, d2, d3, d4, d5, d6, d7)+ (a1, a2, a3, a4, a5, a6, a7)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ return (a1, a2, a3, a4, a5, a6, a7)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7, Format d8 a8)+ => Format+ (d1, d2, d3, d4, d5, d6, d7, d8)+ (a1, a2, a3, a4, a5, a6, a7, a8)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7, d8) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ a8 <- readpf d8+ return (a1, a2, a3, a4, a5, a6, a7, a8)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7, Format d8 a8, Format d9 a9)+ => Format+ (d1, d2, d3, d4, d5, d6, d7, d8, d9)+ (a1, a2, a3, a4, a5, a6, a7, a8, a9)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7, d8, d9) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ a8 <- readpf d8+ a9 <- readpf d9+ return (a1, a2, a3, a4, a5, a6, a7, a8, a9)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7, Format d8 a8, Format d9 a9, Format d10 a10)+ => Format+ (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10)+ (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ a8 <- readpf d8+ a9 <- readpf d9+ a10 <- readpf d10+ return (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7, Format d8 a8, Format d9 a9, Format d10 a10,+ Format d11 a11)+ => Format+ (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11)+ (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ a8 <- readpf d8+ a9 <- readpf d9+ a10 <- readpf d10+ a11 <- readpf d11+ return (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7, Format d8 a8, Format d9 a9, Format d10 a10,+ Format d11 a11, Format d12 a12)+ => Format+ (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12)+ (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ a8 <- readpf d8+ a9 <- readpf d9+ a10 <- readpf d10+ a11 <- readpf d11+ a12 <- readpf d12+ return (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7, Format d8 a8, Format d9 a9, Format d10 a10,+ Format d11 a11, Format d12 a12, Format d13 a13)+ => Format+ (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13)+ (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ a8 <- readpf d8+ a9 <- readpf d9+ a10 <- readpf d10+ a11 <- readpf d11+ a12 <- readpf d12+ a13 <- readpf d13+ return (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7, Format d8 a8, Format d9 a9, Format d10 a10,+ Format d11 a11, Format d12 a12, Format d13 a13, Format d14 a14)+ => Format+ (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14)+ (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ a8 <- readpf d8+ a9 <- readpf d9+ a10 <- readpf d10+ a11 <- readpf d11+ a12 <- readpf d12+ a13 <- readpf d13+ a14 <- readpf d14+ return (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14)++instance+ (Format d1 a1, Format d2 a2, Format d3 a3, Format d4 a4, Format d5 a5,+ Format d6 a6, Format d7 a7, Format d8 a8, Format d9 a9, Format d10 a10,+ Format d11 a11, Format d12 a12, Format d13 a13, Format d14 a14,+ Format d15 a15)+ => Format+ (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14, d15)+ (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15)+ where+ readpf (d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13, d14, d15) = do+ a1 <- readpf d1+ a2 <- readpf d2+ a3 <- readpf d3+ a4 <- readpf d4+ a5 <- readpf d5+ a6 <- readpf d6+ a7 <- readpf d7+ a8 <- readpf d8+ a9 <- readpf d9+ a10 <- readpf d10+ a11 <- readpf d11+ a12 <- readpf d12+ a13 <- readpf d13+ a14 <- readpf d14+ a15 <- readpf d15+ return (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15)+
+ src/Text/XFormat/Show.hs view
@@ -0,0 +1,512 @@+{-# 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(..),+ 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) => 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++-- | Direction (left or right) used for 'AlignF'.++data Dir = L | R++align :: Dir -> Int -> ShowS -> ShowS+align dir wid f =+ case dir of+ L -> f . g+ R -> g . f+ where+ len = length (f "")+ g = if len < wid then showString (replicate (wid - len) ' ') else id++instance (Format d f) => Format (AlignF d) f where+ showsf' (Align dir wid d) = fmap (align 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+
+ xformat.cabal view
@@ -0,0 +1,54 @@+name: xformat+version: 0.1+synopsis:++ Extensible, type-safe formatting with scanf- and printf-like functions++homepage: http://github.com/spl/xformat/tree/master+description:++ /Warning:/ This version of the package is very experimental and the interface+ may change in later versions. I am seeking comments to improve it.+ .+ This package is composed of two functions for formatted conversion between+ strings and typed values. Each is defined as a type-indexed function using a+ type class with multiple parameters and functional dependencies along with+ format descriptors.+ .+ "Text.XFormat.Read" allows one to parse values from a formatted string. Its+ functionality is similar to the C @scanf@ function. Unlike @scanf@, however,+ the format descriptor is well-typed, ensuring that the output type is+ statically known.+ .+ "Text.XFormat.Show" allows one to print values to a formatted string. Its+ functionality is similar to the C @printf@ function. Unlike @printf@, however,+ the format descriptor is well-typed, ensuring that the variable number+ arguments are statically known.+ .+ These functions can be easily extended to support new formats and new types.+ Extension is simple: define a format descriptor and an instance of the+ appropriate class.++category: Text, Generics+copyright: (c) 2009 Sean Leather+license: BSD3+license-file: LICENSE+author: Sean Leather,+maintainer: leather@cs.uu.nl+stability: experimental+build-type: Custom+cabal-version: >= 1.2.1+tested-with: GHC == 6.8.3, GHC == 6.10.1++--------------------------------------------------------------------------------++Library+ hs-source-dirs: src++ exposed-modules: Text.XFormat.Read+ Text.XFormat.Show++ build-depends: base >= 3.0 && < 5.0++ ghc-options: -Wall -O2+