shave off unused modules
This commit is contained in:
parent
2f926c6a71
commit
d460c73bd0
@ -33,11 +33,11 @@ executable breve
|
|||||||
other-extensions: RecordWildCards, DeriveGeneric,
|
other-extensions: RecordWildCards, DeriveGeneric,
|
||||||
DataKinds, KindSignatures, TypeOperators
|
DataKinds, KindSignatures, TypeOperators
|
||||||
build-depends: base >=4.8 && <5.0,
|
build-depends: base >=4.8 && <5.0,
|
||||||
warp, warp-tls, tls, blaze-html, blaze-markup,
|
warp, warp-tls, tls, blaze-html,
|
||||||
servant-server, servant, servant-blaze,
|
servant, servant-server, servant-blaze,
|
||||||
wai, wai-extra, streaming-commons, http-api-data,
|
wai, wai-extra, streaming-commons, http-api-data,
|
||||||
transformers, mtl,
|
|
||||||
text, aeson, bytestring, binary,
|
mtl, text, aeson, bytestring, binary,
|
||||||
hashtables, cryptohash, random,
|
hashtables, cryptohash, random,
|
||||||
configurator, directory
|
configurator, directory
|
||||||
ghc-options: -threaded -O2
|
ghc-options: -threaded -O2
|
||||||
|
@ -15,7 +15,6 @@ import Breve.UrlTable
|
|||||||
import Views
|
import Views
|
||||||
|
|
||||||
-- Misc
|
-- Misc
|
||||||
import Data.Monoid
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
|
|
||||||
@ -26,18 +25,18 @@ import GHC.Generics (Generic)
|
|||||||
|
|
||||||
-- HTML replies
|
-- HTML replies
|
||||||
import Text.Blaze.Html5 (Html)
|
import Text.Blaze.Html5 (Html)
|
||||||
import Text.Blaze.Renderer.Utf8 (renderMarkup)
|
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
|
||||||
|
|
||||||
-- API definition
|
-- API definition
|
||||||
import Servant
|
import Servant
|
||||||
import Servant.HTML.Blaze (HTML)
|
import Servant.HTML.Blaze (HTML)
|
||||||
import Web.FormUrlEncoded (FromForm(..), parseUnique)
|
import Web.FormUrlEncoded (FromForm(..), parseUnique)
|
||||||
import GHC.TypeNats (Nat)
|
|
||||||
|
|
||||||
|
|
||||||
-- * Types
|
-- * Types
|
||||||
|
|
||||||
-- | API successful reply
|
-- | API successful reply
|
||||||
|
--
|
||||||
-- This is the reply returned by the JSON API
|
-- This is the reply returned by the JSON API
|
||||||
-- handler when the url has been shortned
|
-- handler when the url has been shortned
|
||||||
-- successfully.
|
-- successfully.
|
||||||
@ -49,7 +48,7 @@ data ApiReply = ApiReply
|
|||||||
|
|
||||||
instance ToJSON ApiReply
|
instance ToJSON ApiReply
|
||||||
|
|
||||||
-- | This type is just a wrapped around a 'Text'
|
-- | This type is just a wrapper around a 'Text'
|
||||||
-- value. It's used to create a 'FromForm' instance
|
-- value. It's used to create a 'FromForm' instance
|
||||||
-- for a 'Url'.
|
-- for a 'Url'.
|
||||||
newtype UrlForm = UrlForm Text
|
newtype UrlForm = UrlForm Text
|
||||||
@ -92,15 +91,16 @@ type App =
|
|||||||
-- +----------+------+----------------------+
|
-- +----------+------+----------------------+
|
||||||
-- | path | type | description |
|
-- | path | type | description |
|
||||||
-- +==========+======+======================+
|
-- +==========+======+======================+
|
||||||
-- | / | POST | upload a new url |
|
-- | /api | POST | upload a new url |
|
||||||
-- +----------+------+----------------------+
|
-- +----------+------+----------------------+
|
||||||
type API =
|
type API =
|
||||||
"api" :> ReqBody '[FormUrlEncoded] UrlForm :> Post '[JSON] ApiReply
|
"api" :> ReqBody '[FormUrlEncoded] UrlForm :> Post '[JSON] ApiReply
|
||||||
|
|
||||||
-- | Breve application
|
-- | Breve application
|
||||||
--
|
breve :: FilePath -- ^ static assets path
|
||||||
-- Breve takes as parameters the bind url and the urls table
|
-> Url -- ^ bind url
|
||||||
breve :: FilePath -> Url -> UrlTable -> Application
|
-> UrlTable -- ^ url hashtable
|
||||||
|
-> Application
|
||||||
breve static url table = serve (Proxy :: Proxy Breve) (breveServer static url table)
|
breve static url table = serve (Proxy :: Proxy Breve) (breveServer static url table)
|
||||||
|
|
||||||
-- | Empty application
|
-- | Empty application
|
||||||
@ -135,7 +135,7 @@ resolver table name = do
|
|||||||
url <- liftIO (extract table name)
|
url <- liftIO (extract table name)
|
||||||
case url of
|
case url of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
throwError $ err404 { errBody = renderMarkup (message "404: not found") }
|
throwError $ err404 { errBody = renderHtml (message "404: not found") }
|
||||||
Just url -> do
|
Just url -> do
|
||||||
logStr ("Resolved " <> name <> " -> " <> url)
|
logStr ("Resolved " <> name <> " -> " <> url)
|
||||||
pure (addHeader url NoContent)
|
pure (addHeader url NoContent)
|
||||||
|
@ -7,7 +7,7 @@ run the Breve webserver.
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
-- Breve modules
|
-- Breve modules
|
||||||
import Application
|
import Application (breve, emptyApp)
|
||||||
import Breve.Settings
|
import Breve.Settings
|
||||||
import Breve.UrlTable
|
import Breve.UrlTable
|
||||||
import Paths_breve (getDataFileName)
|
import Paths_breve (getDataFileName)
|
||||||
|
Loading…
Reference in New Issue
Block a user