nek0/eidolon
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

hunting warnings

Browse source
This commit is contained in:
nek0 2016-08-23 20:06:35 +02:00
parent 8927bf8e32
commit cc0a0ce1a3
1 changed files with 7 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
Helper.hs
View file

@ -22,23 +22,18 @@ import Model
import Data.Maybe import Data.Maybe
import Data.List as L import Data.List as L
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time import Data.Time
import Data.Char import Data.Char
import Database.Persist import Database.Persist
import System.Random import System.Random
-- import System.Locale
import Yesod import Yesod
import Numeric (readHex, showHex) import Numeric (readHex, showHex)
import Network.Mail.Mime import Network.Mail.Mime
import Text.Blaze.Html.Renderer.Utf8 import Text.Blaze.Html.Renderer.Utf8
import Filesystem.Path.CurrentOS
import Database.Bloodhound
import Network.HTTP.Client
import Network.HTTP.Types.Status as S
import Control.Monad (when)
import Codec.Picture import Codec.Picture
@ -62,7 +57,7 @@ extractKey = extractKey' . keyToValues
packKey :: PersistEntity record => T.Text -> Key record packKey :: PersistEntity record => T.Text -> Key record
packKey = keyFromValues' . readText packKey = keyFromValues' . readText
where where
readText t = PersistInt64 $ (fromIntegral $ read $ T.unpack t) readText t = PersistInt64 (fromIntegral $ read $ T.unpack t)
keyFromValues' v = case keyFromValues [v] of keyFromValues' v = case keyFromValues [v] of
Left err -> error $ T.unpack err Left err -> error $ T.unpack err
Right k -> k Right k -> k
@ -158,7 +153,8 @@ reverseLookup :: Eq b => b -> [(a, b)] -> Maybe a
reverseLookup s ((x, y):zs) reverseLookup s ((x, y):zs)
| s == y = Just x | s == y = Just x
| s /= y = reverseLookup s zs | s /= y = reverseLookup s zs
| otherwise = Nothing reverseLookup _ [] = Nothing
reverseLookup _ _ = Nothing
acceptedTypes :: [T.Text] acceptedTypes :: [T.Text]
acceptedTypes = ["image/jpeg", "image/jpg", "image/png", "image/x-ms-bmp", "image/x-bmp", "image/bmp", "image/tiff", "image/tiff-fx", "image/svg+xml", "image/gif"] acceptedTypes = ["image/jpeg", "image/jpg", "image/png", "image/x-ms-bmp", "image/x-bmp", "image/bmp", "image/tiff", "image/tiff-fx", "image/svg+xml", "image/gif"]
@ -201,18 +197,13 @@ getThumbWidth path
return $ imageWidth img return $ imageWidth img
Left e -> Left e ->
error e error e
-- | path == Nothing = pure 230
-- | otherwise = liftIO $ withMagickWandGenesis $ do
-- (_, w) <- magickWand
-- readImage w (T.pack $ fromJust path)
-- getImageWidth w
multiFileField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m [FileInfo] multiFileField :: (Monad m) => Field m [FileInfo]
multiFileField = Field multiFileField = Field
{ fieldParse = \_ files -> return $ { fieldParse = \_ files -> return $
case files of case files of
[] -> Right Nothing [] -> Right Nothing
file:_ -> Right $ Just files _:_ -> Right $ Just files
, fieldView = \id' name attrs _ isReq -> toWidget [hamlet| , fieldView = \id' name attrs _ isReq -> toWidget [hamlet|
<input id=#{id'} name=#{name} *{attrs} type=file :isReq:required multiple="" enctype="multipart/form-data"> <input id=#{id'} name=#{name} *{attrs} type=file :isReq:required multiple="" enctype="multipart/form-data">
|] |]