HListPP (empty) → 0.1

raw patch · 4 files changed

+143/−0 lines, 4 filesdep +applicative-quotersdep +basedep +regex-applicativesetup-changed

Dependencies added: applicative-quoters, base, regex-applicative

Files

• HListPP.cabal +55/−0
• HListPP.hs +56/−0
• LICENSE +30/−0
• Setup.hs +2/−0

@@ -0,0 +1,55 @@+name:                HListPP+version:             0.1+synopsis:            A preprocessor for HList labelable labels+description:         A preprocessor that replaces @`longDescriptiveName@ with+                    .+                     > hLens' (Label :: Label "longDescriptiveName")+                    .+                     Use with ghc flags @-F -pgmF HListPP@, which can+                     be added per-file with a pragma:+                    .+                     > ❴-# OPTIONS_GHC -F -pgmF HListPP #-❵ -- change braces to ascii (haddock doesn't allow literal comments in files)+                    .+                     Note that @`labels@ is expanded to something that+                     takes up about 26 more columns. To avoid issues with+                     layout, put a newline after keywords that introduce+                     layout, at least if there are @`labels@ in the same row.+                     In other words:+                    .+                     > `character.`position.`x %= \ x -> let+                     >      msg = "a really long message about x>0"+                     >      pos = x - 5+                     >    in if pos < 0+                     >          then error msg+                     >          else pos+                    .+                     Instead of+                    .+                     > `character.`position.`x %= \ x -> let msg = "a really long message about x>0"+                     >                                       pos = x - 5+                     >                            in if pos < 0+                     >                                then error msg+                     >                                else pos+                    .+                     A blank library is included in this package to make+                     it possible to depend on HListPP++homepage:            http://code.haskell.org/~aavogt/HListPP+license:             BSD3+license-file:        LICENSE+author:              Adam Vogt <vogt.adam@gmail.com>+maintainer:          Adam Vogt <vogt.adam@gmail.com>+category:            Development+build-type:          Simple+cabal-version:       >=1.10++library+  default-language: Haskell2010++executable HListPP+  main-is:             HListPP.hs+  other-extensions:    QuasiQuotes, ViewPatterns+  build-depends:       base >=4.6 && <4.8,+                       applicative-quoters >=0.1 && <0.2,+                       regex-applicative >=0.3 && <0.4+  default-language:    Haskell2010

@@ -0,0 +1,56 @@+{-# LANGUAGE QuasiQuotes, ViewPatterns #-}+module Main where++import Control.Applicative.QQ.ADo+import Data.Char+import Data.List+import Data.Monoid+import System.Environment+import Text.Regex.Applicative++-- "ModuleName."+modNameDot = [ado|+    m <- psym isUpper+    odName <- many (psym isAlpha)+    dot <- sym '.'+    m:odName ++ [dot] |]++-- "M.Od.Ule.Name.something"+qualIdent = [ado|+    modNames <- many modNameDot+    end <- some (psym isAlpha)+    concat (modNames ++ [end]) |]++takeQual x = case findLongestPrefix qualIdent x of+    Just (a , '`' : rest) -> ('`' : a ++ "`", rest) -- `infix`+    Just (a, rest) -> (addLabel a,rest)             -- `ident+    Nothing -> ("``", x) -- unlikely++addLabel xu = "(hLens' (Label :: Label \""++xu++"\"))"++main = operate =<< getArgs++{-# INLINE operate #-}+operate [originalFileName, inputFile, outputFile] = do+    input <- readFile inputFile+    let linePragma = "{-# LINE 1 \"" <> originalFileName <> "\" #-}\n"+    writeFile outputFile (linePragma <> s input)+operate _ = error "usage: HListPP originalFileName inputFile outputFile\+  \ also: \+  \ {-# OPTIONS_GHC -F -pgmF HListPP #-}"++-- | applies takeQual outside of characters, strings+{-# INLINE s #-}+s (stripPrefix "'\"'" -> Just xs) = "'\"'" ++ s xs+s (stripPrefix "'`'"  -> Just xs) = "'`'"  ++ s xs+s ('"': xs) = '"' : t xs+s ('`':  (takeQual -> (a,xs))) = a ++ s xs+s (x:xs) = x : s xs+s [] = []++-- | inside string+{-# INLINE t #-}+t (stripPrefix "\\\"" -> Just xs) = "\\\"" ++ t xs+t ('"' : xs) = '"' : s xs+t (x:xs) = x : t xs+

@@ -0,0 +1,30 @@+Copyright (c) 2014, Adam Vogt <vogt.adam@gmail.com>++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 Adam Vogt <vogt.adam@gmail.com> 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain