diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/src/Main.hs b/src/Main.hs index 6d116a0..2e80a6a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,6 +7,7 @@ import System.IO import Data.Maybe (fromMaybe, isJust, fromJust) import Data.List (isPrefixOf, isSuffixOf, scanl, scanr, zipWith3, intersperse, sort, inits, tails) import Control.Monad (when, unless) +import Data.Foldable (foldrM) import System.Exit (die) import qualified Data.Text as T @@ -104,14 +105,20 @@ instance Show Nav where convert :: FilePath -> FilePath -> IO Nav convert r f = do unless (valid r f) $ - error $ "Don't know what to do with: " ++ f + die $ "Don't know what to do with: " ++ f de <- doesDirectoryExist f fe <- (isFragment f &&) <$> doesFileExist f case de of True -> do allChildren <- (map (f </>)) <$> listDirectory f - let downlinks = sort $ filter (\x -> valid r x && not (isSuffixOf "index.html" x)) $ allChildren - navChildren <- mapM (convert r) downlinks + let downlinks = sort $ allChildren + let filterInterested c acc = do + isDir <- doesDirectoryExist c + case isDir || ((isFragment c) && (not $ isSuffixOf "index.html" c)) of + True -> pure $ c:acc + False -> pure acc + filtered <- foldrM filterInterested [] downlinks + navChildren <- mapM (convert r) filtered navIndexFrag <- do let ifp = f </> "index.html" fe <- doesFileExist ifp @@ -134,7 +141,7 @@ convert r f = do , navFilePath = navFilePath } False -> - error $ "Path doesn't exist or is not a directory or file: " ++ f + die $ "Path doesn't exist or is not a directory or file: " ++ f fallbackIndexNav :: FilePath -> [Nav] -> Nav fallbackIndexNav p ns = NavFile (fallbackIndexFrag p ns) (T.pack . takeFileName $ takeDirectory p) p @@ -171,8 +178,8 @@ emit outdir nav1 (NavDir cs i dp) nav2 = do exists <- doesDirectoryExist newdir unless exists $ createDirectory newdir - let sharedBefore = T.append nav1 $ T.pack "<li><ul>" - let sharedAfter = T.append (T.pack "</li></ul>") nav2 + let sharedBefore = T.append nav1 $ T.pack "<ul>" + let sharedAfter = T.append (T.pack "</ul>") nav2 let ncs = map mkNavItem cs let priors = inits ncs let posts = tails ncs @@ -192,7 +199,7 @@ main = do hPutStr stderr $ "Using config: " ++ show flags tree <- convert r r hPutStr stderr $ "\nFound tree:\n" ++ show tree - let rNav = T.append (mkNavItem tree) (T.pack "<ul>") + let rNav = T.append (T.pack "<ul>") (mkNavItem tree) emit o rNav tree (T.pack "</ul>") when (isJust s) $ case isAbsolute $ fromJust s of |