packages feed

lhae-0.0.2: src/Util/FileType.hs

module Util.FileType ( FileType (..),extension,fromExtension
                     , fromFilePath,wildcard,bitmapType
                     , unknownFileType,unknownFileTypeIn
                     , justPngWildcard)
    where

import qualified Graphics.UI.WXCore as WXC
import Data.Char (toLower)
import System.FilePath (takeExtension)
import Util.Sexp (Sexp(Atom))
import Util.Sexpable (Sexpable (..),unexpected,unknownAtom)
import I18n(__)

data FileType = Bmp | Jpeg | Png | Tif deriving (Eq)

instance Sexpable FileType where
    toSexp = Atom . extension
    fromSexp (Atom ext) = 
        case fromExtension ext of
          Nothing -> unknownAtom ext
          Just ft -> return ft
    fromSexp sexp = unexpected sexp

extension :: FileType -> String
extension ext = 
    case ext of { Bmp -> "bmp"; Jpeg -> "jpeg"
                ; Png -> "png"; Tif -> "tif"}

fromExtension :: String -> Maybe FileType
fromExtension ext = 
    case map toLower ext of 
      "bmp" -> Just Bmp
      "jpg" -> Just Jpeg; "jpeg" -> Just Jpeg
      "png" -> Just Png; "tif" -> Just Tif
      _ -> Nothing

unknownFileType :: String -> String
unknownFileType ext = (__ "Unknown file type") ++ " '" ++ ext ++ "'"

unknownFileTypeIn :: FilePath -> String
unknownFileTypeIn filepath = 
    (__ "Unknown file type")++ " '" ++ (tail $ takeExtension filepath) ++ "'"

fromFilePath :: FilePath -> Maybe FileType
fromFilePath = fromExtension . tail . takeExtension

wildcard :: [(String,[String])]
wildcard = [ ("bmp",["*.bmp","*.BMP"])
           , ("jpeg",["*.jpg","*.JPG","*.jpeg","*.JPEG"])
           , ("png",["*.png","*.PNG"])
           , ("tif",["*.tif","*.TIF"])
           ]

justPngWildcard :: [(String,[String])]
justPngWildcard = [("png",["*.png","*.PNG"])]

bitmapType :: FileType -> Int
bitmapType ext = 
    case ext of
      Bmp -> WXC.wxBITMAP_TYPE_BMP
      Jpeg -> WXC.wxBITMAP_TYPE_JPEG
      Png -> WXC.wxBITMAP_TYPE_PNG
      Tif -> WXC.wxBITMAP_TYPE_TIF