    {-# LANGUAGE CPP, ScopedTypeVariables, 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
    -}

    {- Utility functions for Gitit.
    -}

    module Network.Gitit.Util ( readFileUTF8
                              , inDir
                              , withTempDir
                              , orIfNull
                              , splitCategories
                              , trim
                              , yesOrNo
                              , parsePageType
                              , encUrl
                              , getPageTypeDefaultExtensions
                              )
    where
    import System.Directory
    import Control.Exception (bracket)
    import System.FilePath ((</>), (<.>))
    import System.IO.Error (isAlreadyExistsError)
    import Control.Monad.Trans (liftIO)
    import Data.Char (toLower, isAscii)
    import Data.Text (Text)
    import qualified Data.Text as T
    import Network.Gitit.Types
    import qualified Control.Exception as E
    import qualified Text.Pandoc.UTF8 as UTF8
    import Text.Pandoc (Extension(..), Extensions, getDefaultExtensions, enableExtension)
    import Network.URL (encString)

    -- | Read file as UTF-8 string.  Encode filename as UTF-8.
    readFileUTF8 :: FilePath -> IO Text
    readFileUTF8 :: FilePath -> IO Text
    readFileUTF8 = (FilePath -> Text) -> IO FilePath -> IO Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> Text
    T.pack (IO FilePath -> IO Text)
    -> (FilePath -> IO FilePath) -> FilePath -> IO Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> IO FilePath
    UTF8.readFile

    -- | Perform a function a directory and return to working directory.
    inDir :: FilePath -> IO a -> IO a
    inDir :: FilePath -> IO a -> IO a
    inDir d :: FilePath
    d action :: IO a
    action = do
      FilePath
    w <- IO FilePath
    getCurrentDirectory
      FilePath -> IO ()
    setCurrentDirectory FilePath
    d
      a
    result <- IO a
    action
      FilePath -> IO ()
    setCurrentDirectory FilePath
    w
      a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result

    -- | Perform a function in a temporary directory and clean up.
    withTempDir :: FilePath -> (FilePath -> IO a) -> IO a
    withTempDir :: FilePath -> (FilePath -> IO a) -> IO a
    withTempDir baseName :: FilePath
    baseName f :: FilePath -> IO a
    f = do
      FilePath
    oldDir <- IO FilePath
    getCurrentDirectory
      IO FilePath -> (FilePath -> IO ()) -> (FilePath -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (Integer -> FilePath -> IO FilePath
    createTempDir 0 FilePath
    baseName)
              (\tmp :: FilePath
    tmp -> FilePath -> IO ()
    setCurrentDirectory FilePath
    oldDir IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> FilePath -> IO ()
    removeDirectoryRecursive FilePath
    tmp)
              FilePath -> IO a
    f

    -- | Create a temporary directory with a unique name.
    createTempDir :: Integer -> FilePath -> IO FilePath
    createTempDir :: Integer -> FilePath -> IO FilePath
    createTempDir num :: Integer
    num baseName :: FilePath
    baseName = do
      FilePath
    sysTempDir <- IO FilePath
    getTemporaryDirectory
      let dirName :: FilePath
    dirName = FilePath
    sysTempDir FilePath -> FilePath -> FilePath
    </> FilePath
    baseName FilePath -> FilePath -> FilePath
    <.> Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    num
      IO FilePath -> IO FilePath
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ IO FilePath -> (IOError -> IO FilePath) -> IO FilePath
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch (FilePath -> IO ()
    createDirectory FilePath
    dirName IO () -> IO FilePath -> IO FilePath
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> FilePath -> IO FilePath
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    dirName) ((IOError -> IO FilePath) -> IO FilePath)
    -> (IOError -> IO FilePath) -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $
          \e :: IOError
    e -> if IOError -> Bool
    isAlreadyExistsError IOError
    e
                   then Integer -> FilePath -> IO FilePath
    createTempDir (Integer
    num Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + 1) FilePath
    baseName
                   else IOError -> IO FilePath
    forall a. IOError -> IO a
    ioError IOError
    e

    -- | Returns a list, if it is not null, or a backup, if it is.
    orIfNull :: [a] -> [a] -> [a]
    orIfNull :: [a] -> [a] -> [a]
    orIfNull lst :: [a]
    lst backup :: [a]
    backup = if [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    lst then [a]
    backup else [a]
    lst

    -- | Split a string containing a list of categories.
    splitCategories :: String -> [String]
    splitCategories :: FilePath -> [FilePath]
    splitCategories = FilePath -> [FilePath]
    words (FilePath -> [FilePath])
    -> (FilePath -> FilePath) -> FilePath -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> FilePath -> FilePath
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    puncToSpace (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath
    trim
         where puncToSpace :: Char -> Char
    puncToSpace x :: Char
    x | Char
    x Char -> FilePath -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ['.',',',';',':'] = ' '
               puncToSpace x :: Char
    x = Char
    x

    -- | Trim leading and trailing spaces.
    trim :: String -> String
    trim :: FilePath -> FilePath
    trim = FilePath -> FilePath
    forall a. [a] -> [a]
    reverse (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath
    trimLeft (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath
    forall a. [a] -> [a]
    reverse (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath
    trimLeft
      where trimLeft :: FilePath -> FilePath
    trimLeft = (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> FilePath -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [' ','\t'])

    -- | Show Bool as "yes" or "no".
    yesOrNo :: Bool -> String
    yesOrNo :: Bool -> FilePath
    yesOrNo True  = "yes"
    yesOrNo False = "no"

    parsePageType :: String -> (PageType, Bool)
    parsePageType :: FilePath -> (PageType, Bool)
    parsePageType s :: FilePath
    s =
      case (Char -> Char) -> FilePath -> FilePath
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower FilePath
    s of
           "markdown"     -> (PageType
    Markdown,Bool
    False)
           "markdown+lhs" -> (PageType
    Markdown,Bool
    True)
           "commonmark"   -> (PageType
    CommonMark,Bool
    False)
           "docbook"      -> (PageType
    DocBook,Bool
    False)
           "rst"          -> (PageType
    RST,Bool
    False)
           "rst+lhs"      -> (PageType
    RST,Bool
    True)
           "html"         -> (PageType
    HTML,Bool
    False)
           "textile"      -> (PageType
    Textile,Bool
    False)
           "latex"        -> (PageType
    LaTeX,Bool
    False)
           "latex+lhs"    -> (PageType
    LaTeX,Bool
    True)
           "org"          -> (PageType
    Org,Bool
    False)
           "mediawiki"    -> (PageType
    MediaWiki,Bool
    False)
           x :: FilePath
    x              -> FilePath -> (PageType, Bool)
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> (PageType, Bool)) -> FilePath -> (PageType, Bool)
    forall a b. (a -> b) -> a -> b
    $ "Unknown page type: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    x

    getPageTypeDefaultExtensions :: PageType -> Bool -> Extensions
    getPageTypeDefaultExtensions :: PageType -> Bool -> Extensions
    getPageTypeDefaultExtensions pt :: PageType
    pt lhs :: Bool
    lhs =
      if Bool
    lhs
         then Extension -> Extensions -> Extensions
    enableExtension Extension
    Ext_literate_haskell Extensions
    defaults
         else Extensions
    defaults
      where defaults :: Extensions
    defaults = Text -> Extensions
    getDefaultExtensions (Text -> Extensions) -> Text -> Extensions
    forall a b. (a -> b) -> a -> b
    $
              case PageType
    pt of
                CommonMark -> "commonmark"
                DocBook    -> "docbook"
                HTML       -> "html"
                LaTeX      -> "latex"
                Markdown   -> "markdown"
                MediaWiki  -> "mediawiki"
                Org        -> "org"
                RST        -> "rst"
                Textile    -> "textile"

    encUrl :: String -> String
    encUrl :: FilePath -> FilePath
    encUrl = Bool -> (Char -> Bool) -> FilePath -> FilePath
    encString Bool
    True Char -> Bool
    isAscii