Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Switch to GitLab Next
Sign in / Register
Toggle navigation
Open sidebar
Ibnu Daru Aji
Cirkeltrek
Commits
f3d72f0a
Commit
f3d72f0a
authored
Apr 21, 2018
by
Ibnu Daru Aji
Browse files
Added development mode.
parent
fe886b3b
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
84 additions
and
16 deletions
+84
-16
.gitignore
.gitignore
+1
-1
Cirkeltrek.cabal
Cirkeltrek.cabal
+3
-1
app/Main.hs
app/Main.hs
+3
-3
app/devel.hs
app/devel.hs
+5
-0
package.yaml
package.yaml
+1
-0
src/Application.hs
src/Application.hs
+37
-3
src/Foundation.hs
src/Foundation.hs
+28
-7
src/Model.hs
src/Model.hs
+6
-1
No files found.
.gitignore
View file @
f3d72f0a
...
...
@@ -19,4 +19,4 @@ cabal.sandbox.config
*~
\#*
TAGS
Cirkeltrek.cabal
\ No newline at end of file
*.cabal
Cirkeltrek.cabal
View file @
f3d72f0a
...
...
@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash:
ac82d237ef701a1dbc867cec1e99eb5d5bb8ad007265c41dc76968c2c000666f
-- hash:
fd7a7246f0613d88e47e6f2e5ce057afc082ed5215a32651d8e7e52850604853
name: Cirkeltrek
version: 0.0.0
...
...
@@ -26,6 +26,7 @@ library
, base
, classy-prelude
, classy-prelude-yesod
, data-default
, esqueleto
, fast-logger
, file-embed
...
...
@@ -63,6 +64,7 @@ executable Cirkeltrek
, base
, classy-prelude
, classy-prelude-yesod
, data-default
, esqueleto
, fast-logger
, file-embed
...
...
app/Main.hs
View file @
f3d72f0a
import
Application
(
newMain
)
-- for YesodDispatch instance
import
Foundation
import
Yesod.Core
import
Application
(
newMain
)
import
Foundation
import
Yesod.Core
main
::
IO
()
main
=
newMain
app/devel.hs
0 → 100644
View file @
f3d72f0a
{-# LANGUAGE PackageImports #-}
import
"Cirkeltrek"
Application
(
develMain
)
import
Prelude
(
IO
)
main
=
develMain
package.yaml
View file @
f3d72f0a
...
...
@@ -6,6 +6,7 @@ dependencies:
-
aeson
-
classy-prelude
-
classy-prelude-yesod
-
data-default
-
esqueleto
-
fast-logger
-
file-embed
...
...
src/Application.hs
View file @
f3d72f0a
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
...
...
@@ -7,22 +8,27 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module
Application
where
import
ClassyPrelude.Yesod
import
Control.Monad
import
Control.Monad.Logger
import
Database.Persist.Postgresql
import
Foundation
import
Language.Haskell.TH.Syntax
import
Network.HTTP.Client.TLS
import
Network.Wai
(
Middleware
)
import
Network.Wai.Handler.Warp
import
Network.Wai.Middleware.RequestLogger
import
System.Log.FastLogger
import
Yesod.Core
import
Yesod.Core.Types
(
loggerSet
)
import
Yesod.Default.Config2
import
Yesod.Static
import
Home
import
Model
import
Settings
(
ApplicationSettings
(
..
),
configSettingsYmlValue
)
import
Settings
(
ApplicationSettings
(
..
),
configSettingsYmlValue
)
mkYesodDispatch
"App"
resourcesApp
...
...
@@ -63,10 +69,22 @@ warpSettings app =
(
toLogStr
$
"Exception from warp: "
++
show
exception
))
defaultSettings
makeLogware
::
App
->
IO
Middleware
makeLogware
app
=
do
mkRequestLogger
def
{
outputFormat
=
if
appDetailedRequestLogging
$
appSettings
app
then
Detailed
True
else
Apache
FromFallback
,
destination
=
Logger
$
loggerSet
$
appLogger
app
}
makeApplication
::
App
->
IO
Application
makeApplication
app
=
do
logware
<-
makeLogware
app
commonapp
<-
toWaiApp
app
return
$
defaultMiddlewaresNoLogging
commonapp
return
$
logware
$
defaultMiddlewaresNoLogging
commonapp
newMain
::
IO
()
newMain
=
do
...
...
@@ -74,3 +92,19 @@ newMain = do
app
<-
makeFoundation
settings
commonapp
<-
makeApplication
app
runSettings
(
warpSettings
app
)
commonapp
-- DEVEL
getAppSettings
::
IO
ApplicationSettings
getAppSettings
=
loadYamlSettings
[
configSettingsYml
]
[]
useEnv
getAppDev
::
IO
(
Settings
,
Application
)
getAppDev
=
do
settings
<-
getAppSettings
found
<-
makeFoundation
settings
warpsettings
<-
getDevSettings
$
warpSettings
found
app
<-
makeApplication
found
return
(
warpsettings
,
app
)
develMain
::
IO
()
develMain
=
develMainHelper
getAppDev
src/Foundation.hs
View file @
f3d72f0a
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module
Foundation
where
...
...
@@ -13,11 +14,15 @@ import ClassyPrelude.Yesod
import
Database.Persist.Sql
import
Network.HTTP.Client
import
Text.Hamlet
import
Yesod.Auth
import
Yesod.Auth.HashDB
import
Yesod.Auth.Message
import
Yesod.Core
import
Yesod.Core.Types
import
Yesod.Form
import
Yesod.Static
import
Model
import
Settings
data
App
=
App
...
...
@@ -53,7 +58,7 @@ instance Yesod App where
$maybe route <- mcurrentroute
<p> You're at #{show route}.
$nothing
<p>
Y
ou're lost.
<p>
Apparently y
ou're lost.
^{widget}
|]
withUrlRenderer
$
(
hamletFile
"templates/wrapper.hamlet"
)
...
...
@@ -64,3 +69,19 @@ instance YesodPersist App where
master
<-
getYesod
runSqlPool
action
$
appConnectionPool
master
instance
RenderMessage
App
FormMessage
where
renderMessage
_
_
=
defaultFormMessage
instance
YesodAuth
App
where
type
AuthId
App
=
UsersId
loginDest
_
=
HomeR
logoutDest
_
=
HomeR
redirectToReferer
_
=
False
authPlugins
_
=
[
authHashDB
(
Just
.
UniqueUsername
)]
authenticate
creds
=
liftHandler
$
runDB
$
do
x
<-
getBy
$
UniqueUsername
$
credsIdent
creds
case
x
of
Nothing
->
return
$
UserError
InvalidLogin
Just
(
Entity
uid
_
)
->
return
$
Authenticated
uid
instance
YesodAuthPersist
App
src/Model.hs
View file @
f3d72f0a
...
...
@@ -4,7 +4,7 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitP
arams
#-}
{-# LANGUAGE NoImplicitP
relude
#-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
...
...
@@ -13,6 +13,7 @@ module Model where
import
ClassyPrelude.Yesod
import
Database.Persist.TH
import
Yesod.Auth.HashDB
import
Model.Grouping
...
...
@@ -94,3 +95,7 @@ share
zappedBy UsersId Maybe
deriving Show Eq
|]
instance
HashDBUser
Users
where
userPasswordHash
=
usersPassword
setPasswordHash
h
u
=
u
{
usersPassword
=
Just
h
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment