content: -- | This script generates a man page for patat.
  {-# LANGUAGE OverloadedStrings #-}
  import           Control.Exception   (throw)
  import           Control.Monad       (guard)
  import           Control.Monad.Trans (liftIO)
  import           Data.Char           (isSpace, toLower)
  import           Data.List           (isPrefixOf)
  import qualified Data.Map            as M
  import           Data.Maybe          (isJust)
  import qualified Data.Text           as T
  import qualified Data.Text.IO        as T
  import qualified Data.Time           as Time
  import qualified GHC.IO.Encoding     as Encoding
  import           Prelude
  import           System.Environment  (getEnv)
  import qualified System.IO           as IO
  import           Text.DocTemplates   as DT
  import qualified Text.Pandoc         as Pandoc
  
  getVersion :: IO String
  getVersion =
      dropWhile isSpace . drop 1 . dropWhile (/= ':') . head .
      filter (\l -> "version:" `isPrefixOf` map toLower l) .
      map (dropWhile isSpace) . lines <$> readFile "patat.cabal"
  
  getPrettySourceDate :: IO String
  getPrettySourceDate = do
      epoch <- getEnv "SOURCE_DATE_EPOCH"
      utc   <- Time.parseTimeM True locale "%s" epoch :: IO Time.UTCTime
      return $ Time.formatTime locale "%B %d, %Y" utc
    where
      locale = Time.defaultTimeLocale
  
  type Sections = [(Int, T.Text, [Pandoc.Block])]
  
  toSections :: Int -> [Pandoc.Block] -> Sections
  toSections level = go
    where
      go []       = []
      go (h : xs) = case toSectionHeader h of
          Nothing         -> go xs
          Just (l, title) ->
              let (section, cont) = break (isJust . toSectionHeader) xs in
              (l, title, section) : go cont
  
      toSectionHeader :: Pandoc.Block -> Maybe (Int, T.Text)
      toSectionHeader (Pandoc.Header l _ inlines) = do
          guard (l <= level)
          let doc = Pandoc.Pandoc Pandoc.nullMeta [Pandoc.Plain inlines]
              txt = case Pandoc.runPure (Pandoc.writeMarkdown Pandoc.def doc) of
                      Left err -> throw err  -- Bad!
                      Right x  -> T.strip x
          return (l, txt)
      toSectionHeader _ = Nothing
  
  fromSections :: Sections -> [Pandoc.Block]
  fromSections = concatMap $ \(level, title, blocks) ->
      Pandoc.Header level ("", [], []) [Pandoc.Str title] : blocks
  
  reorganizeSections :: Pandoc.Pandoc -> Pandoc.Pandoc
  reorganizeSections (Pandoc.Pandoc meta0 blocks0) =
      let sections0 = toSections 2 blocks0 in
      Pandoc.Pandoc meta0 $ fromSections $
          [ (1, "NAME", nameSection)
          ] ++
          [ (1, "SYNOPSIS", s)
          | (_, _, s) <- lookupSection "Running" sections0
          ] ++
          [ (1, "DESCRIPTION", [])
          ] ++
              [ (2, n, s)
              | (_, n, s) <- lookupSection "Controls" sections0
              ] ++
              [ (2, n, s)
              | (_, n, s) <- lookupSection "Input format" sections0
              ] ++
              [ (2, n, s)
              | (_, n, s) <- lookupSection "Configuration" sections0
              ] ++
          [ (1, "OPTIONS", s)
          | (_, _, s) <- lookupSection "Options" sections0
          ] ++
          [ (1, "SEE ALSO", seeAlsoSection)
          ]
    where
      nameSection    = mkPara "patat - Presentations Atop The ANSI Terminal"
      seeAlsoSection = mkPara "pandoc(1)"
      mkPara str     = [Pandoc.Para [Pandoc.Str str]]
  
      lookupSection name sections =
          [section | section@(_, n, _) <- sections, name == n]
  
  simpleContext :: [(T.Text, T.Text)] -> DT.Context T.Text
  simpleContext = DT.toContext . M.fromList
  
  main :: IO ()
  main = Pandoc.runIOorExplode $ do
      liftIO $ Encoding.setLocaleEncoding Encoding.utf8
  
      let readerOptions = Pandoc.def
              { Pandoc.readerExtensions = Pandoc.pandocExtensions
              }
  
      source   <- liftIO $ T.readFile "README.md"
      pandoc0  <- Pandoc.readMarkdown readerOptions source
      template <- Pandoc.compileDefaultTemplate "man"
  
      version <- T.pack <$> liftIO getVersion
      date    <- T.pack <$> liftIO getPrettySourceDate
  
      let writerOptions = Pandoc.def
              { Pandoc.writerTemplate   = Just template
              , Pandoc.writerVariables  = simpleContext
                  [ ("author",  "Jasper Van der Jeugt")
                  , ("title",   "patat manual")
                  , ("date",    date)
                  , ("footer",  "patat v" <> version)
                  , ("section", "1")
                  ]
              }
  
      let pandoc1 = reorganizeSections $ pandoc0
      txt <- Pandoc.writeMan writerOptions pandoc1
      liftIO $ do
          T.putStr txt
          IO.hPutStrLn IO.stderr "Wrote man page."
  