initial commit

.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+pandoc-to-sphinx.cabal
+*~

AUTHORS

@@ -0,0 +1,6 @@
+Copyright (c) 2017 Presidenza del Consiglio dei Ministri
+
+Moral rights:
+ Francesco Occhipinti
+
+The version control system provides attribution for specific lines of code.

ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for pandoc-to-sphinx
+
+## Unreleased changes

README.md

@@ -0,0 +1,20 @@
+# pandoc-to-sphinx
+
+
+
+## License
+
+Copyright (c) the respective contributors, as shown by the AUTHORS file.
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as published
+by the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public License
+along with this program.  If not, see <http://www.gnu.org/licenses/>.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -0,0 +1,9 @@
+module Main where
+
+import Text.Pandoc
+import Lib (transform)
+
+main :: IO ()
+main = do
+
+

design.md

@@ -0,0 +1,28 @@
+`pandoc-to-sphinx`
+
+from any pandoc-compatible document to a set of files ready to be
+published on read the docs
+
+#### Status
+
+This is pre-alpha at the moment, it's an usable evolutionary prototype
+
+#### Installation
+
+This is an Haskell package and can be installed from its sources with
+[stack](https://docs.haskellstack.org/en/stable/GUIDE/)
+
+#### Usage
+
+After installation, typing `pandoc-to-sphinx --help` will give you the
+following:
+
+```
+pandoc-to-sphinx <document.ext> <output-dir>
+
+
+-l --level: (optional) the section level to use for splitting the document
+
+-s --second-split: (optional) the level for the second split
+
+```

focus

@@ -0,0 +1,57 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+licenza per una pubblicazione più graduale
+
+o ci sono le funzioni di alto livello esportate in Text.Pandoc.App
+collegando Text.Pandoc.Readers.getReader con il parsing di opzioni
+o si specifica il writer manualmente
+
+https://github.com/Hogeyama/pandoc-wrapper/blob/master/Main.hs
+
+in Main i can put together a minimal wrapper
+
+if there is anything from `convert.hs`, i can add it eventually
+what happens when pandoc reads an RST which refers to media?
+
+i can add new options after we fix the problem with table wraps in docs2rst
+
+un wrapper sarebbe semplicemente un client per la libreria
+non mi sembra che ci sia supporto specifico per i wrapper
+
+otherwise accepting json input
+maybe we can do it with a pandoc wrapper like the existing ones
+it requires a way to pass command line options through
+accepting any pandoc-document as an input is more convenient for the users
+
+
+

package.yaml

@@ -0,0 +1,48 @@
+name:                pandoc-to-sphinx
+version:             0.1.0.0
+github:              "githubuser/pandoc-to-sphinx"
+license:             BSD3
+author:              "Author name here"
+maintainer:          "[email protected]"
+copyright:           "2018 Author name here"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/githubuser/pandoc-to-sphinx#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+
+library:
+  source-dirs: src
+
+executables:
+  pandoc-to-sphinx-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - pandoc-to-sphinx
+
+tests:
+  pandoc-to-sphinx-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - pandoc-to-sphinx

src/Lib.hs

@@ -0,0 +1,157 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Lib
+    ( transform
+    ) where
+
+import Text.Pandoc
+import Text.Pandoc.JSON
+import Text.Pandoc.Options
+import Text.Pandoc.Walk (query, walk)
+import qualified Data.Text.IO as T
+import Data.Monoid ((<>))
+import Options.Applicative
+import Control.Monad (sequence_, join)
+import Data.Either (fromRight)
+import Data.List (intercalate)
+import System.Directory (createDirectory,
+                         removeDirectoryRecursive,
+                         doesFileExist,
+                         doesPathExist)
+import Control.Applicative ((<$>))
+import Control.Monad (when)
+import System.FilePath.Posix (dropExtension, addExtension)
+
+main = do
+  c <- T.getContents
+  c' <- (onBody f . fromRight (Pandoc nullMeta []) . readJSON def) c
+  (T.putStr . writeJSON def) c'
+
+transform :: Pandoc -> IO Pandoc
+transform = onBody f
+
+onBody :: ([Block] -> IO [Block]) -> Pandoc -> IO Pandoc
+onBody f (Pandoc m b) = do
+  b' <- f b
+  pure (Pandoc m b')
+
+f :: [Block] -> IO [Block]
+f d = do
+  exists <- doesPathExist "index"  
+  when exists (removeDirectoryRecursive "index")
+  createDirectory "index"  
+  s <- writeSections d
+  pure (makeIndex s d)
+
+makeIndex :: [String] -> [Block] -> [Block]
+makeIndex s b = getIntro b <> [tableOfContents]
+  where tableOfContents = tocTree 2 s
+        getIntro = join . fst . breakSections
+
+writeSections :: [Block] -> IO [String]
+writeSections = sequence . map writeSection . snd . breakSections
+
+writeSection :: [Block] -> IO String
+writeSection [] = pure "empty-section"
+writeSection s =
+  let path = getPath $ head s
+  in do
+    (Right contents) <- runIO (writeRST rstOptions (Pandoc nullMeta s))
+    avail <- availablePath path
+    T.writeFile avail contents
+    pure avail
+
+availablePath :: String -> IO String
+availablePath path = do
+  (available, c) <- untilM (\ x -> not <$> (doesFileExist $ getPath x)) (\(p, c)-> (p, c+1)) (path, 1)
+  pure $ getPath (available, c)
+  where getPath (p, 1) = p
+        getPath o = addNumber o
+        addNumber (p, c) = addExtension (dropExtension p <> "-" <> show c) ".rst"
+
+-- | like `until` but for monadic functions
+-- >>> let p a = Just (a > 3)
+-- >>> untilM p (+1) 0
+-- Just 4
+untilM :: Monad m => (a -> m Bool) -> (a -> a) -> a -> m a
+untilM p f i = do
+  r <- p i
+  if r then pure i else untilM p f (f i)
+
+breakSections body = (intro, sections)
+  where intro = take 1 broken
+        sections = drop 1 broken
+        broken = multiBreak (isHeading (level body)) body
+
+rstOptions = def { writerWrapText = WrapNone }
+
+headDefault :: a -> [a] -> a
+headDefault d = defaultMaybe d . maybeHead
+
+defaultMaybe :: a -> Maybe a -> a
+defaultMaybe d Nothing = d
+defaultMaybe _ (Just s) = s
+
+maybeHead :: [a] -> Maybe a
+maybeHead l
+  | null l = Nothing
+  | otherwise = Just (head l)
+
+-- | if we have only one header 1 break by header 2 and so on
+level :: [Block] -> Int
+level body = headDefault 1 $ filter hasSeveral [2, 3, 4, 5, 1]
+  where hasSeveral l = (length $ query (collectHeading l) body) > 1
+        collectHeading l i = if isHeading l i then [i] else []
+
+-- | Multiple version of break, like a `split` that keeps the delimiter
+-- >>> multiBreak (==' ') "bla bla bla b"
+-- ["bla"," bla"," bla"," b"]
+multiBreak :: (a -> Bool) -> [a] -> [[a]]
+multiBreak p [] = []
+multiBreak p l@(h:t)
+  | p h       = (h : t1) : multiBreak p t2
+  | otherwise = l1 : multiBreak p l2
+  where (t1, t2) = break p t
+        (l1, l2) = break p l
+
+{-
+
+.. toctree::
+   :maxdepth: 2
+   :caption: Indice dei contenuti
+
+   index/che-cos-e-docs-italia.rst
+   index/starter-kit.rst
+
+-}
+tocTree :: Int -> [String] -> Block
+tocTree depth paths = RawBlock "rst" $
+           ".. toctree::" <>
+           "\n  :maxdepth: " <> show depth <>
+           "\n  :caption: Indice dei contenuti" <>
+           "\n" <>
+           concatMap (\x -> "\n  "<>x) paths
+
+-- | get the path corresponding to some heading
+-- >>> getPath (Header 2 ("", [], []) [Str "my section accénted"])
+-- "index/my-section-accénted.rst"
+getPath :: Block -> String
+getPath (Header _  _ i) = "index/" <> adapt (foldl j "" $ walk simplify' i) <> ".rst"
+  where j s1 (Str s2) = s1 <> s2
+        j s1 _ = s1 <> "unknown-inline"
+        adapt = map replace . limit -- adapt for the file system
+        limit = take 50 -- file names cannot be too long
+        replace '/' = '-'
+        replace o = o
+
+simplify' = concatMap simplify
+
+simplify :: Inline -> [Inline]
+simplify (Emph i) = i
+simplify (Strong i) = i
+simplify (Link _ i _) = i
+simplify Space = [Str "-"]
+simplify i = [i]
+
+isHeading :: Int -> Block -> Bool
+isHeading a (Header b _ _) = a == b
+isHeading _ _ = False