# joefiorini / error.txt Last active July 22, 2014

### SSH clone URL

You can clone with HTTPS or SSH.

View error.txt
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 main.hs:136:7: Couldn't match expected type Data.Text.Internal.Lazy.Text' with actual type StringType m1' The type variable m1' is ambiguous Possible fix: add a type signature that fixes these type variable(s) In the second argument of ($)', namely template "Home" () (genElement (Nothing, fromStringLit "div") [] [asChild ((genElement (Nothing, fromStringLit "h1") [] [asChild (fromStringLit "Welcome to the Happstack CMS!")])), asChild ((genElement (Nothing, fromStringLit "p") [] [asChild (fromStringLit "This is a demo CMS written in Happstack. Cool stuff, eh?")])), asChild ((genElement (Nothing, fromStringLit "a") [asAttr (fromStringLit "href" := fromStringLit "/announcements")] [asChild (fromStringLit "Announcements")]))])' In the expression: ok <$> toResponse $template "Home" () (genElement (Nothing, fromStringLit "div") [] [asChild ((genElement (Nothing, fromStringLit "h1") [] [asChild (fromStringLit "Welcome to the Happstack CMS!")])), asChild ((genElement (Nothing, fromStringLit "p") [] [asChild (fromStringLit "This is a demo CMS written in Happstack. Cool stuff, eh?")])), asChild ((genElement (Nothing, fromStringLit "a") [asAttr (fromStringLit "href" := fromStringLit "/announcements")] [asChild (fromStringLit "Announcements")]))]) In an equation for homePage': homePage = ok <$> toResponse $template "Home" () (genElement (Nothing, fromStringLit "div") [] [asChild ((genElement (Nothing, fromStringLit "h1") [] [asChild (fromStringLit "Welcome to the Happstack CMS!")])), asChild ((genElement (Nothing, fromStringLit "p") [] [asChild (fromStringLit "This is a demo CMS written in Happstack. Cool stuff, eh?")])), asChild ((genElement (Nothing, fromStringLit "a") [asAttr (fromStringLit "href" := fromStringLit "/announcements")] [asChild (fromStringLit "Announcements")]))]) main.hs:148:20: Couldn't match expected type Data.Text.Internal.Lazy.Text' with actual type StringType m0' The type variable m0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) In the expression: defaultTemplate "Announcements" () (genElement (Nothing, fromStringLit "div") [] [asChild ((genElement (Nothing, fromStringLit "p") [] [asChild (fromStringLit "\"There are no announcements in the system\"")])), asChild ((genElement (Nothing, fromStringLit "form") [asAttr (fromStringLit "method" := fromStringLit "post"), asAttr (fromStringLit "action" := fromStringLit "/new")] [asChild ((genElement (Nothing, fromStringLit "button") [...] [...]))]))]) In a case alternative: [] -> defaultTemplate "Announcements" () (genElement (Nothing, fromStringLit "div") [] [asChild ((genElement (Nothing, fromStringLit "p") [] [asChild (fromStringLit "\"There are no announcements in the system\"")])), asChild ((genElement (Nothing, fromStringLit "form") [asAttr (fromStringLit "method" := fromStringLit "post"), ....] [asChild ((genElement ... ... ...))]))]) In the second argument of ($)', namely case announcements of { [] -> defaultTemplate "Announcements" () (genElement (Nothing, fromStringLit "div") [] [asChild ((genElement (Nothing, fromStringLit "p") [] [...])), asChild ((genElement (Nothing, fromStringLit "form") [...] [...]))]) _ -> defaultTemplate "Announcements" () (genElement (Nothing, fromStringLit "div") [] []) }' 
View error.txt
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TemplateHaskell, TypeFamilies, RecordWildCards, OverloadedStrings, ScopedTypeVariables, OverlappingInstances, NoMonomorphismRestriction #-} {-# OPTIONS_GHC -F -pgmFhsx2hs #-}   module Main where   import Control.Applicative ((<$>), optional) import Control.Monad (msum) import Control.Monad.IO.Class (liftIO) import Control.Monad.Reader (ask) import Control.Monad.State (get, put) import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text as DText import Data.Text (unpack) import Data.Data (Data, Typeable) import Data.IxSet as IxSet import Happstack.Server ( Happstack, HasRqData, Method(GET, POST), Request(rqMethod) , Response , ServerPartT(..), ServerPart, WebMonad, FilterMonad, ServerMonad , askRq, decodeBody, dir, defaultBodyPolicy, lookText , mapServerPartT, nullConf, nullDir, ok, simpleHTTP , seeOther, method , toResponse ) import Control.Exception (bracket) import Data.Monoid import HSP import HSP.Monad import Happstack.Server.HSP.HTML import Happstack.Server.XMLGenT import HSP.HTML4 import Data.Time (UTCTime) import Data.Time.Clock (getCurrentTime) import Data.Acid (AcidState, Query, Update, makeAcidic, openLocalState) import Data.Acid.Advanced (query', update') import Data.Acid.Local (createCheckpointAndClose) import Data.SafeCopy (base, deriveSafeCopy, SafeCopy) newtype ContentItemId = ContentItemId { itemId' :: Integer } deriving (Eq, Ord, Data, Show, Enum, Read, Typeable, SafeCopy) newtype ContentItemSlug = ContentItemSlug { itemSlug :: String } deriving (Eq, Ord, Data, Show, Read, Typeable, SafeCopy) data ContentItemType = Announcement | Event | Offer deriving (Eq, Ord, Show, Data, Read, Typeable)$(deriveSafeCopy 0 'base ''ContentItemType)   data ContentItem = ContentItem { itemId :: ContentItemId, itemType :: ContentItemType, title :: Text, description :: Text, slug :: Maybe ContentItemSlug, publishAt :: UTCTime, createdAt :: UTCTime, updatedAt :: UTCTime } deriving (Eq, Ord, Read, Show, Data, Typeable)   $(deriveSafeCopy 0 'base ''ContentItem) {- Need to also index by itemType, so I can query by itemType in the UI -} instance Indexable ContentItem where empty = ixSet [ ixFun$ \item -> [ itemId item ], ixFun $\item -> [ slug item ], ixFun$ \item -> [ itemType item ] ]   data ContentCollection = ContentCollection { nextContentItemId :: ContentItemId, contentItems :: IxSet ContentItem } deriving (Data, Typeable)   $(deriveSafeCopy 0 'base ''ContentCollection) initialContentState :: ContentCollection initialContentState = ContentCollection { nextContentItemId = ContentItemId 1, contentItems = IxSet.empty } newContentItem :: UTCTime -> Update ContentCollection ContentItem newContentItem pubDate = do c@ContentCollection{..} <- get let contentItem = ContentItem { itemId = nextContentItemId, title = DText.empty, description = DText.empty, slug = Nothing, publishAt = pubDate, itemType = Announcement, createdAt = pubDate, updatedAt = pubDate } put$ c { nextContentItemId = succ nextContentItemId, contentItems = IxSet.insert contentItem contentItems } return contentItem   allAnnouncements :: Query ContentCollection [ContentItem] allAnnouncements = do ContentCollection{..} <- ask let items' = IxSet.toList $contentItems @= Announcement return items'$(makeAcidic ''ContentCollection [ 'newContentItem , 'allAnnouncements ]) main :: IO () main = do bracket (openLocalState initialContentState) (createCheckpointAndClose) (\acid -> simpleHTTP nullConf (myApp acid))   myApp :: AcidState ContentCollection -> ServerPart Response myApp acid = msum [ dir "announcements" $announcements acid, dir "new"$ newAnnouncement acid, homePage ]   template = defaultTemplate   homePage :: ServerPart Response homePage = ok <$> toResponse$ template "Home" ()

