{-# 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
  [Char]
w <- IO [Char]
getCurrentDirectory
  [Char] -> IO ()
setCurrentDirectory [Char]
d
  a
result <- IO a
action
  [Char] -> IO ()
setCurrentDirectory [Char]
w
  a -> IO a
forall a. 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 :: forall a. [Char] -> ([Char] -> IO a) -> IO a
withTempDir [Char]
baseName [Char] -> IO a
f = do
  [Char]
oldDir <- IO [Char]
getCurrentDirectory
  IO [Char] -> ([Char] -> IO ()) -> ([Char] -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Integer -> [Char] -> IO [Char]
createTempDir Integer
0 [Char]
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)
          [Char] -> IO a
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
  [Char]
sysTempDir <- IO [Char]
getTemporaryDirectory
  let dirName :: [Char]
dirName = [Char]
sysTempDir [Char] -> [Char] -> [Char]
</> [Char]
baseName [Char] -> [Char] -> [Char]
<.> Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
num
  IO [Char] -> IO [Char]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> IO [Char]) -> IO [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char] -> (IOError -> IO [Char]) -> IO [Char]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch ([Char] -> IO ()
createDirectory [Char]
dirName IO () -> IO [Char] -> IO [Char]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
dirName) ((IOError -> IO [Char]) -> IO [Char])
-> (IOError -> IO [Char]) -> IO [Char]
forall a b. (a -> b) -> a -> b
$
      \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