diff --git a/hyakko.cabal b/hyakko.cabal --- a/hyakko.cabal +++ b/hyakko.cabal @@ -1,5 +1,5 @@ name: hyakko -version: 0.6.5 +version: 0.6.6 cabal-version: >= 1.6 build-type: Simple license: MIT @@ -63,18 +63,18 @@ Executable hyakko build-depends: base >= 4 && < 5, - ghc >= 7, - filepath >= 1.2, - regex-pcre >= 0.9, - unordered-containers >= 0.2, - directory >= 1, - pandoc >= 1.10, - bytestring >= 0.9, - text >= 0.11, - highlighting-kate >= 0.5, - blaze-html >= 0.5, - cmdargs >= 0.10, - aeson >= 0.6 + filepath >= 1.2 && < 1.4, + regex-pcre-builtin >= 0.9 && < 1.0, + unordered-containers >= 0.2 && < 0.3, + directory >= 1.0 && < 2.0, + pandoc == 1.13.*, + bytestring >= 0.9 && < 1.0, + text >= 0.11 && < 2.0, + highlighting-kate == 0.5.*, + blaze-html >= 0.5 && < 1.0, + cmdargs == 0.10.*, + aeson >= 0.7 && < 0.8, + mtl >= 2.1 && < 2.2 hs-source-dirs: src ghc-options: -O2 -Wall main-is: Hyakko.lhs diff --git a/src/Hyakko.lhs b/src/Hyakko.lhs --- a/src/Hyakko.lhs +++ b/src/Hyakko.lhs @@ -38,7 +38,7 @@ > import Hyakko.Text.Templates > import Hyakko.Types -> import Data.Aeson (decode') +> import Data.Aeson (decode', Value(..)) > import qualified Data.HashMap.Strict as M > import Data.ByteString.Lazy.Char8 (ByteString) > import qualified Data.ByteString.Lazy.Char8 as L @@ -47,9 +47,11 @@ > import qualified Data.Text.IO as T > import Data.List (sort) > import Data.Maybe (fromJust, isNothing) +> import Data.Monoid > import Data.Version (showVersion) > import Control.Applicative ((<$>)) -> import Control.Monad (filterM, (>=>), forM, forM_, unless) +> import Control.Monad (filterM, (>=>), forM, forM_, unless, when) +> import Control.Monad.State.Strict > import qualified Text.Blaze.Html as B > import Text.Blaze.Html.Renderer.Utf8 (renderHtml) > import qualified Text.Highlighting.Kate as K @@ -95,22 +97,23 @@ > forM_ xs $ \x -> do > code <- T.readFile x > let sections = parse (getLanguage x) code -> if null sections then +> noSects = null sections +> when noSects $ > putStrLn $ "hyakko doesn't support the language extension " > ++ takeExtension x -> else do -> let highlighted = highlight x sections -> y = mapSections sections highlighted -> generateHTML opts' x y +> unless noSects $ do +> let highlighted = highlight x sections +> y = mapSections sections highlighted +> generateHTML opts' x y Given a string of source code, parse out eacg block of prose and the code that follows it — by detecting which is which, line by line — then create an individual **section** for it. Each section is Map with `docText` and `codeText` properties, and eventuall `docsHtml` and `codeHtml` as well. -> inSections :: [Text] -> ByteString -> Sections +> inSections :: [Text] -> Text -> Sections > inSections xs r = -> let sections = sectionOff "" "" xs +> let sections = sectionOff mempty mempty xs > in map M.fromList sections > where save :: Text -> Text -> [(String, Text)] @@ -123,23 +126,24 @@ > sectionOff code docs (y:ys) = > let line = T.unpack y > shebang = L.pack "(^#![/]|^\\s*#\\{)" -> in if line =~ r && (not $ line =~ shebang) then +> r' = L.pack $ T.unpack r +> in if line =~ r' && (not $ line =~ shebang) then > handleDocs code > else -> sectionOff (code ++. y ++. "\n") docs ys +> sectionOff (code <> y <> "\n") docs ys > where handleDocs "" = handleHeaders code (newdocs docs) ys > handleDocs _ = save code docs -> : handleHeaders "" (newdocs "") ys +> : handleHeaders mempty (newdocs mempty) ys -> newdocs d = d ++. (replace r y "") ++. "\n" +> newdocs d = d <> (replace r y mempty) <> "\n" If there is a header markup, only for `---` and `===`, it will get its own line from the other documentation. > handleHeaders c d zs = > if T.unpack d =~ L.pack "^(---|===)+" then -> save c d : sectionOff "" "" zs +> save c d : sectionOff mempty mempty zs > else > sectionOff c d zs @@ -150,37 +154,38 @@ > parse :: Maybe Language -> Text -> Sections > parse Nothing _ = [] > parse (Just src) code = -> inSections (fromLiterate (T.lines code) (literate src) True) -> ("^\\s*" ++* symbol src ++* "\\s?") +> inSections (fromLiterate (T.lines code) $ literate src) +> ("^\\s*" <> symbol src <> "\\s?") Transforms a literate style language file into its normal, non-literate style language. If it is normal, `fromLiterate` for returns the same list of `Text` that was passed in. -> where fromLiterate :: [Text] -> Maybe Bool -> Bool -> [Text] -> fromLiterate [] _ _ = [] -> fromLiterate xs Nothing _ = xs -> fromLiterate (x:xs) lit isText = -> let s = symbol src -> r = "^" ++* (fromJust $ litSymbol src) ++* "\\s?" -> r1 = L.pack "^\\s*$" -> (x', y) = if T.unpack x =~ r then -> (replace r x "", False) -> else -> insert (T.unpack x =~ r1) isText -> ((T.pack $ L.unpack s) ++. " " ++. x) -> in x': fromLiterate xs lit y +> where fromLiterate :: [Text] -> Maybe Bool -> [Text] +> fromLiterate [] _ = [] +> fromLiterate xs Nothing = xs +> fromLiterate xs _ = +> let s = symbol src +> r = "^" <> (fromJust $ litSymbol src) <> "\\s?" +> r1 = L.pack "^\\s*$" +> fn = forM xs $ \x -> do +> (ys, isText) <- get +> let hasLitSymbol = T.unpack x =~ (L.pack $ T.unpack r) +> when hasLitSymbol $ +> put (ys ++ [replace r x mempty], False) + Inserts a comment symbol and a single space into the documentation line and check if the last line was code and documentation. If the previous line was code and the line is blank or has just whitespace, it returns a blank `Text` datatype; otherwise it will return just the comment symbol. -> where insert :: Bool -> Bool -> Text -> (Text, Bool) -> insert True True _ = (T.pack . L.unpack -> $ symbol src, True) -> insert True False _ = ("", False) -> insert False _ y = (y, True) +> unless hasLitSymbol $ +> case (T.unpack x =~ r1, isText) of +> (True, True) -> put (ys ++ [s], True) +> (True, False) -> put (ys ++ [mempty], False) +> (False, _) -> put (ys ++ [s <> " " <> x], True) +> in fst . snd $ runState fn (mempty, True) Highlights the current file of code, using **Kate**, and outputs the the highlighted html to its caller. @@ -188,8 +193,8 @@ > highlight :: FilePath -> Sections -> [Text] > highlight src section = > let language = fromJust $ getLanguage src -> langName = L.unpack $ name_ language -> input = map (\x -> T.unpack $ x M.! "codeText") section +> langName = T.unpack $ name_ language +> input = map (T.unpack . (M.! "codeText")) section > html = B.toHtml . K.formatHtmlBlock K.defaultFormatOpts > . K.highlightAs langName > htmlText = T.pack . L.unpack . renderHtml . html @@ -222,14 +227,13 @@ > isHeader = header =~ L.pack "^<(h\\d)" > count = [0 .. (length section) - 1] > (h, count') = if isHeader then -> let layout' = if isNothing maybeLayout then "" -> else fromJust maybeLayout +> let layout' = maybe mempty id maybeLayout > in ( [("header", header)] > , (if layout' == "linear" then tail else id) count) > else > ([("header", header)], count) > source <- sources $ dirOrFiles opts -> html <- hyakkoTemplate opts $ concat +> html <- hyakkoTemplate opts . varListToJSON $ concat > [ [("title", if isHeader then getHeader header else title)] > , h > , cssTemplate opts @@ -252,23 +256,14 @@ Helpers & Setup --------------- -Infix functions for easier concatenation with Text and ByteString. - -> (++.) :: Text -> Text -> Text -> (++.) = T.append -> {-# INLINE (++.) #-} - -> (++*) :: ByteString -> ByteString -> ByteString -> (++*) = L.append -> {-# INLINE (++*) #-} - Simpler type signatuted regex replace function. -> replace :: ByteString -> Text -> Text -> Text +> replace :: Text -> Text -> Text -> Text > replace reg x y = -> let str = T.unpack x -> (_, _, rp) = str =~ reg :: (String, String, String) -> in y ++. (T.pack rp) +> let str = T.unpack x +> reg' = L.pack $ T.unpack reg +> (_, _, rp) = str =~ reg' :: (String, String, String) +> in y <> (T.pack rp) > readLanguageFile :: IO ByteString > readLanguageFile = getDataFileName "resources/languages.json" @@ -311,10 +306,10 @@ Create the template that we will use to generate the Hyakko HTML page. -> hyakkoTemplate :: Hyakko -> [(String, String)] -> IO Text +> hyakkoTemplate :: Hyakko -> Value -> IO Text > hyakkoTemplate opts var = do > content <- hyakkoFile "html" opts -> return . T.pack . renderTemplate var $ T.unpack content +> return . T.pack $ renderTemplate' (T.unpack content) var The CSS styles we'd like to apply to the documentation. @@ -366,14 +361,14 @@ > forM_ dirs $ \x -> do > let x' = T.pack x -> dir' = T.unpack $ T.replace oldLocation "" x' +> dir' = T.unpack $ T.replace oldLocation mempty x' > createDirectoryIfMissing False $ dirout dir' Copy all the files into the recently created directories. > forM_ files $ \x -> do > let x' = T.pack x -> file = dirout (T.unpack $ T.replace oldLocation "" x') +> file = dirout (T.unpack $ T.replace oldLocation mempty x') > copyFile x file Configuration diff --git a/src/Hyakko/Types.hs b/src/Hyakko/Types.hs --- a/src/Hyakko/Types.hs +++ b/src/Hyakko/Types.hs @@ -4,7 +4,6 @@ import Control.Applicative ((<$>), (<*>), empty) import Data.Aeson -import Data.ByteString.Lazy (ByteString) import Data.HashMap.Strict (HashMap) import Data.Text (Text) import System.Console.CmdArgs @@ -19,10 +18,10 @@ -- Better data type for language info — compared to the `Object` data type -- in `Aeson`. data Language = - Language { name_ :: ByteString - , symbol :: ByteString + Language { name_ :: Text + , symbol :: Text , literate :: Maybe Bool - , litSymbol :: Maybe ByteString + , litSymbol :: Maybe Text } instance FromJSON Language where