Welcome to the Happstack CMS!

This is a demo CMS written in Happstack. Cool stuff, eh?

Announcements
announcements :: AcidState ContentCollection -> ServerPart Response announcements acid = do announcements <- query' acid (AllAnnouncements) ok <$> toResponse$ case announcements of [] -> defaultTemplate "Announcements" ()

"There are no announcements in the system"

_ -> defaultTemplate "Announcements" ()
-- H.ol $mapM_ announcement' announcements -- where -- announcement' ContentItem{..} = -- H.h3 (H.toHtml$ show title)   newAnnouncement :: AcidState ContentCollection -> ServerPart Response newAnnouncement acid = do method POST now <- liftIO $getCurrentTime item <- update' acid (NewContentItem now) let url = "/edit?id=" ++ show (itemId'$ itemId item) seeOther url (toResponse ()) 
{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts,
GeneralizedNewtypeDeriving, MultiParamTypeClasses,
{-# OPTIONS_GHC -F -pgmFhsx2hs #-}

module Main where

import Control.Applicative ((<$>), optional) import Control.Monad (msum) import Control.Monad.IO.Class (liftIO) import Control.Monad.Reader (ask) import Control.Monad.State (get, put) import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text as DText import Data.Text (unpack) import qualified Data.Text.Lazy as TL import Data.Data (Data, Typeable) import Data.IxSet as IxSet import Happstack.Server ( Happstack, HasRqData, Method(GET, POST), Request(rqMethod) , Response , ServerPartT(..), ServerPart, WebMonad, FilterMonad, ServerMonad , askRq, decodeBody, dir, defaultBodyPolicy, lookText , mapServerPartT, nullConf, nullDir, ok, simpleHTTP , seeOther, method , toResponse ) import Control.Exception (bracket) import Data.Monoid import HSP import HSP.Monad import HSP.ServerPartT import Happstack.Server.HSP.HTML import Happstack.Server.XMLGenT import HSP.HTML4 import Data.Time (UTCTime) import Data.Time.Clock (getCurrentTime) import Data.Acid (AcidState, Query, Update, makeAcidic, openLocalState) import Data.Acid.Advanced (query', update') import Data.Acid.Local (createCheckpointAndClose) import Data.SafeCopy (base, deriveSafeCopy, SafeCopy) newtype ContentItemId = ContentItemId { itemId' :: Integer } deriving (Eq, Ord, Data, Show, Enum, Read, Typeable) deriveSafeCopy 0 'base ''ContentItemId newtype ContentItemSlug = ContentItemSlug { itemSlug :: String } deriving (Eq, Ord, Data, Show, Read, Typeable) deriveSafeCopy 0 'base ''ContentItemSlug data ContentItemType = Announcement | Event | Offer deriving (Eq, Ord, Show, Data, Read, Typeable)$(deriveSafeCopy 0 'base ''ContentItemType)

data ContentItem = ContentItem {
itemId :: ContentItemId,
itemType :: ContentItemType,
title :: Text,
description :: Text,
slug :: Maybe ContentItemSlug,
publishAt :: UTCTime,
createdAt :: UTCTime,
updatedAt :: UTCTime
} deriving (Eq, Ord, Read, Show, Data, Typeable)

$(deriveSafeCopy 0 'base ''ContentItem) {- Need to also index by itemType, so I can query by itemType in the UI -} instance Indexable ContentItem where empty = ixSet [ ixFun$ \item -> [ itemId item ],
ixFun $\item -> [ slug item ], ixFun$ \item -> [ itemType item ]
]

data ContentCollection = ContentCollection {
nextContentItemId :: ContentItemId,
contentItems :: IxSet ContentItem
} deriving (Data, Typeable)

$(deriveSafeCopy 0 'base ''ContentCollection) initialContentState :: ContentCollection initialContentState = ContentCollection { nextContentItemId = ContentItemId 1, contentItems = IxSet.empty } newContentItem :: UTCTime -> Update ContentCollection ContentItem newContentItem pubDate = do c@ContentCollection{..} <- get let contentItem = ContentItem { itemId = nextContentItemId, title = DText.empty, description = DText.empty, slug = Nothing, publishAt = pubDate, itemType = Announcement, createdAt = pubDate, updatedAt = pubDate } put$ c { nextContentItemId = succ nextContentItemId,
contentItems = IxSet.insert contentItem contentItems }
return contentItem

allAnnouncements :: Query ContentCollection [ContentItem]
allAnnouncements = do
let items' = IxSet.toList $contentItems @= Announcement return items'$(makeAcidic ''ContentCollection
[ 'newContentItem
, 'allAnnouncements
])
main :: IO ()
main = do bracket (openLocalState initialContentState)
(createCheckpointAndClose)
(\acid ->
simpleHTTP nullConf (myApp acid))

myApp :: AcidState ContentCollection -> ServerPart Response
myApp acid = msum
[ -- dir "announcements" $announcements acid, -- dir "new"$ newAnnouncement acid,
homePage ]

template :: ( EmbedAsChild (ServerPartT IO) headers
, EmbedAsChild (ServerPartT IO) body
) =>
TL.Text
-> body
-> ServerPartT IO XML
template = defaultTemplate

homePage :: ServerPart Response
homePage =
ok . toResponse =<< template "Home"
()
(<div>
<h1>Welcome to the Happstack CMS!</h1>
<p>This is a demo CMS written in Happstack. Cool stuff, eh?</p>
<a href="/announcements">Announcements</a>
</div>)

announcements :: AcidState ContentCollection -> ServerPart Response
announcements acid = do
announcements <- query' acid (AllAnnouncements)
ok . toResponse =<<
case announcements of
[] -> template "Announcements"
()
<div>
<p>"There are no announcements in the system"</p>
<form method="post" action="/new">
<button type="submit">New Announcement</button>
</form>
</div>
_ -> template "Announcements" () <div></div>
-- H.ol $mapM_ announcement' announcements -- where -- announcement' ContentItem{..} = -- H.h3 (H.toHtml$ show title)

newAnnouncement :: AcidState ContentCollection -> ServerPart Response
newAnnouncement acid = do
method POST
now <- liftIO $getCurrentTime item <- update' acid (NewContentItem now) let url = "/edit?id=" ++ show (itemId'$ itemId item)
seeOther url (toResponse ())
`