HListPP 0.1 → 0.2

raw patch · 3 files changed

+37/−5 lines, 3 files

Files

• ChangeLog +7/−0
• HListPP.cabal +2/−1
• HListPP.hs +28/−4

@@ -0,0 +1,7 @@+May 28 2014+Release 0.2+Report filename given an error.+Avoid parsing within comments.++May 20 2014+Initial release 0.1

@@ -1,5 +1,5 @@ name:                HListPP-version:             0.1+version:             0.2 synopsis:            A preprocessor for HList labelable labels description:         A preprocessor that replaces @`longDescriptiveName@ with                     .@@ -42,6 +42,7 @@ category:            Development build-type:          Simple cabal-version:       >=1.10+extra-source-files:  ChangeLog  library   default-language: Haskell2010

@@ -7,6 +7,9 @@ import Data.Monoid import System.Environment import Text.Regex.Applicative+import Control.Exception+import System.Exit+import System.IO  -- "ModuleName." modNameDot = [ado|@@ -28,21 +31,32 @@  addLabel xu = "(hLens' (Label :: Label \""++xu++"\"))" -main = operate =<< getArgs+main = do+  args <- getArgs+  operate args+    `catch` \ (SomeException e) -> do+          hPutStrLn stderr (show e)+          hPutStrLn stderr ("in: HListPP " ++ unwords args)+          exitFailure  {-# 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\+operate args = error $ "usage: HListPP originalFileName inputFile outputFile\   \ also: \-  \ {-# OPTIONS_GHC -F -pgmF HListPP #-}"+  \ {-# OPTIONS_GHC -F -pgmF HListPP #-}\+  \ called with arguments: " ++ show args --- | applies takeQual outside of characters, strings+-- | applies takeQual outside of characters, strings, comments {-# INLINE s #-} s (stripPrefix "'\"'" -> Just xs) = "'\"'" ++ s xs s (stripPrefix "'`'"  -> Just xs) = "'`'"  ++ s xs+s (stripPrefix "{-" -> Just xs) = "{-" ++ cl xs+s (stripPrefix "--" -> Just xs)+        | x1 : _ <- xs, isSymbol x1 = "--" ++ s xs+        | otherwise = "-- " ++ cs xs s ('"': xs) = '"' : t xs s ('`':  (takeQual -> (a,xs))) = a ++ s xs s (x:xs) = x : s xs@@ -53,4 +67,14 @@ t (stripPrefix "\\\"" -> Just xs) = "\\\"" ++ t xs t ('"' : xs) = '"' : s xs t (x:xs) = x : t xs+t [] = error "expected \"" +-- | inside multiline comment+cl (stripPrefix "-}" -> Just xs) = "-}" ++ s xs+cl (x:xs) = x:cl xs+cl [] = error "expected -}"++-- | inside single line comment+cs ('\n':xs) = '\n' : s xs+cs (x:xs) = x : cs xs+cs "" = ""