diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for nowdoc + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2018 + +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 Author name here 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# nowdoc diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/nowdoc.cabal b/nowdoc.cabal new file mode 100644 --- /dev/null +++ b/nowdoc.cabal @@ -0,0 +1,58 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 087ee2b1e9300c01bedb2232553e220d78e6f4c5308d0221029287e0cc914fe1 + +name: nowdoc +version: 0.1.0.0 +synopsis: Here document without variable expansion like PHP Nowdoc +description: Please see the README on GitHub at +category: Text +homepage: https://github.com/YoshikuniJujo/nowdoc#readme +bug-reports: https://github.com/YoshikuniJujo/nowdoc/issues +author: Yoshikuni Jujo +maintainer: PAF01143@nifty.ne.jp +copyright: 2018 Yoshikuni Jujo +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + samples/sample0.hs + samples/sample1.hs + samples/sample2.hs + samples/sample3.hs + samples/sample4.hs + +source-repository head + type: git + location: https://github.com/YoshikuniJujo/nowdoc + +library + exposed-modules: + Text.Nowdoc + other-modules: + Paths_nowdoc + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , template-haskell + default-language: Haskell2010 + +test-suite nowdoc-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_nowdoc + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , nowdoc + , template-haskell + default-language: Haskell2010 diff --git a/samples/sample0.hs b/samples/sample0.hs new file mode 100644 --- /dev/null +++ b/samples/sample0.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE QuasiQuotes #-} + +import Text.Nowdoc + +main :: IO () +main = putStr [nowdoc| +Now, fair Hippolyta, our nuptial hour +Draws on apace; four happy days brings in +Another moon: but, O, methinks, how slow +This old moon wanes! she lingers my desires, +Like to a step-dame or a dowager +Long withering out a young man revenue. +|] diff --git a/samples/sample1.hs b/samples/sample1.hs new file mode 100644 --- /dev/null +++ b/samples/sample1.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE QuasiQuotes #-} + +import Text.Nowdoc + +main :: IO () +main = putStr [nowdoc| +hello | ] +world | ] +|] diff --git a/samples/sample2.hs b/samples/sample2.hs new file mode 100644 --- /dev/null +++ b/samples/sample2.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE QuasiQuotes #-} + +import Text.Nowdoc + +main :: IO () +main = putStr [nowdoc| +#include + +int +main(int argc, char *argv[]) +{ + printf("Hello, world!\n"); + return 0; +} +|] diff --git a/samples/sample3.hs b/samples/sample3.hs new file mode 100644 --- /dev/null +++ b/samples/sample3.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE QuasiQuotes #-} + +import Text.Nowdoc + +main :: IO () +main = putStr message + +message :: String +message = [nowdoc| +Two households, both alike in dignity, +In fair Verona, where we lay our scene, +From ancient grudge break to new mutiny, +Where civil blood makes civil hands unclean. +From forth the fatal loins of these two foes +A pair of star-cross'd lovers take their life; +Whose misadventured piteous overthrows +Do with their death bury their parents' strife. +The fearful passage of their death-mark'd love, +And the continuance of their parents' rage, +Which, but their children's end, nought could remove, +Is now the two hours' traffic of our stage; +The which if you with patient ears attend, +What here shall miss, our toil shall strive to mend. +|] diff --git a/samples/sample4.hs b/samples/sample4.hs new file mode 100644 --- /dev/null +++ b/samples/sample4.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE QuasiQuotes #-} + +import Text.Nowdoc + +main :: IO () +main = putStr src + +src :: String +src = [nowdoc| +$hello = "hello" +$world = "world" + +puts $hello, $world +|] diff --git a/src/Text/Nowdoc.hs b/src/Text/Nowdoc.hs new file mode 100644 --- /dev/null +++ b/src/Text/Nowdoc.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -Wall -fno-warn-tabs #-} + +module Text.Nowdoc (nowdoc) where + +import Language.Haskell.TH (litE, stringL) +import Language.Haskell.TH.Quote (QuasiQuoter(..)) + +nowdoc :: QuasiQuoter +nowdoc = QuasiQuoter { + quoteExp = litE . stringL . unescape . dropHeadNewline, + quotePat = const . error $ errorString "a pattern", + quoteType = const . error $ errorString "a type", + quoteDec = const . error $ errorString "a declaration" + } + +errorString :: String -> String +errorString ctx = + "You have used the `nowdoc' QuasiQoter in " ++ ctx ++ + " context; you must only use it in an expression context" + +dropHeadNewline :: String -> String +dropHeadNewline ('\n' : cs) = cs +dropHeadNewline cs = cs + +unescape :: String -> String +unescape ('|' : cs) = case span (== ' ') cs of + (_ : ss, ']' : cs') -> '|' : ss ++ "]" ++ unescape cs' + (ss, cs') -> '|' : ss ++ unescape cs' +unescape (c : cs) = c : unescape cs +unescape "" = "" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"