mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

v4.2: Bump SafeCopy versions of types

Browse source
This commit is contained in:
Vincent Ambo 2014-08-22 15:56:03 +02:00
parent 2c0eecc9aa
commit 56609f1f59
No known key found for this signature in database
GPG key ID: 66F505681DB8F43B
4 changed files with 15 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
TazBlog.cabal
View file

@ -1,5 +1,5 @@
Name: TazBlog Name: TazBlog
Version: 4.1 Version: 4.2
Synopsis: Tazjin's Blog Synopsis: Tazjin's Blog
License: MIT License: MIT
License-file: LICENSE License-file: LICENSE

26
src/BlogDB.hs
View file

@ -26,7 +26,7 @@ import qualified Data.Text as Text
newtype EntryId = EntryId { unEntryId :: Integer } newtype EntryId = EntryId { unEntryId :: Integer }
deriving (Eq, Ord, Data, Enum, Typeable) deriving (Eq, Ord, Data, Enum, Typeable)
$(deriveSafeCopy 0 'base ''EntryId) $(deriveSafeCopy 2 'base ''EntryId)
instance Show EntryId where instance Show EntryId where
show = show . unEntryId show = show . unEntryId
@ -47,11 +47,10 @@ data Entry = Entry {
title :: Text, title :: Text,
btext :: Text, btext :: Text,
mtext :: Text, mtext :: Text,
edate :: UTCTime, edate :: UTCTime
tags :: [Text]
} deriving (Eq, Ord, Show, Data, Typeable) } deriving (Eq, Ord, Show, Data, Typeable)
$(deriveSafeCopy 0 'base ''Entry) $(deriveSafeCopy 2 'base ''Entry)
-- ixSet requires different datatypes for field indexes, so let's define some -- ixSet requires different datatypes for field indexes, so let's define some
newtype Author = Author Text deriving (Eq, Ord, Data, Typeable) newtype Author = Author Text deriving (Eq, Ord, Data, Typeable)
@ -64,15 +63,15 @@ newtype SDate = SDate UTCTime deriving (Eq, Ord, Data, Typeable)
newtype Username = Username Text deriving (Eq, Ord, Data, Typeable) newtype Username = Username Text deriving (Eq, Ord, Data, Typeable)
newtype SessionID = SessionID Text deriving (Eq, Ord, Data, Typeable) newtype SessionID = SessionID Text deriving (Eq, Ord, Data, Typeable)
$(deriveSafeCopy 0 'base ''Author) $(deriveSafeCopy 2 'base ''Author)
$(deriveSafeCopy 0 'base ''Title) $(deriveSafeCopy 2 'base ''Title)
$(deriveSafeCopy 0 'base ''BText) $(deriveSafeCopy 2 'base ''BText)
$(deriveSafeCopy 0 'base ''MText) $(deriveSafeCopy 2 'base ''MText)
$(deriveSafeCopy 0 'base ''Tag) $(deriveSafeCopy 2 'base ''Tag)
$(deriveSafeCopy 0 'base ''EDate) $(deriveSafeCopy 2 'base ''EDate)
$(deriveSafeCopy 0 'base ''SDate) $(deriveSafeCopy 2 'base ''SDate)
$(deriveSafeCopy 0 'base ''Username) $(deriveSafeCopy 2 'base ''Username)
$(deriveSafeCopy 0 'base ''SessionID) $(deriveSafeCopy 2 'base ''SessionID)
instance Indexable Entry where instance Indexable Entry where
empty = ixSet [ ixFun $ \e -> [ entryId e] empty = ixSet [ ixFun $ \e -> [ entryId e]
@ -82,7 +81,6 @@ instance Indexable Entry where
, ixFun $ \e -> [ BText $ btext e] , ixFun $ \e -> [ BText $ btext e]
, ixFun $ \e -> [ MText $ mtext e] , ixFun $ \e -> [ MText $ mtext e]
, ixFun $ \e -> [ EDate $ edate e] , ixFun $ \e -> [ EDate $ edate e]
, ixFun $ \e -> map Tag (tags e)
] ]
data User = User { data User = User {

2
src/Locales.hs
View file

@ -14,7 +14,7 @@ import BlogDB (BlogLang (..))
data BlogError = NotFound | DBError data BlogError = NotFound | DBError
version = "4.1" version = "4.2"
allLang = [EN, DE] allLang = [EN, DE]

3
src/Server.hs
View file

@ -19,7 +19,7 @@ import Happstack.Server.Compression
import System.Locale (defaultTimeLocale) import System.Locale (defaultTimeLocale)
import Blog import Blog
import BlogDB hiding (addComment, deleteComment, updateEntry) import BlogDB hiding (updateEntry)
import Locales import Locales
import RSS import RSS
@ -140,7 +140,6 @@ postEntry acid = do
<*> pure nBtext <*> pure nBtext
<*> pure nMtext <*> pure nMtext
<*> pure now <*> pure now
<*> pure [] -- NYI
update' acid (InsertEntry nEntry) update' acid (InsertEntry nEntry)
seeOther ("/" ++ lang ++ "/" ++ show eId) (toResponse()) seeOther ("/" ++ lang ++ "/" ++ show eId) (toResponse())
where where