module Hoodle.Util where
import Control.Applicative
import Data.Attoparsec.Char8
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Network.URI
import System.Directory
import System.Environment
import System.FilePath
import System.IO
import Data.Time.Clock
import Data.Time.Format
import System.Locale
import Data.Hoodle.Simple
(#) :: a -> (a -> b) -> b
(#) = flip ($)
infixr 0 #
maybeFlip :: Maybe a -> b -> (a->b) -> b
maybeFlip m n j = maybe n j m
uncurry4 :: (a->b->c->d->e)->(a,b,c,d)->e
uncurry4 f (x,y,z,w) = f x y z w
maybeRead :: Read a => String -> Maybe a
maybeRead = fmap fst . listToMaybe . reads
getLargestWidth :: Hoodle -> Double
getLargestWidth hdl =
let ws = map (dim_width . page_dim) (hoodle_pages hdl)
in maximum ws
getLargestHeight :: Hoodle -> Double
getLargestHeight hdl =
let hs = map (dim_height . page_dim) (hoodle_pages hdl)
in maximum hs
waitUntil :: (Monad m) => (a -> Bool) -> m a -> m ()
waitUntil p act = do
a <- act
if p a
then return ()
else waitUntil p act
errorlog :: String -> IO ()
errorlog str = do
homepath <- getEnv "HOME"
let dir = homepath </> ".hoodle.d"
createDirectoryIfMissing False dir
outh <- openFile (dir </> "error.log") AppendMode
utctime <- getCurrentTime
let timestr = formatTime defaultTimeLocale "%F %H:%M:%S %Z" utctime
hPutStr outh (timestr ++ " : " )
hPutStrLn outh str
hClose outh
maybeError' :: String -> Maybe a -> a
maybeError' str = maybe (error str) id
data UrlPath = FileUrl FilePath | HttpUrl String
deriving (Show,Eq)
data T = N | F | H | HS deriving (Show,Eq)
urlParse :: String -> Maybe UrlPath
urlParse str =
if length str < 7
then Just (FileUrl str)
else
let p = do b <- (try (string "file://" *> return F)
<|> try (string "http://" *> return H)
<|> try (string "https://" *> return HS)
<|> (return N) )
rem <- manyTill anyChar ((satisfy (inClass "\r\n") *> return ()) <|> endOfInput)
return (b,rem)
r = parseOnly p (B.pack str)
in case r of
Left _ -> Nothing
Right (b,f) -> case b of
N -> Just (FileUrl f)
F -> Just (FileUrl (unEscapeString f))
H -> Just (HttpUrl ("http://" ++ f))
HS -> Just (HttpUrl ("https://" ++ f))