simple-text-format (empty) → 0.1
raw patch · 7 files changed
+289/−0 lines, 7 filesdep +attoparsecdep +basedep +hspecsetup-changed
Dependencies added: attoparsec, base, hspec, microlens-platform, simple-text-format, text, unordered-containers
Files
- LICENSE +30/−0
- README.md +16/−0
- Setup.hs +2/−0
- simple-text-format.cabal +48/−0
- src/Data/Text/Format/Simple.hs +61/−0
- src/Data/Text/Format/Simple/Internal.hs +73/−0
- test/Spec.hs +59/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Justus Adam (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Justus Adam nor the names of other+ 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.
+ README.md view
@@ -0,0 +1,16 @@+# simple-text-format++This library provides a very simple format string syntax with named identifiers based on `text` and `attoparsec`.++Syntax for identifiers is `${variable-name}`.+Please note that it is whitespace sentitive, meaning `${var]` references the variable `"var"` whereas `${ var}` referenced the varaible `" var"`.+The rendering is agnostic to the data structure you use to keep the identifiers.+The formatting function expects simply a function `Text -> Maybe Text`+There is currently no escaping mechanism, meaning `$` parses to `"$"` but there is no way to get a literal `${`.++```hs+let formatStr = "A string with ${var} and ${var2}"+let identMap = [("var", "something"), ("var2", "something else")] :: HashMap Text Text+format' formatStr (lookup identMap)+-- A string with something and something else+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ simple-text-format.cabal view
@@ -0,0 +1,48 @@+name: simple-text-format+version: 0.1+synopsis: Simple text based format strings with named identifiers.+description: A simple library for format strings based on text and attoparsec. See the readme for more details.+homepage: https://github.com/JustusAdam/simple-text-format#readme+license: BSD3+license-file: LICENSE+author: Justus Adam+maintainer: dev@justus.science+copyright: Copyright: (c) 2017 Justus Adam+category: Development, Text+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Data.Text.Format.Simple+ , Data.Text.Format.Simple.Internal+ build-depends: base >= 4.7 && < 5+ , text+ , attoparsec+ default-language: Haskell2010++-- executable simple-text-format-exe+-- hs-source-dirs: app+-- main-is: Main.hs+-- ghc-options: -threaded -rtsopts -with-rtsopts=-N+-- build-depends: base+-- , simple-text-format+-- default-language: Haskell2010++test-suite simple-text-format-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , simple-text-format+ , hspec+ , unordered-containers+ , text+ , microlens-platform+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/JustusAdam/simple-text-format
+ src/Data/Text/Format/Simple.hs view
@@ -0,0 +1,61 @@+-- |+-- Module : $Header$+-- Description : Simple format strings with named identifiers.+-- Copyright : (c) Justus Adam 2017. All Rights Reserved.+-- License : BSD3+-- Maintainer : dev@justus.science+-- Stability : experimental+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+module Data.Text.Format.Simple+ ( format+ , format'+ , formatC+ , formatC'+ , SubMap+ , Compiled+ , Name+ ) where+++import Data.Either+import qualified Data.Foldable as F+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Format.Simple.Internal as I+++-- | Resolver for names.+type SubMap = Name -> Maybe Text+++-- | Like 'format' but with the string already compiled+formatC :: Compiled -> SubMap -> (Text, [Name])+formatC (Compiled parts) lookup = (T.concat $ rights results, lefts results)+ where+ results = map f parts+ f (String t) = return t+ f (NamedVar n) = maybe (Left n) return $ lookup n+++-- | Like 'format'' but with the string already compiled+formatC' :: Compiled -> SubMap -> Text+formatC' p = fst . formatC p+++-- | Compile a string to a format string and substitute the identifiers from the provided function into it.+--+-- Fails if the string canno be parsed.+-- Retuns the rendered string and a list of names which were used in the string but could not be resolved by the function.+format :: Text -> SubMap -> Either String (Text, [Name])+format a m = do+ a' <- I.parse a+ return $ formatC a' m++-- | Compile a string to a format string and substitute the identifiers from the provided function into it.+--+-- All errors are ignored. Parse failure is thrown as an error and the missing names are discarded.+format' :: Text -> SubMap -> Text+format' a = either error fst . format a
+ src/Data/Text/Format/Simple/Internal.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_HADDOCK not-home #-}+module Data.Text.Format.Simple.Internal where+++import Control.Applicative+import Data.Attoparsec.Combinator+import Data.Attoparsec.Text as A+import Data.Either+import qualified Data.Foldable as F+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Exts+++-- | The name of a referenced variable.+type Name = Text+++data Part+ = String Text+ | NamedVar Name+ deriving Eq++-- | A precompiled format string. Can be used to render several times.+newtype Compiled = Compiled { unCompiled :: [Part] } deriving Eq+++instance Show Compiled where+ show = show . T.unpack . T.concat . map f . unCompiled+ where+ f (String s) = s+ f (NamedVar n) = "${" `mappend` n `mappend` "}"++instance IsString Compiled where+ fromString = either error id . Data.Text.Format.Simple.Internal.parse . fromString+++parse :: Text -> Either String Compiled+parse = parseOnly parser+++parser :: Parser Compiled+parser = Compiled <$> partParser `manyTill` endOfInput+++partParser :: Parser Part+partParser = NamedVar <$> parseVar <|> String <$> parseString++++parseVar :: Parser Name+parseVar = do+ char '$'+ char '{'+ str <- A.takeWhile (/= '}')+ char '}'+ return str+++parseString :: Parser Text+parseString = do+ str <- A.takeWhile (/= '$')++ rest <- (lookAhead (string "${") >> return "")+ <|> (T.cons <$> char '$' <*> parseString)+ <|> return ""+ return $ str `mappend` rest+
+ test/Spec.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+import Data.HashMap.Strict (HashMap)+import Data.Text (Text)+import Data.Text.Format.Simple+import Data.Text.Format.Simple.Internal+import Lens.Micro.Platform+import Test.Hspec+import GHC.Exts+++instance IsList Compiled where+ type Item Compiled = Part+ fromList = Compiled+ toList = unCompiled++parserSpec :: Spec+parserSpec = describe "the parser" $ do+ it "parses a string to a string" $+ parse "a literal string" `shouldBe` Right [String "a literal string"]+ it "parses a variable" $+ parse "${var}" `shouldBe` Right [NamedVar "var"]+ it "parses a string followed by a variable" $+ parse "str ${var}" `shouldBe` Right [String "str ", NamedVar "var"]+ it "parses a string followed by a variable w/o whitespace" $+ parse "str${var}" `shouldBe` Right [String "str", NamedVar "var"]+ it "parses a string followed by a variable followed by a string" $+ parse "str ${var} str2" `shouldBe` Right [String "str ", NamedVar "var", String " str2"]+ it "parses a literal '$'" $+ parse "$" `shouldBe` Right [String "$"]+ it "parses several consecutive literal '$'" $+ parse "$$$$" `shouldBe` Right [String "$$$$"]+++formatSpec :: Spec+formatSpec = do+ let subMap :: HashMap Name Text+ subMap = [("one", "twenty"), ("two", "fourty"), ("var", "value"), ("var2", "it")]+ lookup k = subMap ^. at k+ sp :: Compiled -> (Text, [Name])+ sp = flip formatC lookup++ describe "formatC" $ do+ it "substitutes a single named variable to itself" $+ sp "${var}" `shouldBe` ("value", [])+ it "substitutes a variable between text" $+ sp "do ${var2} right" `shouldBe` ("do it right", [])+ it "substitutes several variables" $+ sp "counting from ${one} to ${two}" `shouldBe` ("counting from twenty to fourty", [])+ it "reports missing names" $+ sp "counting from ${one} to ${three}" `shouldBe` ("counting from twenty to ", ["three"])+++main :: IO ()+main = hspec $ do+ parserSpec+ formatSpec