diff --git a/Text/LaTeX/Packages/Acronym.hs b/Text/LaTeX/Packages/Acronym.hs index f6b1026..71a93b6 100644 --- a/Text/LaTeX/Packages/Acronym.hs +++ b/Text/LaTeX/Packages/Acronym.hs @@ -11,7 +11,7 @@ module Text.LaTeX.Packages.Acronym , footnote, nohyperlinks, printonlyused, withpage, smaller, dua, nolist -- * Types , Acronym(..) - -- functions + -- * functions , ac, acf, acs, acl, acp, acfp, acsp, aclp, acfi, acsu, aclu, iac, iac2 , ac', acf', acs', acl', acp', acfp', acsp', aclp', acfi', acsu', aclu', iac', iac2' , acresetall, acused diff --git a/new-package b/new-package new file mode 100755 index 0000000..d9c37db --- /dev/null +++ b/new-package @@ -0,0 +1,125 @@ +#!/usr/bin/env stack +-- stack --resolver lts-15.11 script --package template-haskell --package filepath + +import Data.Bool(bool) +import Data.Char(toLower, toUpper) +import Data.List(intercalate, sort) + +import Language.Haskell.TH.Ppr(pprint) +import Language.Haskell.TH.Syntax(Body(NormalB), Clause(Clause), Dec(FunD, SigD), Exp(LitE), Lit(StringL), Name, Type(AppT, ConT, ForallT, VarT), mkName, nameBase) + +import System.Console.GetOpt(OptDescr(Option), ArgDescr(NoArg, ReqArg), ArgOrder(Permute), getOpt, usageInfo) +import System.Environment(getArgs) +import System.FilePath.Posix(()) +import System.IO(Handle, IOMode(WriteMode), hFlush, hPutStrLn, openFile, stdout) + +type StringName = (String, Name) + +firstLower :: String -> String +firstLower "" = "" +firstLower (x:xs) = toLower x : xs + +firstUpper :: String -> String +firstUpper "" = "" +firstUpper (x:xs) = toUpper x : xs + +toPackageName :: String -> (String, Name) +toPackageName = (,) <*> (mkName . ('p':) . firstUpper) + +toPackageOptionName :: String -> (String, Name) +toPackageOptionName = (,) <*> (mkName . firstLower) + +docSection :: Handle -> String -> IO () +docSection h = hPutStrLn h . (" -- * " <>) + +importSection :: Handle -> String -> IO () +importSection handle = hPutStrLn handle . ("import " <>) + +tPackageName :: Type +tPackageName = ConT (mkName "PackageName") + +tPackageOption :: Type +tPackageOption = ForallT [] [AppT (ConT (mkName "LaTeXC")) (VarT l)] (VarT l) + where l = mkName "l" + +_stringLiteral :: String -> Clause +_stringLiteral pn = Clause [] (NormalB (LitE (StringL pn))) [] + +stringDec' :: Type -> StringName -> [Dec] +stringDec' typ (s, n) = [ + SigD n typ + , FunD n [_stringLiteral s] + ] + +stringDec :: (StringName -> [String]) -> Type -> StringName -> String +stringDec doc typ sn = haddock (doc sn) <> pprint (stringDec' typ sn) + +_packageDoc :: StringName -> [String] +_packageDoc (s,n) = ["The @" <> s <> "@ package.", "", "> usepackage [] " <> nameBase n] + +_package :: StringName -> String +_package = stringDec _packageDoc tPackageName + +_optionDoc :: StringName -> [String] +_optionDoc (s,_) = ["The @" <> s <> "@ option."] + +_packageOption :: StringName -> String +_packageOption = ('\n' :) . stringDec _optionDoc tPackageOption + +exportFuncs :: Handle -> [StringName] -> IO () +exportFuncs handle = hPutStrLn handle . (" " <>) . concatMap ((", " <>) . nameBase . snd) + +data LaTeXPackage = LaTeXPackage { packageName :: String, packageOptions :: [String], pragmas :: [String], imports :: [String], write :: Bool } + +initialImports :: [String] +initialImports = [ + "Text.LaTeX.Base.Class(LaTeXC, comm0, comm1, comm2, liftL, liftL2)" + , "Text.LaTeX.Base.Syntax(LaTeX(TeXComm, TeXEnv), TeXArg(FixArg, OptArg))" + , "Text.LaTeX.Base.Types(PackageName)" + ] + +initialPackage :: String -> [String] -> LaTeXPackage +initialPackage p ps = LaTeXPackage p ps ["OverloadedStrings"] initialImports False + +header :: String +header = "Usage: stack new-package PACKAGENAME PACKAGEOPTIONS... [OPTION...]" + +options :: [OptDescr (LaTeXPackage -> LaTeXPackage)] +options = [ + Option ['r'] ["pragma"] (ReqArg (\p l@LaTeXPackage {pragmas=ps} -> l{pragmas=p:ps}) "pragma-name") "pragmas used in the module" + , Option ['i'] ["import"] (ReqArg (\i l@LaTeXPackage {imports=is} -> l{imports=i:is}) "import-statement") "import statements used" + , Option ['w'] ["write"] (NoArg (\l -> l{write=True})) "write to a file" + ] + +haddock :: [String] -> String +haddock [] = [] +haddock (l:ls) = unlines (("-- | " ++ l) : map ("-- " ++) ls) + +printUsageInfo :: IO () +printUsageInfo = putStrLn (usageInfo header options) + +main = do + argv <- getArgs + l@LaTeXPackage{packageName=n,packageOptions=os, pragmas=ps, imports=is, write=w} <- case getOpt Permute options argv of + (o, p:pos, []) -> pure (foldr ($) (initialPackage p pos) o) + (o, [], []) -> printUsageInfo >> putStrLn (usageInfo header options) >> ioError (userError "No packagename specified.)") + (_, _, errs) -> printUsageInfo >> ioError (userError (concat errs)) + let fileName = firstUpper n + let mName = "Text.LaTeX.Packages." <> fileName + let pns@(_, pn) = toPackageName n + let snos = map toPackageOptionName os + handle <- bool (pure stdout) (openFile ("Text" "LaTeX" "Packages" (fileName <> ".hs")) WriteMode) w + hPutStrLn handle ("{-# LANGUAGE " <> intercalate ", " (sort ps) <> " #-}\n\nmodule " <> mName <> " (") + docSection handle (n <> " package") + hPutStrLn handle (" " <> nameBase pn) + docSection handle "Package options" + exportFuncs handle snos + mapM_ (docSection handle) ["Types", "Functions"] + hPutStrLn handle " ) where\n" + mapM_ (importSection handle) is + hPutStrLn handle "" + hPutStrLn handle (_package pns) + mapM_ (hPutStrLn handle . _packageOption) snos + hFlush handle + +-- vim:ft=haskell