haddocset 0.2.0 → 0.3.0
raw patch · 3 files changed
+40/−29 lines, 3 files
Files
- Documentation/Haddocset.hs +16/−5
- Main.hs +23/−23
- haddocset.cabal +1/−1
Documentation/Haddocset.hs view
@@ -151,11 +151,19 @@ packageLike p = let t = both $ P.toText p in T.any (== '-') t && (T.all (`elem` "0123456789.") . T.takeWhile (/= '-') $ T.reverse t) +commonPrefix :: P.FilePath -> P.FilePath -> P.FilePath+commonPrefix a0 b0 = P.concat $ loop id (P.splitDirectories a0) (P.splitDirectories b0) where+ loop f [] _ = f []+ loop f _ [] = f []+ loop f (a:as) (b:bs) | a == b = loop (f . (a:)) as bs+ | otherwise = f []+ relativize :: P.FilePath -> P.FilePath -> P.FilePath relativize base path = up P.</> p- where pfx = P.commonPrefix [base, path]- up = P.concat . flip replicate ".." . length . P.splitDirectories . fromMaybe (error "relativize") $ P.stripPrefix pfx base- p = fromMaybe (error "relativize") $ P.stripPrefix pfx path+ where pfx = commonPrefix base path+ up = P.concat . flip replicate ".." . length . P.splitDirectories . fromMaybe err $ P.stripPrefix pfx base+ p = fromMaybe err $ P.stripPrefix pfx path+ err = error $ "relativize: " ++ show base ++ " -> " ++ show path data DocFile = DocFile { docPackage :: PackageId@@ -279,11 +287,14 @@ haddock $ "--gen-index": "--gen-contents": ("--odir=" ++ P.encodeString documentdir): argIs -addSinglePackage :: Bool -> P.FilePath -> P.FilePath -> Sql.Connection -> DocInfo -> IO ()-addSinglePackage quiet docDir haddockDir conn iFile = go `catchIOError` handler+-- dst = docdir+-- P.</> (P.decodeString . display) (docPackage doc)+addSinglePackage :: Bool -> Bool -> P.FilePath -> P.FilePath -> Sql.Connection -> DocInfo -> IO ()+addSinglePackage quiet force docDir haddockDir conn iFile = go `catchIOError` handler where go = do putStr " " >> putStr (display $ diPackageId iFile) >> putChar ' ' >> hFlush stdout+ when force $ P.removeTree $ docDir P.</> (P.decodeString . display) (diPackageId iFile) runResourceT $ docFiles (diPackageId iFile) (diHTMLs iFile) $$ (if quiet then id else (progress False 10 '.' =$)) (copyDocument docDir) Sql.execute_ conn "BEGIN;"
Main.hs view
@@ -43,13 +43,13 @@ unless (optQuiet o) $ putStr " Global package count: " >> print (length globals) unless (optQuiet o) $ putStrLn "[4/5] Copy and populate Documents."- forM_ iFiles $ \iFile -> addSinglePackage (optQuiet o) (optDocumentsDir o) (optHaddockDir o) conn iFile+ forM_ iFiles $ \iFile -> addSinglePackage (optQuiet o) False (optDocumentsDir o) (optHaddockDir o) conn iFile unless (optQuiet o) $ putStrLn "[5/5] Create index." haddockIndex (optHaddockDir o) (optDocumentsDir o) -addCommand :: Options -> IO ()-addCommand o = do+addCommand :: Options -> Bool -> IO ()+addCommand o force = do conn <- Sql.open . P.encodeString $ optTarget o P.</> "Contents/Resources/docSet.dsidx" forM_ (toAddFiles $ optCommand o) $ \i -> go conn i `catchIOError` handler@@ -57,9 +57,9 @@ where go conn p = readDocInfoFile p >>= \mbIFile -> case mbIFile of Nothing -> return ()- Just iFile -> addSinglePackage (optQuiet o) (optDocumentsDir o) (optHaddockDir o) conn iFile+ Just iFile -> addSinglePackage (optQuiet o) force (optDocumentsDir o) (optHaddockDir o) conn iFile handler ioe- | isDoesNotExistError ioe = print ioe+ | isDoesNotExistError ioe = print ioe | otherwise = ioError ioe listCommand :: Options -> IO ()@@ -81,33 +81,33 @@ data Command = Create { createPlist :: Plist, toAddFiles :: [P.FilePath] } | List- | Add { toAddFiles :: [P.FilePath] }+ | Add { toAddFiles :: [P.FilePath], forceAdd :: Bool } deriving Show main :: IO () main = do opts <- execParser optRule case opts of- Options{optCommand = Create{}} -> createCommand opts- Options{optCommand = List} -> listCommand opts- Options{optCommand = Add{}} -> addCommand opts+ Options{optCommand = Create{}} -> createCommand opts+ Options{optCommand = List} -> listCommand opts+ Options{optCommand = Add{forceAdd}} -> addCommand opts forceAdd where optRule = info (helper <*> options) fullDesc options = Options- <$> (strOption (long "hc-pkg" <> metavar "CMD" <> help "hc-pkg command (default: ghc-pkg)") <|> pure "ghc-pkg")- <*> fmap (docsetDir . P.decodeString)- (strOption (long "target" <> short 't' <> metavar "DOCSET" <> help "output directory (default: haskell.docset)") <|> pure "haskell")- <*> switch (long "quiet" <> short 'q' <> help "suppress output.")- <*> subparser (command "create" (info createOpts $ progDesc "crate new docset.")- <> command "list" (info (pure List) $ progDesc "list package of docset.")- <> command "add" (info addOpts $ progDesc "add package to docset."))+ <$> (strOption (long "hc-pkg" <> metavar "CMD" <> help "hc-pkg command (default: ghc-pkg)") <|> pure "ghc-pkg")+ <*> fmap (docsetDir . P.decodeString)+ (strOption (long "target" <> short 't' <> metavar "DOCSET" <> help "output directory (default: haskell.docset)") <|> pure "haskell")+ <*> switch (long "quiet" <> short 'q' <> help "suppress output.")+ <*> subparser (command "create" (info createOpts $ progDesc "crate new docset.")+ <> command "list" (info (pure List) $ progDesc "list package of docset.")+ <> command "add" (info addOpts $ progDesc "add package to docset.")) createOpts = Create- <$> ( Plist- <$> (strOption (long "CFBundleIdentifier") <|> pure "haskell")- <*> (strOption (long "CFBundleName") <|> pure "Haskell")- <*> (strOption (long "DocSetPlatformFamily") <|> pure "haskell"))- <*> many (argument (P.decodeString <$> str) (metavar "CONFS" <> help "path to installed package configuration."))-- addOpts = Add <$> some (argument (P.decodeString <$> str) (metavar "CONFS" <> help "path to installed package configuration."))+ <$> ( Plist <$> (strOption (long "CFBundleIdentifier") <|> pure "haskell")+ <*> (strOption (long "CFBundleName") <|> pure "Haskell")+ <*> (strOption (long "DocSetPlatformFamily") <|> pure "haskell"))+ <*> many (argument (P.decodeString <$> str) (metavar "CONFS" <> help "path to installed package configuration.")) + addOpts = Add+ <$> some (argument (P.decodeString <$> str) (metavar "CONFS" <> help "path to installed package configuration."))+ <*> switch (long "force" <> short 'f' <> help "overwrite exist package.")
haddocset.cabal view
@@ -1,5 +1,5 @@ name: haddocset-version: 0.2.0+version: 0.3.0 synopsis: Generate docset of Dash by Haddock haskell documentation tool description: please read README.md <https://github.com/philopon/haddocset/blob/master/README.md> license: BSD3