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

removed many compile time warnings

Browse source
This commit is contained in:
nek0 2014-12-28 07:12:25 +01:00
parent 30deabbe35
commit 8305c43383
25 changed files with 59 additions and 107 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
Application.hs
View file

@ -7,18 +7,13 @@ module Application
) where
import Import
import Settings
import Yesod.Static
import Yesod.Default.Config2
import Yesod.Default.Main
import Yesod.Default.Handlers
import qualified Database.Persist
import Database.Persist.Sql (runMigration)
import Network.HTTP.Client.Conduit (newManager)
import Control.Concurrent (forkIO, threadDelay)
import Control.Monad
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize, flushLogStr)
import Network.Wai.Logger (clockDateCacher)
import System.Log.FastLogger (newStdoutLoggerSet, defaultBufSize)
import Data.Default (def)
import Yesod.Core.Types (loggerSet)
@ -34,8 +29,7 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger),
IPAddrSource (..),
OutputFormat (..), destination,
mkRequestLogger, outputFormat)
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
toLogStr)
import System.Log.FastLogger (toLogStr)
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!

7
Foundation.hs
View file

@ -3,12 +3,8 @@ module Foundation where
import Prelude
import Yesod
import Yesod.Static
import Yesod.Default.Config2
import Yesod.Default.Util (addStaticContentExternal)
import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
import qualified Settings
import Settings.Development (development)
import qualified Database.Persist
import Database.Persist.Sql -- (ConnectionPool, runSqlPool)
import Settings.StaticFiles
import Settings
@ -18,7 +14,6 @@ import Text.Hamlet (hamletFile)
import Yesod.Core.Types
-- costom imports
import Data.Text
import Data.Maybe
import Helper
-- | The site argument for your application. This can be a good place to
@ -56,7 +51,7 @@ instance Yesod App where
approot = ApprootMaster $ appRoot . appSettings
-- change maximum content length
maximumContentLength _ _ = Just $ 1024 ^ 5
maximumContentLength _ _ = Just $ 1024 ^ (5 :: Int)
-- Store session data on the client in encrypted cookies,
-- default session idle timeout is 120 minutes

6
Handler/Activate.hs
View file

@ -14,7 +14,7 @@ getActivateR token = do
Nothing -> do
mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] []
case mToken of
Just (Entity uTokenId uToken) -> do
Just (Entity _ uToken) -> do
user <- runDB $ getJust (fromJust $ tokenUser uToken)
hexSalt <- return $ toHex $ userSalt user
defaultLayout $ do
@ -23,11 +23,11 @@ getActivateR token = do
_ -> do
setMessage "Invalid token!"
redirect $ HomeR
Just (Entity activatorKey activator) -> do
Just (Entity _ activator) -> do
uSalt <- return $ userSalt $ activatorUser activator
mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] []
case mToken of
Just (Entity uTokenId uToken) -> do
Just (Entity _ _) -> do
hexSalt <- return $ toHex uSalt
defaultLayout $ do
$(widgetFile "activate")

8
Handler/AdminAlbumSettings.hs
View file

@ -70,10 +70,10 @@ postAdminAlbumSettingsR albumId = do
Just album -> do
entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
users <- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities
((res, adminAlbumSettingsWidget), enctype) <- runFormPost $ adminAlbumSettingsForm album albumId users
((res, _), _) <- runFormPost $ adminAlbumSettingsForm album albumId users
case res of
FormSuccess temp -> do
aId <- runDB $ update albumId
_ <- runDB $ update albumId
[ AlbumTitle =. albumTitle temp
, AlbumShares =. albumShares temp
, AlbumSamplePic =. albumSamplePic temp
@ -117,14 +117,14 @@ getAdminAlbumDeleteR albumId = do
newAlbumList <- return $ removeItem albumId albumList
runDB $ update ownerId [UserAlbums =. newAlbumList]
-- delete album content and its comments
mapM (\a -> do
_ <- mapM (\a -> do
-- delete files
medium <- runDB $ getJust a
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
-- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. a] []
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
-- delete album database entry
runDB $ delete a
) (albumContent album)

4
Handler/AdminComments.hs
View file

@ -28,10 +28,10 @@ getAdminCommentDeleteR commentId = do
Right _ -> do
tempComment <- runDB $ get commentId
case tempComment of
Just comment -> do
Just _ -> do
-- delete comment children
children <- runDB $ selectList [CommentParent ==. (Just commentId)] []
mapM (\ent -> runDB $ delete $ entityKey ent) children
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) children
-- delete comment itself
runDB $ delete commentId
setMessage "Comment deleted succesfully"

