yasi (empty) → 0.0.0.0
raw patch · 9 files changed
+444/−0 lines, 9 filesdep +basedep +bytestringdep +hedgehog
Dependencies added: base, bytestring, hedgehog, tasty, tasty-hedgehog, tasty-hunit, template-haskell, text, yasi
Files
- CHANGELOG.md +5/−0
- LICENSE +121/−0
- README.md +7/−0
- src/Yasi.hs +39/−0
- src/Yasi/Internal.hs +150/−0
- test/Driver.hs +1/−0
- test/Interpolations.hs +34/−0
- test/Segments.hs +25/−0
- yasi.cabal +62/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for yasi++## 0.0.0.0 -- 2021-02-13++* First version. Released on an uNsUsPeCtInG world.
+ LICENSE view
@@ -0,0 +1,121 @@+Creative Commons Legal Code++CC0 1.0 Universal++ CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE+ LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN+ ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS+ INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES+ REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS+ PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM+ THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED+ HEREUNDER.++Statement of Purpose++The laws of most jurisdictions throughout the world automatically confer+exclusive Copyright and Related Rights (defined below) upon the creator+and subsequent owner(s) (each and all, an "owner") of an original work of+authorship and/or a database (each, a "Work").++Certain owners wish to permanently relinquish those rights to a Work for+the purpose of contributing to a commons of creative, cultural and+scientific works ("Commons") that the public can reliably and without fear+of later claims of infringement build upon, modify, incorporate in other+works, reuse and redistribute as freely as possible in any form whatsoever+and for any purposes, including without limitation commercial purposes.+These owners may contribute to the Commons to promote the ideal of a free+culture and the further production of creative, cultural and scientific+works, or to gain reputation or greater distribution for their Work in+part through the use and efforts of others.++For these and/or other purposes and motivations, and without any+expectation of additional consideration or compensation, the person+associating CC0 with a Work (the "Affirmer"), to the extent that he or she+is an owner of Copyright and Related Rights in the Work, voluntarily+elects to apply CC0 to the Work and publicly distribute the Work under its+terms, with knowledge of his or her Copyright and Related Rights in the+Work and the meaning and intended legal effect of CC0 on those rights.++1. Copyright and Related Rights. A Work made available under CC0 may be+protected by copyright and related or neighboring rights ("Copyright and+Related Rights"). Copyright and Related Rights include, but are not+limited to, the following:++ i. the right to reproduce, adapt, distribute, perform, display,+ communicate, and translate a Work;+ ii. moral rights retained by the original author(s) and/or performer(s);+iii. publicity and privacy rights pertaining to a person's image or+ likeness depicted in a Work;+ iv. rights protecting against unfair competition in regards to a Work,+ subject to the limitations in paragraph 4(a), below;+ v. rights protecting the extraction, dissemination, use and reuse of data+ in a Work;+ vi. database rights (such as those arising under Directive 96/9/EC of the+ European Parliament and of the Council of 11 March 1996 on the legal+ protection of databases, and under any national implementation+ thereof, including any amended or successor version of such+ directive); and+vii. other similar, equivalent or corresponding rights throughout the+ world based on applicable law or treaty, and any national+ implementations thereof.++2. Waiver. To the greatest extent permitted by, but not in contravention+of, applicable law, Affirmer hereby overtly, fully, permanently,+irrevocably and unconditionally waives, abandons, and surrenders all of+Affirmer's Copyright and Related Rights and associated claims and causes+of action, whether now known or unknown (including existing as well as+future claims and causes of action), in the Work (i) in all territories+worldwide, (ii) for the maximum duration provided by applicable law or+treaty (including future time extensions), (iii) in any current or future+medium and for any number of copies, and (iv) for any purpose whatsoever,+including without limitation commercial, advertising or promotional+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each+member of the public at large and to the detriment of Affirmer's heirs and+successors, fully intending that such Waiver shall not be subject to+revocation, rescission, cancellation, termination, or any other legal or+equitable action to disrupt the quiet enjoyment of the Work by the public+as contemplated by Affirmer's express Statement of Purpose.++3. Public License Fallback. Should any part of the Waiver for any reason+be judged legally invalid or ineffective under applicable law, then the+Waiver shall be preserved to the maximum extent permitted taking into+account Affirmer's express Statement of Purpose. In addition, to the+extent the Waiver is so judged Affirmer hereby grants to each affected+person a royalty-free, non transferable, non sublicensable, non exclusive,+irrevocable and unconditional license to exercise Affirmer's Copyright and+Related Rights in the Work (i) in all territories worldwide, (ii) for the+maximum duration provided by applicable law or treaty (including future+time extensions), (iii) in any current or future medium and for any number+of copies, and (iv) for any purpose whatsoever, including without+limitation commercial, advertising or promotional purposes (the+"License"). The License shall be deemed effective as of the date CC0 was+applied by Affirmer to the Work. Should any part of the License for any+reason be judged legally invalid or ineffective under applicable law, such+partial invalidity or ineffectiveness shall not invalidate the remainder+of the License, and in such case Affirmer hereby affirms that he or she+will not (i) exercise any of his or her remaining Copyright and Related+Rights in the Work or (ii) assert any associated claims and causes of+action with respect to the Work, in either case contrary to Affirmer's+express Statement of Purpose.++4. Limitations and Disclaimers.++ a. No trademark or patent rights held by Affirmer are waived, abandoned,+ surrendered, licensed or otherwise affected by this document.+ b. Affirmer offers the Work as-is and makes no representations or+ warranties of any kind concerning the Work, express, implied,+ statutory or otherwise, including without limitation warranties of+ title, merchantability, fitness for a particular purpose, non+ infringement, or the absence of latent or other defects, accuracy, or+ the present or absence of errors, whether or not discoverable, all to+ the greatest extent permissible under applicable law.+ c. Affirmer disclaims responsibility for clearing rights of other persons+ that may apply to the Work or any use thereof, including without+ limitation any person's Copyright and Related Rights in the Work.+ Further, Affirmer disclaims responsibility for obtaining any necessary+ consents, permissions or other rights required for any use of the+ Work.+ d. Affirmer understands and acknowledges that Creative Commons is not a+ party to this document and has no duty or obligation with respect to+ this CC0 or use of the Work.
+ README.md view
@@ -0,0 +1,7 @@+# yasi+[](https://github.com/amesgen/yasi/actions)+[](https://hackage.haskell.org/package/yasi)++Yet another string interpolator for Haskell.++See [the haddocks](https://hackage.haskell.org/package/yasi/docs/Yasi.html) for documentation.
+ src/Yasi.hs view
@@ -0,0 +1,39 @@+-- | Yet another string interpolator+--+-- * Dead simple+-- * No dependency on [haskell-src-meta](https://hackage.haskell.org/package/haskell-src-meta).+-- It is not actively developed, has long compile times and several bugs, some of which are+-- by design (e.g. operator fixities).+-- * Supports to interpolate 'String', 'Data.Text.Text', 'Data.Text.Lazy.Text',+-- 'Data.ByteString.ByteString' and 'Data.ByteString.Lazy.ByteString' (UTF8).+module Yasi (i) where++import qualified Language.Haskell.TH.Quote as TH+import Yasi.Internal++-- $setup+-- >>> import Yasi+-- >>> import Data.Text (Text)+-- >>> import Data.ByteString (ByteString)++-- | The interpolator, intended to be used with+-- [@QuasiQuotes@](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/exts/template_haskell.html#extension-QuasiQuotes).+--+-- >>> :set -XQuasiQuotes+--+-- >>> (foo, bar) = ("yet another ", "interpolator")+-- >>> [i|${foo}string $bar|] :: String+-- "yet another string interpolator"+--+-- You can also use @${}@ to create a function interpolator (this "abstraction" feature is inspired by+-- [interpolate](https://hackage.haskell.org/package/interpolate)):+--+-- >>> [i|more ${}${} code|] "point" "free" :: Text+-- "more pointfree code"+--+-- To use 'show' to interpolate a value:+--+-- >>> let x = 1 + 1 in [i|1 + 1 = ${show x}|] :: ByteString+-- "1 + 1 = 2"+i :: TH.QuasiQuoter+i = interpolator '$' pure pure
+ src/Yasi/Internal.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE CPP #-}++-- | Internal module, no stability guarantees+module Yasi.Internal+ ( Segment (..),+ parseSegments,+ interpolator,+ Stringy (..),+ )+where++import Control.Monad ((>=>))+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Char as C+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import GHC.Generics (Generic)+import qualified Language.Haskell.TH.Quote as TH+import qualified Language.Haskell.TH.Syntax as TH++#if !(MIN_VERSION_base(4,13,0))+import Control.Monad.Fail (MonadFail)+#endif++data Segment+ = Lit String+ | Var String+ | ShowVar String+ | Abs -- idea due to interpolate+ deriving (Show, Eq, Generic)++parseSegments :: MonadFail m => Char -> String -> m [Segment]+parseSegments c = fmap (group []) . go+ where+ go s+ | let (lit, rest) = span (/= c) s, not (null lit) = (Lit lit :) <$> go rest+ | s == "" = pure []+ | s == [c] = fail $ "should not end with single " <> [c]+ | _ : c' : rest <- s, c == c' = (Lit [c] :) <$> go rest+ | _ : '{' : rest <- s = case span (/= '}') rest of+ (var, '}' : rest) ->+ let seg = case var of+ "" -> Abs+ 's' : 'h' : 'o' : 'w' : ' ' : var -> ShowVar var+ var -> Var var+ in (seg :) <$> go rest+ _ -> fail "missing closing bracket"+ | _ : v : rest' <- s,+ isVarStartChar v =+ let (vs, rest) = span isVarChar rest'+ in (Var (v : vs) :) <$> go rest+ | otherwise = fail $ "invalid char after " <> [c]+ isVarStartChar v = C.isAscii v && C.isAlpha v+ isVarChar v = C.isAscii v && (C.isAlphaNum v || v == '_' || v == '\'')++ group ls [] = lit ls+ group ls (Lit l : ss) = group (l : ls) ss+ group ls (s : ss) = lit ls ++ (s : group [] ss)+ lit [] = []+ lit ls = [Lit $ mconcat $ reverse ls]++ipExpr :: TH.Exp -> TH.Exp -> [Segment] -> TH.Q TH.Exp+ipExpr cast combine segs = do+ (ls, lams) <- go segs+ pure $ lams $ TH.AppE combine (TH.ListE ls)+ where+ go = \case+ [] -> pure ([], id)+ (s : ss) -> prep (go ss) $ case s of+ Lit l -> pure (TH.SigE (TH.LitE (TH.StringL l)) (TH.ConT ''String), id)+ Var v -> pure (TH.VarE (TH.mkName v), id)+ ShowVar v -> pure (TH.AppE (TH.VarE 'show) $ TH.VarE (TH.mkName v), id)+ Abs -> do+ n <- TH.newName "int"+ pure (TH.VarE n, TH.LamE [TH.VarP n])+ prep asg af = do+ (as, g) <- asg+ (a, f) <- af+ pure (TH.AppE cast a : as, f . g)++interpolator ::+ Char ->+ -- | postprocess the 'Segment's+ ([Segment] -> TH.Q [Segment]) ->+ -- | postprocess the 'TH.Exp'+ (TH.Exp -> TH.Q TH.Exp) ->+ TH.QuasiQuoter+interpolator c pp pp' = TH.QuasiQuoter {..}+ where+ quoteExp = parseSegments c >=> pp >=> ipExpr (TH.VarE 'stringy) (TH.VarE 'mconcat) >=> pp'+ quotePat = const $ fail "pattern context not supported"+ quoteType = const $ fail "type context not supported"+ quoteDec = const $ fail "declaration context not supported"++class Stringy a b where+ stringy :: a -> b++instance Stringy String String where+ stringy = id++instance Stringy String T.Text where+ stringy = T.pack++instance Stringy String TL.Text where+ stringy = TL.pack++instance Stringy String B.ByteString where+ stringy = T.encodeUtf8 . T.pack++instance Stringy String BL.ByteString where+ stringy = TL.encodeUtf8 . TL.pack++instance Stringy T.Text T.Text where+ stringy = id++instance Stringy T.Text String where+ stringy = T.unpack++instance Stringy T.Text TL.Text where+ stringy = TL.fromStrict++instance Stringy T.Text B.ByteString where+ stringy = T.encodeUtf8++instance Stringy T.Text BL.ByteString where+ stringy = BL.fromStrict . T.encodeUtf8++instance Stringy TL.Text TL.Text where+ stringy = id++instance Stringy TL.Text String where+ stringy = TL.unpack++instance Stringy TL.Text T.Text where+ stringy = TL.toStrict++instance Stringy TL.Text B.ByteString where+ stringy = BL.toStrict . TL.encodeUtf8++instance Stringy TL.Text BL.ByteString where+ stringy = TL.encodeUtf8++instance Stringy B.ByteString B.ByteString where+ stringy = id++instance Stringy BL.ByteString BL.ByteString where+ stringy = id
+ test/Driver.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
+ test/Interpolations.hs view
@@ -0,0 +1,34 @@+module Interpolations where++import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty+import Test.Tasty.Hedgehog+import Yasi++test_interpolation :: TestTree+test_interpolation =+ testGroup+ "interpolation"+ [ testProperty "to String" . property $ do+ (a, b, c) <- (,,) <$> forAll genString <*> forAll genText <*> forAll genString+ [i|${a}++$b🙀🙀🙀🙀$c🙀|] === a <> "++" <> T.unpack b <> "🙀🙀🙀🙀" <> c <> "🙀",+ testProperty "to Text" . property $ do+ (a, b, c) <- (,,) <$> forAll genText <*> forAll genText <*> forAll genString+ [i|😶😶$a😶😶$b😶😶$c😶😶|] === "😶😶" <> a <> "😶😶" <> b <> "😶😶" <> T.pack c <> "😶😶",+ testProperty "to ByteString" . property $ do+ (a, b, c) <- (,,) <$> forAll genBS <*> forAll genText <*> forAll genString+ let p = T.encodeUtf8 "℘"+ [i|℘$a℘$b℘$c℘|] === p <> a <> p <> T.encodeUtf8 b <> p <> T.encodeUtf8 (T.pack c) <> p,+ testProperty "abstractions" . property $ do+ (a, b) <- (,) <$> forAll genText <*> forAll genText+ [i|xxx-${}${}-yyy|] a b === "xxx-" <> a <> b <> "-yyy"+ ]+ where+ genString = Gen.string range Gen.unicodeAll+ genText = Gen.text range Gen.unicodeAll+ genBS = Gen.bytes range+ range = Range.constant 0 20
+ test/Segments.hs view
@@ -0,0 +1,25 @@+module Segments where++import Test.Tasty.HUnit+import Yasi.Internal++unit_segment_parsing :: IO ()+unit_segment_parsing = do+ ps "foo\\\"" @?= Just [Lit "foo\\\""]+ ps "$a-$b" @?= Just [Var "a", Lit "-", Var "b"]+ ps "asef$" @?= Nothing+ ps "lol$${}" @?= Just [Lit "lol${}"]+ ps "lol$$${}" @?= Just [Lit "lol$", Abs]+ ps "${89+}${}" @?= Just [Var "89+", Abs]+ ps "${}}" @?= Just [Abs, Lit "}"]+ ps "asdf${show bar}$$" @?= Just [Lit "asdf", ShowVar "bar", Lit "$"]+ ps "a$$b" @?= Just [Lit "a$b"]+ ps "$a$b$c" @?= Just [Var "a", Var "b", Var "c"]+ ps "" @?= Just []+ ps " " @?= Just [Lit " "]+ ps "$foobar:\n - $b" @?= Just [Var "foobar", Lit ":\n - ", Var "b"]+ ps "${foobar]" @?= Nothing+ ps "test-$0foo" @?= Nothing+ ps "${show }" @?= Just [ShowVar ""]+ where+ ps = parseSegments '$'
+ yasi.cabal view
@@ -0,0 +1,62 @@+cabal-version: 2.4+name: yasi+version: 0.0.0.0++synopsis: Yet another string interpolator+description:+ Yet another string interpolator,+ with a different set of tradeoffs+category: String, Text, QuasiQuotes++homepage: https://github.com/amesgen/yasi+bug-reports: https://github.com/amesgen/yasi/issues+license: CC0-1.0+license-file: LICENSE+extra-source-files: README.md+author: amesgen+maintainer: amesgen@amesgen.de+extra-source-files: CHANGELOG.md++source-repository head+ location: https://github.com/amesgen/yasi+ type: git++common commons+ default-language: Haskell2010+ ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -fhide-source-paths+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages+ default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances LambdaCase MultiParamTypeClasses OverloadedStrings QuasiQuotes RecordWildCards TemplateHaskell++library+ import: commons+ ghc-options: -Wmissing-export-lists+ hs-source-dirs: src+ exposed-modules:+ Yasi+ Yasi.Internal+ build-depends:+ base >= 4.11 && < 5+ , template-haskell >= 2.13 && < 2.18+ , text ^>= 1.2+ , bytestring >= 0.10.8.2 && < 0.12++test-suite tasty+ import: commons+ type: exitcode-stdio-1.0+ main-is: Driver.hs+ hs-source-dirs: test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ tasty-discover:tasty-discover ^>= 4.2+ build-depends:+ base+ , yasi+ , text+ , tasty >= 1.3 && <= 1.5+ , tasty-hunit ^>= 0.10+ , tasty-hedgehog ^>= 1.0+ , hedgehog ^>= 1.0+ other-modules:+ Segments+ Interpolations