    {-# 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 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)

    #if !MIN_VERSION_pandoc(2,12,0)
    import qualified Data.Text as T
    #endif

    -- | Read file as UTF-8 string.  Encode filename as UTF-8.
    readFileUTF8 :: FilePath -> IO Text
    #if MIN_VERSION_pandoc(2,12,0)
    readFileUTF8 :: [Char] -> IO Text
    readFileUTF8 = [Char] -> IO Text
    UTF8.readFile
    #else
    readFileUTF8 = fmap T.pack . UTF8.readFile
    #endif

    -- | Perform a function a directory and return to working directory.
    inDir :: FilePath -> IO a -> IO a
    inDir :: forall a. [Char] -> IO a -> IO a
    inDir [Char]
    d IO a
    action = do
      w <- IO [Char]
    getCurrentDirectory
      setCurrentDirectory d
      result <- action
      setCurrentDirectory w
      return result

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

    -- | Create a temporary directory with a unique name.
    createTempDir :: Integer -> FilePath -> IO FilePath
    createTempDir :: Integer -> [Char] -> IO [Char]
    createTempDir Integer
    num [Char]
    baseName = do
      sysTempDir <- IO [Char]
    getTemporaryDirectory
      let dirName = [Char]
    sysTempDir [Char] -> [Char] -> [Char]
    </> [Char]
    baseName [Char] -> [Char] -> [Char]
    <.> Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    num
      liftIO $ E.catch (createDirectory dirName >> return dirName) $
          \IOError
    e -> if IOError -> Bool
    isAlreadyExistsError IOError
    e
                   then Integer -> [Char] -> IO [Char]
    createTempDir (Integer
    num Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    1) [Char]
    baseName
                   else IOError -> IO [Char]
    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 :: forall a. [a] -> [a] -> [a]
    orIfNull [a]
    lst [a]
    backup = if [a] -> Bool
    forall a. [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 :: [Char] -> [[Char]]
    splitCategories = [Char] -> [[Char]]
    words ([Char] -> [[Char]]) -> ([Char] -> [Char]) -> [Char] -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    puncToSpace ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    trim
         where puncToSpace :: Char -> Char
    puncToSpace Char
    x | Char
    x Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char
    '.',Char
    ',',Char
    ';',Char
    ':'] = Char
    ' '
               puncToSpace Char
    x = Char
    x

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

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

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

    getPageTypeDefaultExtensions :: PageType -> Bool -> Extensions
    getPageTypeDefaultExtensions :: PageType -> Bool -> Extensions
    getPageTypeDefaultExtensions PageType
    pt 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
                PageType
    CommonMark -> Text
    "commonmark"
                PageType
    DocBook    -> Text
    "docbook"
                PageType
    HTML       -> Text
    "html"
                PageType
    LaTeX      -> Text
    "latex"
                PageType
    Markdown   -> Text
    "markdown"
                PageType
    MediaWiki  -> Text
    "mediawiki"
                PageType
    Org        -> Text
    "org"
                PageType
    RST        -> Text
    "rst"
                PageType
    Textile    -> Text
    "textile"

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