record-dot-preprocessor 0.1 → 0.1.1

raw patch · 4 files changed

+23/−8 lines, 4 files

Files

• CHANGES.txt +3/−0
• record-dot-preprocessor.cabal +1/−1
• src/Edit.hs +16/−6
• src/Unlexer.hs +3/−1

@@ -1,4 +1,7 @@ Changelog for record-dot-preprocessor +0.1.1, released 2018-05-09+    Handle - as an update operator+    Be compatible with qualified imports 0.1, released 2018-05-06     Initial version

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               record-dot-preprocessor-version:            0.1+version:            0.1.1 license:            BSD3 license-file:       LICENSE category:           Development

@@ -45,14 +45,19 @@  -- Add the necessary extensions, imports and local definitions editAddPreamble :: [Paren Lexeme] -> [Paren Lexeme]-editAddPreamble xs-    | (premodu, modu:xs) <- break (is "module") xs+editAddPreamble o@xs+    | (premodu, modu:modname@xs) <- break (is "module") xs     , (prewhr, whr:xs) <- break (is "where") xs-    = gen prefix : nl : premodu ++ modu : prewhr ++ whr : nl : gen imports : nl : xs-    | otherwise = gen prefix : nl : gen imports : nl : xs+    = if isControlLens modname then o else gen prefix : nl : premodu ++ modu : prewhr ++ whr : nl : gen imports : nl : xs ++ [nl, gen trailing, nl]+    | otherwise = gen prefix : nl : gen imports : nl : xs ++ [nl, gen trailing, nl]     where+        -- don't want to create a circular reference if they fake Control.Lens with microlens+        isControlLens (a:b:c:_) = is "Control" a && is "." b && is "Lens" c+        isControlLens _ = False+         prefix = "{-# LANGUAGE DuplicateRecordFields, DataKinds, FlexibleInstances, MultiParamTypeClasses, GADTs, OverloadedLabels #-}"         imports = "import qualified GHC.OverloadedLabels as Z; import qualified Control.Lens as Z"+        trailing = "_preprocessor_unused :: (label ~ \"_unused\", Z.IsLabel label a) => a -> (); _preprocessor_unused x = x `seq` (undefined Z.^. undefined) `seq` ()"   continue op (Paren a b c:xs) = Paren a (op b) c : op xs@@ -66,6 +71,7 @@     | noWhitespace x, noWhitespace dot     , is "." dot     , isField field+    , not $ isCtor x     = editSelectors $ paren (editSelectors [x] ++ [spc, gen "Z.^.", spc, hashField field]) : rest editSelectors xs = continue editSelectors xs @@ -79,9 +85,13 @@     e : spc : gen "Z.&" : spc :     concat [[x, spc, gen "Z.%~", spc] | x <- fields] ++     [paren (intercalate [spc, gen ".", spc] $ map (pure . paren)-        [ concat [ [x, spc, gen "Z.%~", spc] | x <- fields] ++ [paren [fromMaybe (gen "const") op, body]]+        [ concat [ [x, spc, gen "Z.%~", spc] | x <- fields] ++ [paren [operator op, body]]         | (fields, op, body) <- reverse upd]     )]+    where+        operator Nothing = gen "const"+        operator (Just x) | is "-" x = gen "subtract"+        operator (Just x) = x   -- e.a{b.c=d, ...} ==> e . #a & #b . #c .~ d & ...@@ -143,5 +153,5 @@         ctor _ = []          fields ((x,[]):(y,z):rest) = fields $ (x++y,z):rest-        fields ((names, _:typ):rest) = [(name, unwords $ unparen typ) | Item name <- names] ++ fields rest+        fields ((names, _:typ):rest) = [(name, trim $ dropWhile (== '!') $ unwords $ unparen typ) | Item name <- names] ++ fields rest         fields _ = []

@@ -6,4 +6,6 @@ import Lexer  unlexer :: FilePath -> [Lexeme] -> String-unlexer _ xs = concat [lexeme ++ whitespace | Lexeme{..} <- xs]+unlexer src xs =+    "{-# LINE 1 " ++ show src ++ " #-}\n" +++    concat [lexeme ++ whitespace | Lexeme{..} <- xs]