4
Handler/AdminMediumSettings.hs
View file

@ -46,7 +46,7 @@ postAdminMediumSettingsR mediumId = do
tempMedium <- runDB $ get mediumId
case tempMedium of
Just medium -> do
((res, adminMediumSetWidget), enctype) <- runFormPost $ adminMediumSetForm medium
((res, _), _) <- runFormPost $ adminMediumSetForm medium
case res of
FormSuccess temp -> do
runDB $ update mediumId
@ -94,7 +94,7 @@ getAdminMediumDeleteR mediumId = do
runDB $ update albumId [AlbumContent =. newMediaList]
-- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
-- delete medium
runDB $ delete mediumId
-- delete files

8
Handler/AdminProfileSettings.hs
View file

@ -88,7 +88,7 @@ postAdminProfileSettingsR ownerId = do
tempOwner <- runDB $ get ownerId
case tempOwner of
Just owner -> do
((result, adminProfileSetWidget), enctype) <- runFormPost $ adminProfileForm owner
((result, _), _) <- runFormPost $ adminProfileForm owner
case result of
FormSuccess temp -> do
runDB $ update ownerId
@ -129,13 +129,13 @@ getAdminProfileDeleteR ownerId = do
case tempOwner of
Just owner -> do
albumList <- return $ userAlbums owner
mapM (\albumId -> do
_ <- mapM (\albumId -> do
album <- runDB $ getJust albumId
mediaList <- return $ albumContent album
mapM (\med -> do
_ <- mapM (\med -> do
-- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. med] []
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
-- delete media files
medium <- runDB $ getJust med
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)

15
Handler/AlbumSettings.hs
View file

@ -12,8 +12,6 @@ getAlbumSettingsR albumId = do
case tempAlbum of
Just album -> do
ownerId <- return $ albumOwner album
owner <- runDB $ getJust ownerId
ownerName <- return $ userName owner
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
@ -56,12 +54,12 @@ postAlbumSettingsR albumId = do
True -> do
entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
users <- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities
((result, albumSettingsWidget), enctype) <- runFormPost $ albumSettingsForm album albumId users
((result, _), _) <- runFormPost $ albumSettingsForm album albumId users
case result of
FormSuccess temp -> do
newShares <- return (L.sort $ albumShares temp)
oldShares <- return (L.sort $ albumShares album)
case newShares /= oldShares of
_ <- case newShares /= oldShares of
True -> do
link <- ($ AlbumR albumId) <$> getUrlRender
rcptIds <- return $ L.nub $ newShares L.\\ oldShares
@ -81,7 +79,7 @@ postAlbumSettingsR albumId = do
False -> do
return [()]
-- nothing to do here
aId <- runDB $ update albumId
_ <- runDB $ update albumId
[ AlbumTitle =. albumTitle temp
, AlbumShares =. newShares
, AlbumSamplePic =. albumSamplePic temp
@ -122,8 +120,6 @@ getAlbumDeleteR albumId = do
case tempAlbum of
Just album -> do
ownerId <- return $ albumOwner album
owner <- runDB $ getJust ownerId
ownerName <- return $ userName owner
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
@ -151,7 +147,6 @@ postAlbumDeleteR albumId = do
Just album -> do
ownerId <- return $ albumOwner album
owner <- runDB $ getJust ownerId
ownerName <- return $ userName owner
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
@ -167,14 +162,14 @@ postAlbumDeleteR albumId = do
newAlbumList <- return $ removeItem albumId albumList
runDB $ update ownerId [UserAlbums =. newAlbumList]
-- delete album content and its comments
mapM (\a -> do
_ <- mapM (\a -> do
-- delete files
medium <- runDB $ getJust a
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
-- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. a] []
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
runDB $ delete a
) (albumContent album)
-- delete album

1
Handler/Commons.hs
View file

@ -44,7 +44,6 @@ mediumCheck mediumId = do
case tempMedium of
Just medium -> do
ownerId <- return $ mediumOwner medium
owner <- runDB $ getJust ownerId
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do

11
Handler/Login.hs
View file

@ -2,13 +2,13 @@ module Handler.Login where
import Import hiding (returnJson)
import qualified Data.Text as T
import Yesod hiding (returnJson)
import Crypto.HMAC
import Crypto.Hash.CryptoAPI (SHA1)
import qualified Data.ByteString as B
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text.Encoding (encodeUtf8)
import Data.Serialize (encode)
import Data.Maybe
import qualified Data.ByteString as B
import Data.Aeson.Types
data Credentials = Credentials
{ credentialsName :: Text
@ -37,7 +37,7 @@ postLoginR = do
Just (Entity userId user) -> do
salt <- return $ userSalt user
token <- liftIO makeRandomToken
tokenId <- runDB $ insert $ Token (encodeUtf8 token) "login" (Just userId)
_ <- runDB $ insert $ Token (encodeUtf8 token) "login" (Just userId)
returnJson ["salt" .= (toHex salt), "token" .= (toHex $ encodeUtf8 token)]
Nothing ->
returnJsonError ("No such user" :: T.Text)
@ -85,10 +85,13 @@ getLogoutR = do
setMessage "Succesfully logged out"
redirect $ HomeR
returnJson :: Monad m => [Pair] -> m RepJson
returnJson = return . repJson . object
returnJsonError :: (ToJSON a, Monad m) => a -> m RepJson
returnJsonError = returnJson . (:[]) . ("error" .=)
hmacSHA1 :: B.ByteString -> B.ByteString -> B.ByteString
hmacSHA1 keyData msgData =
let key = MacKey keyData
sha1 :: SHA1

10
Handler/Medium.hs
View file

@ -51,10 +51,10 @@ postMediumR mediumId = do
userId <- return $ Just $ getUserIdFromText tempUserId
u <- runDB $ getJust $ fromJust userId
userSl <- return $ Just $ userSlug u
((res, commentiwdget), enctype) <- runFormPost $ commentForm userId userSl mediumId Nothing
((res, _), _) <- runFormPost $ commentForm userId userSl mediumId Nothing
case res of
FormSuccess temp -> do
cId <- runDB $ insert temp
_ <- runDB $ insert temp
--send mail to medium owner
owner <- runDB $ getJust $ mediumOwner medium
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender
@ -124,10 +124,10 @@ postCommentReplyR commentId = do
u <- runDB $ getJust $ fromJust userId
userSl <- return $ Just $ userSlug u
mediumId <- return $ commentOrigin comment
((res, commentWidget), enctype) <- runFormPost $ commentForm userId userSl mediumId (Just commentId)
((res, _), _) <- runFormPost $ commentForm userId userSl mediumId (Just commentId)
case res of
FormSuccess temp -> do
cId <- runDB $ insert temp
_ <- runDB $ insert temp
--send mail to parent author
parent <- runDB $ getJust $ fromJust $ commentParent temp
parAuth <- runDB $ getJust $ fromJust $ commentAuthor parent
@ -209,7 +209,7 @@ postCommentDeleteR commentId = do
Just "confirm" -> do
-- delete comment children
childEnts <- runDB $ selectList [CommentParent ==. (Just commentId)] []
mapM (\ent -> runDB $ delete $ entityKey ent) childEnts
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) childEnts
-- delete comment itself
runDB $ delete commentId
-- outro

6
Handler/MediumSettings.hs
View file

@ -24,10 +24,10 @@ postMediumSettingsR mediumId = do
checkRes <- mediumCheck mediumId
case checkRes of
Right medium -> do
((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium
((result, _), _) <- runFormPost $ mediumSettingsForm medium
case result of
FormSuccess temp -> do
mId <- runDB $ update mediumId
_ <- runDB $ update mediumId
[ MediumTitle =. mediumTitle temp
, MediumDescription =. mediumDescription temp
, MediumTags =. mediumTags temp
@ -75,7 +75,7 @@ postMediumDeleteR mediumId = do
Just "confirm" -> do
-- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
-- delete references first
albumId <- return $ mediumAlbum medium
album <- runDB $ getJust albumId

2
Handler/NewAlbum.hs
View file

@ -25,7 +25,7 @@ postNewAlbumR = do
case msu of
Just tempUserId -> do
userId <- return $ getUserIdFromText tempUserId
((result, albumWidget), enctype) <- runFormPost (albumForm userId)
((result, _), _) <- runFormPost (albumForm userId)
case result of
FormSuccess album -> do
-- Put album in Database

2
Handler/Profile.hs
View file

@ -37,7 +37,7 @@ getUserR :: Text -> Handler Html
getUserR ownerName = do
tempOwner <- runDB $ selectFirst [UserName ==. ownerName] []
case tempOwner of
Just (Entity ownerId owner) ->
Just (Entity ownerId _) ->
getProfileR ownerId
Nothing -> do
setMessage "This user does not exist"

7
Handler/ProfileDelete.hs
View file

@ -3,7 +3,6 @@ module Handler.ProfileDelete where
import Import
import Handler.Commons
import qualified Data.Text as T
import Data.Maybe
import qualified Data.List as L
import System.Directory
import System.FilePath
@ -29,12 +28,12 @@ postProfileDeleteR userId = do
case confirm of
Just "confirm" -> do
albumList <- return $ userAlbums user
mapM (\albumId -> do
_ <- mapM (\albumId -> do
album <- runDB $ getJust albumId
mediaList <- return $ albumContent album
mapM (\med -> do
_ <- mapM (\med -> do
commEnts <- runDB $ selectList [CommentOrigin ==. med] []
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
medium <- runDB $ getJust med
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)

2
Handler/ProfileSettings.hs
View file

@ -21,7 +21,7 @@ postProfileSettingsR userId = do
checkRes <- profileCheck userId
case checkRes of
Right user -> do
((result, profileSettingsWidget), enctype) <- runFormPost $ profileSettingsForm user
((result, _), _) <- runFormPost $ profileSettingsForm user
case result of
FormSuccess temp -> do
runDB $ update userId [

6
Handler/Reactivate.hs
View file

@ -13,7 +13,7 @@ getReactivateR = do
postReactivateR :: Handler Html
postReactivateR = do
((result, reactivateWidget), enctype) <- runFormPost reactivateForm
((result, _), _) <- runFormPost reactivateForm
case result of
FormSuccess temp -> do
users <- runDB $ selectList [UserEmail ==. temp] []
@ -21,10 +21,10 @@ postReactivateR = do
True -> do
userTokens <- foldM (\userTokens (Entity userId user) -> do
token <- liftIO $ generateString
tId <- runDB $ insert $ Token (encodeUtf8 token) "activate" (Just userId)
_ <- runDB $ insert $ Token (encodeUtf8 token) "activate" (Just userId)
return $ (user, token) : userTokens
) [] users
sent <- foldM (\sent (user, token) ->
_ <- foldM (\sent (user, token) ->
case sent of
False ->
return False

4
Handler/Signup.hs
View file

@ -53,8 +53,8 @@ postSignupR = do
[]
False
activatorText <- liftIO generateString
aId <- runDB $ insert $ Activator activatorText newUser
tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing
_ <- runDB $ insert $ Activator activatorText newUser
_ <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing
activateLink <- ($ ActivateR activatorText) <$> getUrlRender
sendMail (userEmail newUser) "Please activate your account!" $
[shamlet|

1
Handler/Tag.hs
View file

@ -2,7 +2,6 @@ module Handler.Tag where
import Import
import qualified Data.Text as T
import Data.Maybe
getTagR :: Text -> Handler Html
getTagR tag = do

20
Handler/Upload.hs
View file

@ -5,14 +5,8 @@ import Data.Time
import Data.Maybe
import qualified Data.Text as T
import qualified System.FilePath as FP
import qualified Filesystem.Path as FSP
import Filesystem.Path.CurrentOS
import Graphics.ImageMagick.MagickWand
import Control.Monad.Trans.Resource
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Helper
data TempMedium = TempMedium
{ tempMediumTitle :: Text
@ -44,7 +38,7 @@ postUploadR = do
case msu of
Just tempUserId -> do
userId <- lift $ pure $ getUserIdFromText tempUserId
((result, uploadWidget), enctype) <- runFormPost (uploadForm userId)
((result, _), _) <- runFormPost (uploadForm userId)
case result of
FormSuccess temp -> do
fil <- return $ tempMediumFile temp
@ -88,8 +82,6 @@ getDirectUploadR albumId = do
case tempAlbum of -- does the requested album exist
Just album -> do
ownerId <- return $ albumOwner album
owner <- runDB $ getJust ownerId
ownerName <- return $ userName owner
msu <- lookupSession "userId"
case msu of -- is anybody logged in
Just tempUserId -> do
@ -117,8 +109,6 @@ postDirectUploadR albumId = do
case tempAlbum of -- does the album exist
Just album -> do
ownerId <- return $ albumOwner album
owner <- runDB $ getJust ownerId
ownerName <- return $ userName owner
msu <- lookupSession "userId"
case msu of -- is anybody logged in
Just tempUserId -> do
@ -126,7 +116,7 @@ postDirectUploadR albumId = do
presence <- return $ (userId == ownerId) || (userId `elem` (albumShares album))
case presence of -- is the logged in user the owner or is the album shared with him
True -> do
((result, dUploadWidget), enctype) <- runFormPost (dUploadForm userId albumId)
((result, _), _) <- runFormPost (dUploadForm userId albumId)
case result of
FormSuccess temp -> do
fil <- return $ tempMediumFile temp
@ -134,8 +124,8 @@ postDirectUploadR albumId = do
case mime `elem` acceptedTypes of
True -> do
albRef <- runDB $ getJust (tempMediumAlbum temp)
ownerId <- return $ albumOwner albRef
path <- writeOnDrive fil ownerId albumId
refOwnerId <- return $ albumOwner albRef
path <- writeOnDrive fil refOwnerId albumId
thumbPath <- generateThumb path ownerId albumId
medium <- return $ Medium
(tempMediumTitle temp)
@ -182,7 +172,7 @@ generateThumb path userId albumId = do
w1 <- getImageWidth w
h1 <- getImageHeight w
h2 <- return 220
w2 <- return $ floor (((fromIntegral w1) / (fromIntegral h1)) * (fromIntegral h2))
w2 <- return $ floor (((fromIntegral w1) / (fromIntegral h1)) * (fromIntegral h2) :: Double)
resizeImage w w2 h2 lanczosFilter 1
setImageCompressionQuality w 95
writeImage w (Just (decodeString newPath))

11
Helper.hs
View file

@ -4,23 +4,16 @@ import Prelude
import Yesod.Static
import Model
import Control.Applicative
import Control.Monad.Trans.Class
import Data.Maybe
import Data.Either
import Data.List
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BC
import qualified Data.Text as T
import Data.Time
import Data.Char
import Database.Persist
import Database.Persist.Types
import System.FilePath
import System.Random
import System.Locale
import Yesod.Persist.Core
import Yesod.Core.Types
import Yesod
import Numeric (readHex, showHex)
import Network.Mail.Mime
@ -77,7 +70,7 @@ tagField = Field
False -> return $ Right $ Just $ removeItem "" $ T.splitOn " " x
True -> return $ Right $ Nothing
_ -> return $ Left $ error "unexpected tag list"
, fieldView = \idAttr nameAttr val eResult isReq ->
, fieldView = \idAttr nameAttr _ eResult _ ->
[whamlet|<input id=#{idAttr} type="text" name=#{nameAttr} value=#{either id (T.intercalate " ") eResult}>|]
, fieldEnctype = UrlEncoded
}
@ -95,7 +88,7 @@ userField users = Field
True -> return $ Left $ error "Invalid username list"
True -> return $ Right $ Just $ []
_ -> return $ Left $ error "unexpected username list"
, fieldView = \idAttr nameAttr val eResult isReq ->
, fieldView = \idAttr nameAttr _ eResult _ ->
[whamlet|<input id=#{idAttr} type="text" name=#{nameAttr} value=#{either id (getUsersFromResult users) eResult}>|]
, fieldEnctype = UrlEncoded
}

10
Model.hs
View file

@ -2,17 +2,7 @@ module Model where
import ClassyPrelude.Yesod
import Yesod.Markdown (Markdown)
import Data.Text (Text)
import Database.Persist.Quasi
import Database.Persist
import Database.Persist.TH
import Data.Typeable (Typeable)
import Data.Eq (Eq)
import Data.Time (UTCTime)
import Data.ByteString
import Data.Bool
import Data.Int
import Text.Show (Show)
import qualified System.FilePath as FP
-- You can define all of your database entities in the entities file.

7
Settings/StaticFiles.hs
View file

@ -1,12 +1,7 @@
module Settings.StaticFiles where
import Prelude (IO)
import Yesod.Static (staticFiles)
import qualified Yesod.Static as Static
import Settings (appStaticDir, compileTimeAppSettings)
import Settings.Development
import Language.Haskell.TH (Q, Exp, Name)
import Data.Default (def)
-- | use this to create your static file serving site
-- staticSite :: IO Static.Static
@ -17,7 +12,7 @@ import Data.Default (def)
-- giving you compile-time verification that referenced files exist.
-- Warning: any files added to your static directory during run-time can't be
-- accessed this way. You'll have to use their FilePath or URL to access them.
staticFiles (appStaticDir compileTimeAppSettings)
Static.staticFiles (appStaticDir compileTimeAppSettings)
-- combineSettings :: CombineSettings
-- combineSettings = def

2
templates/default-layout.hamlet
View file

@ -3,7 +3,7 @@
<ul id="user-nav">
<li>
<a href=@{HomeR}>Home
$maybe userId <- msu
$maybe _ <- msu
Logged in as <a href=@{UserR username}>#{slug}<br>
<li>
<a href=@{LogoutR}>Logout

2
templates/medium.hamlet
View file

@ -38,7 +38,7 @@ $else
<a href=@{CommentReplyR commentId}>Reply to this comment
$if userId == (commentAuthor comment)
<a href=@{CommentDeleteR commentId}>Delete this comment
$forall (Entity replyId reply) <- replies
$forall (Entity _ reply) <- replies
$if commentParent reply == Just commentId
<div #comment class="reply">
<a href=@{ProfileR $ fromJust $ commentAuthor reply}>#{fromJust $ commentAuthorSlug reply}</a> wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}: