hformat 0.1.0.1 → 0.2.0.0

raw patch · 3 files changed

+63/−36 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hformat.cabal +1/−1
• src/Text/Format.hs +46/−22
• tests/Test.hs +16/−13

@@ -1,5 +1,5 @@ name:                hformat
-version:             0.1.0.1
+version:             0.2.0.0
 synopsis:            Simple Haskell formatting
 description: String formatting
 homepage:            http://github.com/mvoidex/hformat

@@ -3,9 +3,9 @@ -- | Format string with named args
 --
 -- >-- Named args
--- >"My name is {name}, I am {age} years old" ~~ ("name" %= "Joe") ~~ ("age" %= 24) ≡ "My name is Joe, I am 24 years old"
+-- >"My name is {name}, I am {age} years old" ~~ ("name" ~% "Joe") ~~ ("age" ~% 24) ≡ "My name is Joe, I am 24 years old"
 -- >-- Arg can have default value
--- >"{var:x} = {val:10}" ~~ ("var" %= y) ≡ "y = 10"
+-- >"{var:x} = {val:10}" ~~ ("var" ~% y) ≡ "y = 10"
 -- >-- Numeric position can be used
 -- >"{0} {1} {0}" ~~ "foo" ~~ "bar" ≡ "foo bar foo"
 -- >-- Positions can be omitted
@@ -14,9 +14,9 @@ -- >"{} and {{}}" ~~ 10 ≡ "10 and {}"
 module Text.Format (
 	FormatArg(..), Format(..), Formatter(..),
-	build,
+	prebuild, build,
 	FormatBuild(..), Hole(..), fmt, FormatResult(..),
-	format, (~~), (%=)
+	format, formats, (~~), (~%)
 	) where
 
 import Prelude.Unicode
@@ -38,6 +38,9 @@ 	formatString ∷ String,
 	formatArgs ∷ [FormatArg] }
 
+instance Show Format where
+	show = unpack ∘ prebuild
+
 instance IsString Format where
 	fromString str = Format str []
 
@@ -57,8 +60,14 @@ 			return $ Just v'
 		return $ Formatter (maybe (Left n) Right $ readMaybe n) v
 
+prebuild ∷ Format → Text
+prebuild = buildFormat True
+
 build ∷ Format → Text
-build fstr = B.toLazyText $ mconcat $ build' 0 fstr where
+build = buildFormat False
+
+buildFormat ∷ Bool → Format → Text
+buildFormat pre fstr = B.toLazyText $ mconcat $ build' 0 fstr where
 	build' ∷ Int → Format → [Builder]
 	build' _ (Format "" _) = []
 	build' i (Format ('{':'{':fstr') args) = B.singleton '{' : build' i (Format fstr' args)
@@ -70,18 +79,24 @@ 	build' i (Format fstr' args) = fromString s : build' i (Format fstr'' args) where
 		(s, fstr'') = break (∈ "{}") fstr'
 	formatArg' ∷ Formatter → [FormatArg] → Builder
-	formatArg' (Formatter (Left name) defVal) args = fromMaybe (error $ "Argument " ++ name ++ " not set") (lookArg <|> fmap B.fromString defVal) where
-		lookArg = do
-			FormatNamed _ fval ← find byName args
-			return fval
-		byName (FormatNamed n _) = n ≡ name
-		byName _ = False
-	formatArg' (Formatter (Right i) defVal) args = fromMaybe (error $ "Argument at index " ++ show i ++ " not set") (lookIdx <|> fmap B.fromString defVal) where
-		lookIdx = do
-			FormatPos fval ← listToMaybe $ drop i $ filter isPos args
-			return fval
-		isPos (FormatPos _) = True
-		isPos _ = False
+	formatArg' f@(Formatter (Left name) defVal) args
+		| pre = fromMaybe (formatBuild f) lookArg
+		| otherwise = fromMaybe (error $ "Argument " ++ name ++ " not set") (lookArg <|> fmap formatBuild defVal)
+		where
+			lookArg = do
+				FormatNamed _ fval ← find byName args
+				return fval
+			byName (FormatNamed n _) = n ≡ name
+			byName _ = False
+	formatArg' f@(Formatter (Right i) defVal) args
+		| pre = fromMaybe (formatBuild f) lookIdx
+		| otherwise = fromMaybe (error $ "Argument at index " ++ show i ++ " not set") (lookIdx <|> fmap formatBuild defVal)
+		where
+			lookIdx = do
+				FormatPos fval ← listToMaybe $ drop i $ filter isPos args
+				return fval
+			isPos (FormatPos _) = True
+			isPos _ = False
 
 -- | FormatBuild class, by default using @show@
 class FormatBuild a where
@@ -107,12 +122,18 @@ instance FormatBuild T.Text where
 	formatBuild = B.fromText
 
