Bump base version and allow for some library changes
Getty Ritter
4 years ago
| 18 | 18 |
default-extensions: OverloadedStrings,
|
| 19 | 19 |
ScopedTypeVariables
|
| 20 | 20 |
ghc-options: -Wall
|
| 21 | |
build-depends: base >=4.7 && <4.9,
|
| 22 | |
Spock,
|
| 21 |
build-depends: base >=4.7 && <5,
|
| 22 |
Spock >=0.10,
|
| 23 | 23 |
lucid,
|
| 24 | 24 |
sqlite-simple,
|
| 25 | 25 |
text,
|
| 8 | 8 |
import Network.Wai.Middleware.Static (staticPolicy, hasPrefix)
|
| 9 | 9 |
import System.Environment (lookupEnv)
|
| 10 | 10 |
import Web.Spock
|
| 11 |
import Web.Spock.Config
|
| 11 | 12 |
|
| 12 | 13 |
import Render
|
| 13 | 14 |
import Types
|
| 14 | 15 |
|
| 15 | |
respondWith :: [Entry] -> ActionCtxT ctx IO ()
|
| 16 |
respondWith :: MonadIO m => [Entry] -> ActionCtxT ctx m ()
|
| 16 | 17 |
respondWith es = do
|
| 17 | 18 |
pref <- preferredFormat
|
| 18 | 19 |
case pref of
|
| 19 | 20 |
PrefJSON -> json es
|
| 20 | 21 |
_ -> html (rPage (rEntries es))
|
| 21 | 22 |
|
| 22 | |
db :: DB a -> ActionCtxT Connection IO a
|
| 23 |
db :: MonadIO m => DB a -> ActionCtxT Connection m a
|
| 23 | 24 |
db mote = do
|
| 24 | 25 |
conn <- getContext
|
| 25 | 26 |
liftIO (mote conn)
|
| 26 | 27 |
|
| 27 | |
unwrap :: Maybe a -> (a -> ActionCtxT ctx IO ()) -> ActionCtxT ctx IO ()
|
| 28 |
unwrap :: MonadIO m => Maybe a -> (a -> ActionCtxT ctx m ()) -> ActionCtxT ctx m ()
|
| 28 | 29 |
unwrap Nothing _ = setStatus status404
|
| 29 | 30 |
unwrap (Just x) f = f x
|
| 30 | 31 |
|
|
| 33 | 34 |
dbLoc <- maybe "test.db" id `fmap` lookupEnv "DB_LOC"
|
| 34 | 35 |
port <- maybe 8080 read `fmap` lookupEnv "PORT"
|
| 35 | 36 |
conn <- open dbLoc
|
| 36 | |
runSpock port $ spockT id $ prehook (return conn) $ do
|
| 37 |
spockCfg <- defaultSpockCfg () PCNoDatabase ()
|
| 38 |
runSpock port $ spock spockCfg $ prehook (return conn) $ do
|
| 37 | 39 |
middleware $ staticPolicy (mempty <> hasPrefix "static")
|
| 38 | 40 |
|
| 39 | 41 |
get root $ do
|
| 1 |
{-# LANGUAGE GADTs #-}
|
| 2 |
|
| 1 | 3 |
module Markup where
|
| 2 | 4 |
|
| 3 | 5 |
import Data.List (intersperse)
|
|
| 6 | 8 |
import qualified Data.Text as T
|
| 7 | 9 |
import Lucid
|
| 8 | 10 |
import Text.Megaparsec
|
| 9 | |
import Text.Megaparsec.Text
|
| 11 |
import Text.Megaparsec.Char
|
| 10 | 12 |
|
| 11 | 13 |
data Chunk
|
| 12 | 14 |
= Bold Text
|
|
| 30 | 32 |
Left _ -> [Chunk t]
|
| 31 | 33 |
Right cs -> cs
|
| 32 | 34 |
|
| 33 | |
parseF :: Parser [Chunk]
|
| 35 |
parseF :: (Stream s, Token s ~ Char) => Parsec () s [Chunk]
|
| 34 | 36 |
parseF = many go
|
| 35 | 37 |
where go = Bold <$> delim '*'
|
| 36 | 38 |
<|> Italic <$> delim '_'
|
| 37 | 39 |
<|> Code <$> delim '`'
|
| 38 | 40 |
<|> Strike <$> delim '~'
|
| 39 | 41 |
<|> (Chunk . T.pack) <$> pChunk
|
| 40 | |
delim :: Char -> Parser Text
|
| 41 | 42 |
delim c = (T.pack . (<> " ")) <$>
|
| 42 | |
(char c *> manyTill anyChar (try (char c >> space)))
|
| 43 |
(char c *> manyTill asciiChar (try (char c >> space)))
|
| 43 | 44 |
pChunk = some (noneOf ("*_`~" :: String))
|
| 44 | 45 |
|
| 45 | 46 |
build :: [Chunk] -> Html ()
|