diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## v1.0.0.1 + +- Few small fixes to make sure tests build with recent versions of GHC. + [#22](https://github.com/cdepillabout/servant-static-th/pull/22). + Thanks [@blackheaven](https://github.com/blackheaven)! + ## v1.0.0.0 - Serve any files called `index.html` on the root `/` as well as the path diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,7 +3,6 @@ ================== [![Build Status](https://github.com/cdepillabout/servant-static-th/workflows/CI/badge.svg)](https://github.com/cdepillabout/servant-static-th/actions) -[![Build Status](https://secure.travis-ci.org/cdepillabout/servant-static-th.svg)](http://travis-ci.org/cdepillabout/servant-static-th) [![Hackage](https://img.shields.io/hackage/v/servant-static-th.svg)](https://hackage.haskell.org/package/servant-static-th) [![Stackage LTS](http://stackage.org/package/servant-static-th/badge/lts)](http://stackage.org/lts/package/servant-static-th) [![Stackage Nightly](http://stackage.org/package/servant-static-th/badge/nightly)](http://stackage.org/nightly/package/servant-static-th) diff --git a/servant-static-th.cabal b/servant-static-th.cabal --- a/servant-static-th.cabal +++ b/servant-static-th.cabal @@ -1,5 +1,5 @@ name: servant-static-th -version: 1.0.0.0 +version: 1.0.0.1 synopsis: Embed a directory of static files in your Servant server description: Please see . homepage: https://github.com/cdepillabout/servant-static-th @@ -30,7 +30,7 @@ , Servant.Static.TH.Internal.Mime , Servant.Static.TH.Internal.Server , Servant.Static.TH.Internal.Util - build-depends: base >= 4.8 && < 5 + build-depends: base >= 4.15 && < 5 , blaze-html , bytestring , containers @@ -64,15 +64,21 @@ else buildable: False -test-suite servant-static-th-doctest - type: exitcode-stdio-1.0 - main-is: DocTest.hs - hs-source-dirs: test - build-depends: base - , doctest - , Glob - default-language: Haskell2010 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N +-- TODO: By default, recent versions of cabal don't run tests in +-- an environment that would allow doctests to work. This needs +-- to be updated to use a library like cabal-doctest, but there +-- are also various problems with that: +-- https://github.com/cdepillabout/pretty-simple/issues/82#issuecomment-2387289781 +-- test-suite servant-static-th-doctest +-- type: exitcode-stdio-1.0 +-- main-is: DocTest.hs +-- hs-source-dirs: test +-- build-depends: base +-- , doctest +-- , Glob +-- , servant-static-th +-- default-language: Haskell2010 +-- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N test-suite servant-static-th-test type: exitcode-stdio-1.0 @@ -88,6 +94,7 @@ , bytestring , directory , filepath + , hspec , hspec-wai , tasty , tasty-hspec diff --git a/src/Servant/Static/TH/Internal/Api.hs b/src/Servant/Static/TH/Internal/Api.hs --- a/src/Servant/Static/TH/Internal/Api.hs +++ b/src/Servant/Static/TH/Internal/Api.hs @@ -5,7 +5,6 @@ module Servant.Static.TH.Internal.Api where -import Data.Foldable (foldl1) import Data.List.NonEmpty (NonEmpty) import Language.Haskell.TH (Dec, Q, Type, appT, litT, mkName, @@ -22,14 +21,16 @@ addDependentFile filePath MimeTypeInfo mimeT respT _ <- extensionToMimeTypeInfoEx filePath let fileName = takeFileName filePath - let fileNameLitT = litT $ strTyLit fileName + let fileNameLitT :: Q Type + fileNameLitT = litT $ strTyLit fileName case fileName of -- We special-case files called "index.html" and generate a type that serves on both -- the root, and under the path "index.html". "index.html" -> [t|Get '[$(mimeT)] $(respT) :<|> $(fileNameLitT) :> Get '[$(mimeT)] $(respT)|] _ -> [t|$(fileNameLitT) :> Get '[$(mimeT)] $(respT)|] fileTreeToApiType (FileTreeDir filePath fileTrees) = - let fileNameLitT = litT $ strTyLit $ takeFileName filePath + let fileNameLitT :: Q Type + fileNameLitT = litT $ strTyLit $ takeFileName filePath in [t|$(fileNameLitT) :> $(combineWithServantOrT nonEmptyApiTypesQ)|] where nonEmptyApiTypesQ :: NonEmpty (Q Type) diff --git a/src/Servant/Static/TH/Internal/FileTree.hs b/src/Servant/Static/TH/Internal/FileTree.hs --- a/src/Servant/Static/TH/Internal/FileTree.hs +++ b/src/Servant/Static/TH/Internal/FileTree.hs @@ -18,7 +18,6 @@ import Data.List (sort) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Maybe (catMaybes) -import Data.Monoid ((<>)) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.FilePath (()) diff --git a/src/Servant/Static/TH/Internal/Mime.hs b/src/Servant/Static/TH/Internal/Mime.hs --- a/src/Servant/Static/TH/Internal/Mime.hs +++ b/src/Servant/Static/TH/Internal/Mime.hs @@ -27,7 +27,6 @@ import qualified Data.ByteString.Lazy as LByteString import Data.Map (Map) import qualified Data.Map as Map -import Data.Monoid ((<>)) import Data.Proxy (Proxy) import Data.Text (pack, unpack) import Data.Text.Encoding (decodeUtf8With, encodeUtf8) @@ -76,7 +75,8 @@ utf8ByteStringToExp :: ByteString -> Q Exp utf8ByteStringToExp byteString = - let stringExp = stringE . unpack $ decodeUtf8With lenientDecode byteString + let stringExp :: Q Exp + stringExp = stringE . unpack $ decodeUtf8With lenientDecode byteString packedExp = appE (varE 'pack) stringExp byteStringExp = appE (varE 'encodeUtf8) packedExp in appE (varE 'pure) byteStringExp diff --git a/src/Servant/Static/TH/Internal/Server.hs b/src/Servant/Static/TH/Internal/Server.hs --- a/src/Servant/Static/TH/Internal/Server.hs +++ b/src/Servant/Static/TH/Internal/Server.hs @@ -4,12 +4,11 @@ module Servant.Static.TH.Internal.Server where -import Data.Foldable (foldl1) -import Data.List.NonEmpty (NonEmpty((:|))) +import Data.List.NonEmpty (NonEmpty) import Language.Haskell.TH (Dec, Exp, Q, appE, clause, conT, funD, mkName, normalB, runIO, sigD) -import Language.Haskell.TH.Syntax (addDependentFile) +import Language.Haskell.TH.Syntax (Type, addDependentFile) import Servant.API ((:<|>)((:<|>))) import Servant.Server (ServerT) import System.FilePath (takeFileName) @@ -126,6 +125,7 @@ -> Q [Dec] createServerDec apiName serverName templateDir = let funcName = mkName serverName + sigTypeQ :: Q Type sigTypeQ = [t|forall m. Applicative m => ServerT $(conT (mkName apiName)) m|] signatureQ = sigD funcName sigTypeQ diff --git a/test/DocTest.hs b/test/DocTest.hs deleted file mode 100644 --- a/test/DocTest.hs +++ /dev/null @@ -1,40 +0,0 @@ - -module Main (main) where - -import Prelude - -import Data.Monoid ((<>)) -import System.FilePath.Glob (glob) -import Test.DocTest (doctest) - -main :: IO () -main = glob "src/**/*.hs" >>= doDocTest - -doDocTest :: [String] -> IO () -doDocTest options = doctest $ options <> ghcExtensions - -ghcExtensions :: [String] -ghcExtensions = - [ - -- "-XConstraintKinds" - -- , "-XDataKinds" - "-XDeriveDataTypeable" - , "-XDeriveGeneric" - -- , "-XEmptyDataDecls" - , "-XFlexibleContexts" - -- , "-XFlexibleInstances" - -- , "-XGADTs" - -- , "-XGeneralizedNewtypeDeriving" - -- , "-XInstanceSigs" - -- , "-XMultiParamTypeClasses" - -- , "-XNoImplicitPrelude" - , "-XOverloadedStrings" - -- , "-XPolyKinds" - -- , "-XRankNTypes" - -- , "-XRecordWildCards" - , "-XScopedTypeVariables" - -- , "-XStandaloneDeriving" - -- , "-XTupleSections" - -- , "-XTypeFamilies" - -- , "-XTypeOperators" - ] diff --git a/test/Spec/ServerSpec.hs b/test/Spec/ServerSpec.hs --- a/test/Spec/ServerSpec.hs +++ b/test/Spec/ServerSpec.hs @@ -8,11 +8,12 @@ import Data.Proxy (Proxy(Proxy)) import Network.Wai (Application) import Servant.Server (serve) +import Test.Hspec (it) import Test.Hspec.Wai (ResponseMatcher(matchHeaders), (<:>), get, shouldRespondWith, with) import Test.Tasty (TestTree) -import Test.Tasty.Hspec (testSpec, it) +import Test.Tasty.Hspec (testSpec) import Servant.Static.TH (createApiAndServerDecs)