+instance FormatBuild Formatter where
+	formatBuild = formatBuild ∘ show
+
 class Hole a where
 	hole ∷ a → [FormatArg]
 
 instance Hole Builder where
 	hole = return ∘ FormatPos
 
+instance {-# OVERLAPPING #-} Hole FormatArg where
+	hole = return
+
 instance {-# OVERLAPPING #-} Hole [FormatArg] where
 	hole = id
 
@@ -122,8 +143,8 @@ instance {-# OVERLAPPABLE #-} FormatBuild a ⇒ Hole a where
 	hole = return ∘ FormatPos ∘ formatBuild
 
-fmt ∷ Hole a ⇒ a → [FormatArg]
-fmt = hole
+fmt ∷ FormatBuild a ⇒ a → FormatArg
+fmt = FormatPos ∘ formatBuild
 
 class FormatResult r where
 	formatResult ∷ Format → r
@@ -140,12 +161,15 @@ format ∷ FormatResult r ⇒ String → r
 format = formatResult ∘ fromString
 
+formats ∷ FormatResult r ⇒ String → [FormatArg] → r
+formats f = formatResult ∘ Format f
+
 infixl 7 ~~
 
 (~~) ∷ (Hole a, FormatResult r) ⇒ Format → a → r
 fstr ~~ arg = formatResult $ fstr { formatArgs = formatArgs fstr ++ hole arg }
 
-infixr 8 %=
+infixr 8 ~%
 
-(%=) ∷ FormatBuild a ⇒ String → a → [FormatArg]
-name %= value = [FormatNamed name (formatBuild value)]
+(~%) ∷ FormatBuild a ⇒ String → a → FormatArg
+name ~% value = FormatNamed name (formatBuild value)

@@ -11,24 +11,27 @@ main ∷ IO ()
 main = hspec $ do
 	describe "positional arguments" $ do
-		it "should format unnamed arguments" $
+		it "should format unnamed arguments"
 			(format "{} + {} = {}" ~~ (10 ∷ Int) ~~ (12 ∷ Int) ~~ (22 ∷ Int) ≡ "10 + 12 = 22")
-		it "should format positional arguments" $
+		it "should format positional arguments"
 			(format "{0} + {0} = {1}" ~~ (10 ∷ Int) ~~ (20 ∷ Int) ≡ "10 + 10 = 20")
 	describe "named arguments" $
-		it "should format named arguments" $
-			(format "{x} + {y} = {z}" ~~ "x" %= (1 ∷ Int) ~~ "y" %= (2 ∷ Int) ~~ "z" %= (3 ∷ Int) ≡ "1 + 2 = 3")
+		it "should format named arguments"
+			(format "{x} + {y} = {z}" ~~ "x" ~% (1 ∷ Int) ~~ "y" ~% (2 ∷ Int) ~~ "z" ~% (3 ∷ Int) ≡ "1 + 2 = 3")
 	describe "default values" $ do
-		it "should accept default values for positional arguments" $
+		it "should accept default values for positional arguments"
 			(format "{0:foo} is {1:bar}" ~~ "blah" ≡ "blah is bar")
-		it "should accept default values for named arguments" $
-			(format "{x:12} + {y:13}" ~~ "y" %= (10 ∷ Int) ≡ "12 + 10")
-	describe "lists" $ do
-		it "should accept list of values" $
-			(format "{0} + {x:10} = {1}" ~~ [fmt (3 ∷ Int), "x" %= (5 ∷ Int), fmt (8 ∷ Int)] ≡ "3 + 5 = 8")
+		it "should accept default values for named arguments"
+			(format "{x:12} + {y:13}" ~~ "y" ~% (10 ∷ Int) ≡ "12 + 10")
+	describe "lists" $
+		it "should accept list of values"
+			(format "{0} + {x:10} = {1}" ~~ [fmt (3 ∷ Int), "x" ~% (5 ∷ Int), fmt (8 ∷ Int)] ≡ "3 + 5 = 8")
 	describe "escape" $
-		it "should escape curly braces" $
+		it "should escape curly braces"
 			(format "{} is not {{}}" ~~ "{}" ≡ "{} is not {}")
 	describe "mix" $
-		it "should process mixed arguments" $
-			(format "{1:foo} and {} are {what:args}" ~~ "what" %= "quux" ~~ (10 ∷ Int) ~~ (20 ∷ Int) ≡ "20 and 10 are quux")
+		it "should process mixed arguments"
+			(format "{1:foo} and {} are {what:args}" ~~ "what" ~% "quux" ~~ (10 ∷ Int) ~~ (20 ∷ Int) ≡ "20 and 10 are quux")
+	describe "prebuild" $
+		it "should show partially formatted" $
+			show (format "{0} ≡ {1}" ~~ "foo" ∷ Format) ≡ "foo ≡ {1}"