    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-
    Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 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 General Public License for more details.
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    -}

    {- | Functions for initializing a Gitit wiki.
    -}

    module Network.Gitit.Initialize ( initializeGititState
                                    , recompilePageTemplate
                                    , compilePageTemplate
                                    , createStaticIfMissing
                                    , createRepoIfMissing
                                    , createDefaultPages
                                    , createTemplateIfMissing )
    where
    import System.FilePath ((</>), (<.>))
    import Data.Semigroup ((<>))
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.FileStore
    import qualified Data.Map as M
    import Network.Gitit.Util (readFileUTF8)
    import Network.Gitit.Types
    import Network.Gitit.State
    import Network.Gitit.Framework
    import Network.Gitit.Plugins
    import Network.Gitit.Layout (defaultRenderPage)
    import Paths_gitit (getDataFileName)
    import Control.Exception (throwIO, try)
    import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
    import Control.Monad ((<=<), unless, forM_, liftM)
    import Text.Pandoc hiding (getDataFileName, WARNING)
    import System.Log.Logger (logM, Priority(..))
    import qualified Text.StringTemplate as ST

    -- | Initialize Gitit State.
    initializeGititState :: Config -> IO ()
    initializeGititState :: Config -> IO ()
    initializeGititState Config
    conf = do
      let userFile' :: FilePath
    userFile' = Config -> FilePath
    userFile Config
    conf
          pluginModules' :: [FilePath]
    pluginModules' = Config -> [FilePath]
    pluginModules Config
    conf
      plugins' <- [FilePath] -> IO [Plugin]
    loadPlugins [FilePath]
    pluginModules'

      userFileExists <- doesFileExist userFile'
      users' <- if userFileExists
                   then liftM (M.fromList . read . T.unpack) $ readFileUTF8 userFile'
                   else return M.empty

      templ <- compilePageTemplate (templatesDir conf)

      updateGititState $ \GititState
    s -> GititState
    s { sessions      = Sessions M.empty
                                 , users         = users'
                                 , templatesPath = templatesDir conf
                                 , renderPage    = defaultRenderPage templ
                                 , plugins       = plugins' }

    -- | Recompile the page template.
    recompilePageTemplate :: IO ()
    recompilePageTemplate :: IO ()
    recompilePageTemplate = do
      tempsDir <- (GititState -> FilePath) -> IO FilePath
    forall (m :: * -> *) a. MonadIO m => (GititState -> a) -> m a
    queryGititState GititState -> FilePath
    templatesPath
      ct <- compilePageTemplate tempsDir
      updateGititState $ \GititState
    st -> GititState
    st{renderPage = defaultRenderPage ct}

    --- | Compile a master page template named @page.st@ in the directory specified.
    compilePageTemplate :: FilePath -> IO (ST.StringTemplate String)
    compilePageTemplate :: FilePath -> IO (StringTemplate FilePath)
    compilePageTemplate FilePath
    tempsDir = do
      defaultGroup <- FilePath -> IO FilePath
    getDataFileName (FilePath
    "data" FilePath -> FilePath -> FilePath
    </> FilePath
    "templates") IO FilePath
    -> (FilePath -> IO (STGroup FilePath)) -> IO (STGroup FilePath)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= FilePath -> IO (STGroup FilePath)
    forall a. Stringable a => FilePath -> IO (STGroup a)
    ST.directoryGroup
      customExists <- doesDirectoryExist tempsDir
      combinedGroup <-
        if customExists
           -- default templates from data directory will be "shadowed"
           -- by templates from the user's template dir
           then do customGroup <- ST.directoryGroup tempsDir
                   return $ ST.mergeSTGroups customGroup defaultGroup
           else do logM "gitit" WARNING $ "Custom template directory not found"
                   return defaultGroup
      case ST.getStringTemplate "page" combinedGroup of
            Just StringTemplate FilePath
    t    -> StringTemplate FilePath -> IO (StringTemplate FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StringTemplate FilePath
    t
            Maybe (StringTemplate FilePath)
    Nothing   -> FilePath -> IO (StringTemplate FilePath)
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "Could not get string template"

    -- | Create templates dir if it doesn't exist.
    createTemplateIfMissing :: Config -> IO ()
    createTemplateIfMissing :: Config -> IO ()
    createTemplateIfMissing Config
    conf' = do
      templateExists <- FilePath -> IO Bool
    doesDirectoryExist (Config -> FilePath
    templatesDir Config
    conf')
      unless templateExists $ do
        createDirectoryIfMissing True (templatesDir conf')
        templatePath <- getDataFileName $ "data" </> "templates"
        -- templs <- liftM (filter (`notElem` [".",".."])) $
        --  getDirectoryContents templatePath
        -- Copy footer.st, since this is the component users
        -- are most likely to want to customize:
        forM_ ["footer.st"] $ \FilePath
    t -> do
          FilePath -> FilePath -> IO ()
    copyFile (FilePath
    templatePath FilePath -> FilePath -> FilePath
    </> FilePath
    t) (Config -> FilePath
    templatesDir Config
    conf' FilePath -> FilePath -> FilePath
    </> FilePath
    t)
          FilePath -> Priority -> FilePath -> IO ()
    logM FilePath
    "gitit" Priority
    WARNING (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Created " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (Config -> FilePath
    templatesDir Config
    conf' FilePath -> FilePath -> FilePath
    </> FilePath
    t)

    -- | Create page repository unless it exists.
    createRepoIfMissing :: Config -> IO ()
    createRepoIfMissing :: Config -> IO ()
    createRepoIfMissing Config
    conf = do
      let fs :: FileStore
    fs = Config -> FileStore
    filestoreFromConfig Config
    conf
      repoExists <- IO () -> IO (Either FileStoreError ())
    forall e a. Exception e => IO a -> IO (Either e a)
    try (FileStore -> IO ()
    initialize FileStore
    fs) IO (Either FileStoreError ())
    -> (Either FileStoreError () -> IO Bool) -> IO Bool
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Either FileStoreError ()
    res ->
        case Either FileStoreError ()
    res of
             Right ()
    _               -> do
               FilePath -> Priority -> FilePath -> IO ()
    logM FilePath
    "gitit" Priority
    WARNING (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Created repository in " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Config -> FilePath
    repositoryPath Config
    conf
               Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
             Left FileStoreError
    RepositoryExists -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
             Left FileStoreError
    e                -> FileStoreError -> IO (ZonkAny 1)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO FileStoreError
    e IO (ZonkAny 1) -> IO Bool -> IO Bool
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      unless repoExists $ createDefaultPages conf

    createDefaultPages :: Config -> IO ()
    createDefaultPages :: Config -> IO ()
    createDefaultPages Config
    conf = do
        let fs :: FileStore
    fs = Config -> FileStore
    filestoreFromConfig Config
    conf
            pt :: PageType
    pt = Config -> PageType
    defaultPageType Config
    conf
            toPandoc :: Text -> PandocPure Pandoc
    toPandoc = ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readMarkdown ReaderOptions
    forall a. Default a => a
    def{ readerExtensions = enableExtension Ext_smart (readerExtensions def) }
            defOpts :: WriterOptions
    defOpts = WriterOptions
    forall a. Default a => a
    def{ writerExtensions = if showLHSBirdTracks conf
                                                 then enableExtension
                                                      Ext_literate_haskell
                                                      $ writerExtensions def
                                                 else writerExtensions def
                         }
            -- note: we convert this (markdown) to the default page format
            converter :: Text -> IO Text
    converter = Either PandocError Text -> IO Text
    forall a. Either PandocError a -> IO a
    handleError (Either PandocError Text -> IO Text)
    -> (Text -> Either PandocError Text) -> Text -> IO Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PandocPure Text -> Either PandocError Text
    forall a. PandocPure a -> Either PandocError a
    runPure (PandocPure Text -> Either PandocError Text)
    -> (Text -> PandocPure Text) -> Text -> Either PandocError Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . case PageType
    pt of
                           PageType
    Markdown   -> Text -> PandocPure Text
    forall a. a -> PandocPure a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                           PageType
    LaTeX      -> WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeLaTeX WriterOptions
    defOpts (Pandoc -> PandocPure Text)
    -> (Text -> PandocPure Pandoc) -> Text -> PandocPure Text
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> PandocPure Pandoc
    toPandoc
                           PageType
    HTML       -> WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeHtml5String WriterOptions
    defOpts (Pandoc -> PandocPure Text)
    -> (Text -> PandocPure Pandoc) -> Text -> PandocPure Text
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> PandocPure Pandoc
    toPandoc
                           PageType
    RST        -> WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeRST WriterOptions
    defOpts (Pandoc -> PandocPure Text)
    -> (Text -> PandocPure Pandoc) -> Text -> PandocPure Text
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> PandocPure Pandoc
    toPandoc
                           PageType
    Textile    -> WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeTextile WriterOptions
    defOpts (Pandoc -> PandocPure Text)
    -> (Text -> PandocPure Pandoc) -> Text -> PandocPure Text
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> PandocPure Pandoc
    toPandoc
                           PageType
    Org        -> WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeOrg WriterOptions
    defOpts (Pandoc -> PandocPure Text)
    -> (Text -> PandocPure Pandoc) -> Text -> PandocPure Text
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> PandocPure Pandoc
    toPandoc
    #if MIN_VERSION_pandoc(3,0,0)
                           PageType
    DocBook    -> WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeDocBook5 WriterOptions
    defOpts (Pandoc -> PandocPure Text)
    -> (Text -> PandocPure Pandoc) -> Text -> PandocPure Text
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> PandocPure Pandoc
    toPandoc
    #else
                           DocBook    -> writeDocbook5 defOpts <=< toPandoc
    #endif
                           PageType
    MediaWiki  -> WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeMediaWiki WriterOptions
    defOpts (Pandoc -> PandocPure Text)
    -> (Text -> PandocPure Pandoc) -> Text -> PandocPure Text
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> PandocPure Pandoc
    toPandoc
                           PageType
    CommonMark -> WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeCommonMark WriterOptions
    defOpts (Pandoc -> PandocPure Text)
    -> (Text -> PandocPure Pandoc) -> Text -> PandocPure Text
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Text -> PandocPure Pandoc
    toPandoc

        welcomepath <- FilePath -> IO FilePath
    getDataFileName (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "data" FilePath -> FilePath -> FilePath
    </> FilePath
    "FrontPage" FilePath -> FilePath -> FilePath
    <.> FilePath
    "page"
        welcomecontents <- converter =<< readFileUTF8 welcomepath
        helppath <- getDataFileName $ "data" </> "Help" <.> "page"
        helpcontentsInitial <- converter =<< readFileUTF8 helppath
        markuppath <- getDataFileName $ "data" </> "markup" <.> show pt
        helpcontentsMarkup <- converter =<< readFileUTF8 markuppath
        let helpcontents = Text
    helpcontentsInitial Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    helpcontentsMarkup
        usersguidepath <- getDataFileName "README.markdown"
        usersguidecontents <- converter =<< readFileUTF8 usersguidepath
        -- include header in case user changes default format:
        let header = Text
    "---\nformat: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
              FilePath -> Text
    T.pack (PageType -> FilePath
    forall a. Show a => a -> FilePath
    show PageType
    pt) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (if Config -> Bool
    defaultLHS Config
    conf then Text
    "+lhs" else Text
    "") Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
              Text
    "\n...\n\n"
        -- add front page, help page, and user's guide
        let auth = FilePath -> FilePath -> Author
    Author FilePath
    "Gitit" FilePath
    ""
        createIfMissing fs (frontPage conf <.> defaultExtension conf) auth "Default front page"
          $ header <> welcomecontents
        createIfMissing fs ("Help" <.> defaultExtension conf) auth "Default help page"
          $ header <> helpcontents
        createIfMissing fs ("Gitit User’s Guide" <.> defaultExtension conf) auth "User’s guide (README)"
          $ header <> usersguidecontents

    createIfMissing :: FileStore -> FilePath -> Author -> Description -> Text -> IO ()
    createIfMissing :: FileStore -> FilePath -> Author -> FilePath -> Text -> IO ()
    createIfMissing FileStore
    fs FilePath
    p Author
    a FilePath
    comm Text
    cont = do
      res <- IO () -> IO (Either FileStoreError ())
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO () -> IO (Either FileStoreError ()))
    -> IO () -> IO (Either FileStoreError ())
    forall a b. (a -> b) -> a -> b
    $ FileStore -> FilePath -> Author -> FilePath -> FilePath -> IO ()
    forall a.
    Contents a =>
    FileStore -> FilePath -> Author -> FilePath -> a -> IO ()
    create FileStore
    fs FilePath
    p Author
    a FilePath
    comm (Text -> FilePath
    T.unpack Text
    cont)
      case res of
           Right ()
    _ -> FilePath -> Priority -> FilePath -> IO ()
    logM FilePath
    "gitit" Priority
    WARNING (FilePath
    "Added " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    p FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " to repository")
           Left FileStoreError
    ResourceExists -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
           Left FileStoreError
    e              -> FileStoreError -> IO (ZonkAny 0)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO FileStoreError
    e IO (ZonkAny 0) -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Create static directory unless it exists.
    createStaticIfMissing :: Config -> IO ()
    createStaticIfMissing :: Config -> IO ()
    createStaticIfMissing Config
    conf = do
      let staticdir :: FilePath
    staticdir = Config -> FilePath
    staticDir Config
    conf
      staticExists <- FilePath -> IO Bool
    doesDirectoryExist FilePath
    staticdir
      unless staticExists $ do

        let cssdir = FilePath
    staticdir FilePath -> FilePath -> FilePath
    </> FilePath
    "css"
        createDirectoryIfMissing True cssdir
        cssDataDir <- getDataFileName $ "data" </> "static" </> "css"
        -- cssFiles <- liftM (filter (\f -> takeExtension f == ".css")) $ getDirectoryContents cssDataDir
        forM_ ["custom.css"] $ \FilePath
    f -> do
          FilePath -> FilePath -> IO ()
    copyFile (FilePath
    cssDataDir FilePath -> FilePath -> FilePath
    </> FilePath
    f) (FilePath
    cssdir FilePath -> FilePath -> FilePath
    </> FilePath
    f)
          FilePath -> Priority -> FilePath -> IO ()
    logM FilePath
    "gitit" Priority
    WARNING (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Created " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (FilePath
    cssdir FilePath -> FilePath -> FilePath
    </> FilePath
    f)

        {-
        let icondir = staticdir </> "img" </> "icons"
        createDirectoryIfMissing True icondir
        iconDataDir <- getDataFileName $ "data" </> "static" </> "img" </> "icons"
        iconFiles <- liftM (filter (\f -> takeExtension f == ".png")) $ getDirectoryContents iconDataDir
        forM_ iconFiles $ \f -> do
          copyFile (iconDataDir </> f) (icondir </> f)
          logM "gitit" WARNING $ "Created " ++ (icondir </> f)
        -}

        logopath <- getDataFileName $ "data" </> "static" </> "img" </> "logo.png"
        createDirectoryIfMissing True $ staticdir </> "img"
        copyFile logopath $ staticdir </> "img" </> "logo.png"
        logM "gitit" WARNING $ "Created " ++ (staticdir </> "img" </> "logo.png")

        {-
        let jsdir = staticdir </> "js"
        createDirectoryIfMissing True jsdir
        jsDataDir <- getDataFileName $ "data" </> "static" </> "js"
        javascripts <- liftM (filter (`notElem` [".", ".."])) $ getDirectoryContents jsDataDir
        forM_ javascripts $ \f -> do
          copyFile (jsDataDir </> f) (jsdir </> f)
          logM "gitit" WARNING $ "Created " ++ (jsdir </> f)
        -}