9e216da9ef
After go1.16, go will use module mode by default, even when the repository is checked out under GOPATH or in a one-off directory. Add go.mod, go.sum to keep this repo buildable without opting out of the module mode. > go mod init github.com/mmcgrana/gobyexample > go mod tidy > go mod vendor In module mode, the 'vendor' directory is special and its contents will be actively maintained by the go command. pygments aren't the dependency the go will know about, so it will delete the contents from vendor directory. Move it to `third_party` directory now. And, vendor the blackfriday package. Note: the tutorial contents are not affected by the change in go1.16 because all the examples in this tutorial ask users to run the go command with the explicit list of files to be compiled (e.g. `go run hello-world.go` or `go build command-line-arguments.go`). When the source list is provided, the go command does not have to compute the build list and whether it's running in GOPATH mode or module mode becomes irrelevant.
210 lines
8.4 KiB
Haskell
210 lines
8.4 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, GeneralizedNewtypeDeriving
|
|
, MultiParamTypeClasses, OverloadedStrings, ScopedTypeVariables, TemplateHaskell
|
|
, TypeFamilies, FlexibleInstances #-}
|
|
module Main where
|
|
import Control.Applicative (Applicative, Alternative, (<$>))
|
|
import Control.Exception.Lifted (bracket)
|
|
import Control.Monad.Trans.Control (MonadBaseControl)
|
|
import Control.Monad (MonadPlus, mplus)
|
|
import Control.Monad.Reader (MonadReader, ReaderT(..), ask)
|
|
import Control.Monad.Trans (MonadIO(..))
|
|
import Data.Acid ( AcidState(..), EventState(..), EventResult(..)
|
|
, Query(..), QueryEvent(..), Update(..), UpdateEvent(..)
|
|
, IsAcidic(..), makeAcidic, openLocalState
|
|
)
|
|
import Data.Acid.Local ( createCheckpointAndClose
|
|
, openLocalStateFrom
|
|
)
|
|
import Data.Acid.Advanced (query', update')
|
|
import Data.Maybe (fromMaybe)
|
|
import Data.SafeCopy (SafeCopy, base, deriveSafeCopy)
|
|
import Data.Data (Data, Typeable)
|
|
import Data.Lens ((%=), (!=))
|
|
import Data.Lens.Template (makeLens)
|
|
import Data.Text.Lazy (Text)
|
|
import Happstack.Server ( Happstack, HasRqData, Method(GET, POST), Request(rqMethod)
|
|
, Response
|
|
, ServerPartT(..), WebMonad, FilterMonad, ServerMonad
|
|
, askRq, decodeBody, dir, defaultBodyPolicy, lookText
|
|
, mapServerPartT, nullConf, nullDir, ok, simpleHTTP
|
|
, toResponse
|
|
)
|
|
import Prelude hiding (head, id)
|
|
import System.FilePath ((</>))
|
|
import Text.Blaze ((!))
|
|
import Text.Blaze.Html4.Strict (body, head, html, input, form, label, p, title, toHtml)
|
|
import Text.Blaze.Html4.Strict.Attributes (action, enctype, for, id, method, name, type_, value)
|
|
class HasAcidState m st where
|
|
getAcidState :: m (AcidState st)
|
|
query :: forall event m.
|
|
( Functor m
|
|
, MonadIO m
|
|
, QueryEvent event
|
|
, HasAcidState m (EventState event)
|
|
) =>
|
|
event
|
|
-> m (EventResult event)
|
|
query event =
|
|
do as <- getAcidState
|
|
query' (as :: AcidState (EventState event)) event
|
|
update :: forall event m.
|
|
( Functor m
|
|
, MonadIO m
|
|
, UpdateEvent event
|
|
, HasAcidState m (EventState event)
|
|
) =>
|
|
event
|
|
-> m (EventResult event)
|
|
update event =
|
|
do as <- getAcidState
|
|
update' (as :: AcidState (EventState event)) event
|
|
-- | bracket the opening and close of the `AcidState` handle.
|
|
|
|
-- automatically creates a checkpoint on close
|
|
withLocalState :: (MonadBaseControl IO m, MonadIO m, IsAcidic st, Typeable st) =>
|
|
Maybe FilePath -- ^ path to state directory
|
|
-> st -- ^ initial state value
|
|
-> (AcidState st -> m a) -- ^ function which uses the `AcidState` handle
|
|
-> m a
|
|
withLocalState mPath initialState =
|
|
bracket (liftIO $ (maybe openLocalState openLocalStateFrom mPath) initialState)
|
|
(liftIO . createCheckpointAndClose)
|
|
-- State that stores a hit count
|
|
|
|
data CountState = CountState { _count :: Integer }
|
|
deriving (Eq, Ord, Data, Typeable, Show)
|
|
|
|
$(deriveSafeCopy 0 'base ''CountState)
|
|
$(makeLens ''CountState)
|
|
|
|
initialCountState :: CountState
|
|
initialCountState = CountState { _count = 0 }
|
|
|
|
incCount :: Update CountState Integer
|
|
incCount = count %= succ
|
|
|
|
$(makeAcidic ''CountState ['incCount])
|
|
-- State that stores a greeting
|
|
data GreetingState = GreetingState { _greeting :: Text }
|
|
deriving (Eq, Ord, Data, Typeable, Show)
|
|
|
|
$(deriveSafeCopy 0 'base ''GreetingState)
|
|
$(makeLens ''GreetingState)
|
|
|
|
initialGreetingState :: GreetingState
|
|
initialGreetingState = GreetingState { _greeting = "Hello" }
|
|
|
|
getGreeting :: Query GreetingState Text
|
|
getGreeting = _greeting <$> ask
|
|
|
|
setGreeting :: Text -> Update GreetingState Text
|
|
setGreeting txt = greeting != txt
|
|
|
|
$(makeAcidic ''GreetingState ['getGreeting, 'setGreeting])
|
|
data Acid = Acid { acidCountState :: AcidState CountState
|
|
, acidGreetingState :: AcidState GreetingState
|
|
}
|
|
|
|
withAcid :: Maybe FilePath -> (Acid -> IO a) -> IO a
|
|
withAcid mBasePath action =
|
|
let basePath = fromMaybe "_state" mBasePath
|
|
in withLocalState (Just $ basePath </> "count") initialCountState $ \c ->
|
|
withLocalState (Just $ basePath </> "greeting") initialGreetingState $ \g ->
|
|
action (Acid c g)
|
|
newtype App a = App { unApp :: ServerPartT (ReaderT Acid IO) a }
|
|
deriving ( Functor, Alternative, Applicative, Monad, MonadPlus, MonadIO
|
|
, HasRqData, ServerMonad ,WebMonad Response, FilterMonad Response
|
|
, Happstack, MonadReader Acid)
|
|
|
|
runApp :: Acid -> App a -> ServerPartT IO a
|
|
runApp acid (App sp) = mapServerPartT (flip runReaderT acid) sp
|
|
instance HasAcidState App CountState where
|
|
getAcidState = acidCountState <$> ask
|
|
|
|
instance HasAcidState App GreetingState where
|
|
getAcidState = acidGreetingState <$> ask
|
|
page :: App Response
|
|
page =
|
|
do nullDir
|
|
g <- greet
|
|
c <- update IncCount -- ^ a CountState event
|
|
ok $ toResponse $
|
|
html $ do
|
|
head $ do
|
|
title "acid-state demo"
|
|
body $ do
|
|
form ! action "/" ! method "POST" ! enctype "multipart/form-data" $ do
|
|
label "new message: " ! for "msg"
|
|
input ! type_ "text" ! id "msg" ! name "greeting"
|
|
input ! type_ "submit" ! value "update message"
|
|
p $ toHtml g
|
|
p $ do "This page has been loaded "
|
|
toHtml c
|
|
" time(s)."
|
|
where
|
|
greet =
|
|
do m <- rqMethod <$> askRq
|
|
case m of
|
|
POST ->
|
|
do decodeBody (defaultBodyPolicy "/tmp/" 0 1000 1000)
|
|
newGreeting <- lookText "greeting"
|
|
update (SetGreeting newGreeting) -- ^ a GreetingState event
|
|
return newGreeting
|
|
GET ->
|
|
do query GetGreeting -- ^ a GreetingState event
|
|
main :: IO ()
|
|
main =
|
|
withAcid Nothing $ \acid ->
|
|
simpleHTTP nullConf $ runApp acid page
|
|
newtype FooState = FooState { foo :: Text }
|
|
deriving (Eq, Ord, Data, Typeable, SafeCopy)
|
|
|
|
initialFooState :: FooState
|
|
initialFooState = FooState { foo = "foo" }
|
|
|
|
askFoo :: Query FooState Text
|
|
askFoo = foo <$> ask
|
|
|
|
$(makeAcidic ''FooState ['askFoo])
|
|
fooPlugin :: (Happstack m, HasAcidState m FooState) => m Response
|
|
fooPlugin =
|
|
dir "foo" $ do
|
|
txt <- query AskFoo
|
|
ok $ toResponse txt
|
|
data Acid' = Acid' { acidCountState' :: AcidState CountState
|
|
, acidGreetingState' :: AcidState GreetingState
|
|
, acidFooState' :: AcidState FooState
|
|
}
|
|
withAcid' :: Maybe FilePath -> (Acid' -> IO a) -> IO a
|
|
withAcid' mBasePath action =
|
|
let basePath = fromMaybe "_state" mBasePath
|
|
in withLocalState (Just $ basePath </> "count") initialCountState $ \c ->
|
|
withLocalState (Just $ basePath </> "greeting") initialGreetingState $ \g ->
|
|
withLocalState (Just $ basePath </> "foo") initialFooState $ \f ->
|
|
action (Acid' c g f)
|
|
newtype App' a = App' { unApp' :: ServerPartT (ReaderT Acid' IO) a }
|
|
deriving ( Functor, Alternative, Applicative, Monad, MonadPlus, MonadIO
|
|
, HasRqData, ServerMonad ,WebMonad Response, FilterMonad Response
|
|
, Happstack, MonadReader Acid')
|
|
|
|
instance HasAcidState App' FooState where
|
|
getAcidState = acidFooState' <$> ask
|
|
fooAppPlugin :: App' Response
|
|
fooAppPlugin = fooPlugin
|
|
fooReaderPlugin :: ReaderT (AcidState FooState) (ServerPartT IO) Response
|
|
fooReaderPlugin = fooPlugin
|
|
instance HasAcidState (ReaderT (AcidState FooState) (ServerPartT IO)) FooState where
|
|
getAcidState = ask
|
|
withFooPlugin :: (MonadIO m, MonadBaseControl IO m) =>
|
|
FilePath -- ^ path to state directory
|
|
-> (ServerPartT IO Response -> m a) -- ^ function that uses fooPlugin
|
|
-> m a
|
|
withFooPlugin basePath f =
|
|
do withLocalState (Just $ basePath </> "foo") initialFooState $ \fooState ->
|
|
f $ runReaderT fooReaderPlugin fooState
|
|
main' :: IO ()
|
|
main' =
|
|
withFooPlugin "_state" $ \fooPlugin' ->
|
|
withAcid Nothing $ \acid ->
|
|
simpleHTTP nullConf $ fooPlugin' `mplus` runApp acid page
|