{-# 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 :: FilePath -> IO Text
readFileUTF8 = FilePath -> 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 :: FilePath -> IO a -> IO a
inDir FilePath
d 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 FilePath
baseName 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 Integer
0 FilePath
baseName)
          (\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 Integer
num 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
$
      \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
+ Integer
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 [a]
lst [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 Char
x | Char
x Char -> FilePath -> 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 :: 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` [Char
' ',Char
'\t'])

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

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