moduleDerive.Main(deriveMain )whereimportLanguage.Haskell importData.Derive.All (Derivation )importDerive.Derivation importDerive.Generate importDerive.Test importDerive.Flags importData.ListimportSystem.DirectoryderiveMain::[Derivation ]->IO()deriveMain derivations =do(flags ,files )<-getFlags ifTest `elem`flags thentest elseifGenerate `elem`flags thengenerate elseifPreprocessor `elem`flags then(iflengthfiles /=3thenerror$"Expected to be invoked as a GHC preprocessor with 3 files, but got "++show(lengthfiles )elsedocopyFile(files !!1)(files !!2)mainFile derivations (Append :flags )(files !!2))elseifnullfiles thenputStr$"No files specified\n"++flagInfo elsemapM_(mainFile derivations flags )files mainFile::[Derivation ]->[Flag ]->FilePath->IO()mainFile derivations flags file =dosrc <-readFilefile src <-return$unlines$filter(not.isPrefixOf"#")$linessrc letparse =fromParseResult.parseFileContentsWithModedefaultParseMode{parseFilename=file ,extensions=defaultExtensions }real =parse src mine =parse $uncomment src ::ModuleSrcSpanInfoflags <-return$foldladdFlags flags [(getPointLocsl ,wordsx )|OptionsPragmasl (Just(UnknownTool"DERIVE"))x <-modulePragmas mine ]letblur =fmap(const())letres =performDerive derivations (blur mine ::Module())$wantDerive flags (blur real )(blur mine )writeDerive file (moduleName $blur mine )flags res uncomment::String->Stringuncomment ('{':'-':'!':xs )=' ':' ':' ':uncomment xs uncomment('!':'-':'}':xs )=' ':' ':' ':uncomment xs uncomment(x :xs )=x :uncomment xs uncomment[]=[]-- Taken from HLint, update occasionallydefaultExtensions::[Extension]defaultExtensions =[e |e @EnableExtension{}<-knownExtensions]\\mapEnableExtensionbadExtensions badExtensions =[Arrows-- steals proc,TransformListComp-- steals the group keyword,XmlSyntax,RegularPatterns-- steals a-b,UnboxedTuples-- breaks (#) lens operator,QuasiQuotes-- breaks [x| ...], making whitespace free list comps break,DoRec,RecursiveDo-- breaks rec,TypeApplications-- HSE fails on @ patterns]

AltStyle によって変換されたページ (->オリジナル) /