diff --git a/.gitignore b/.gitignore index 163de4bd..a66f2a0e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ **/*/dist +dist-newstyle /bin /lib /share diff --git a/cabal.project b/cabal.project new file mode 100644 index 00000000..c6e53e56 --- /dev/null +++ b/cabal.project @@ -0,0 +1,7 @@ +packages: + servant/ + servant-client/ + servant-docs/ + servant-foreign/ + servant-server/ + doc/tutorial/ diff --git a/doc/tutorial/tutorial.cabal b/doc/tutorial/tutorial.cabal index 989cc292..2a9c8d64 100644 --- a/doc/tutorial/tutorial.cabal +++ b/doc/tutorial/tutorial.cabal @@ -47,6 +47,7 @@ library , http-client default-language: Haskell2010 ghc-options: -Wall -pgmL markdown-unlit + build-tool-depends: markdown-unlit:markdown-unlit test-suite spec type: exitcode-stdio-1.0 diff --git a/servant-server/Setup.hs b/servant-server/Setup.hs deleted file mode 100644 index 44671092..00000000 --- a/servant-server/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/servant-server/Setup.lhs b/servant-server/Setup.lhs new file mode 100644 index 00000000..0f89abf8 --- /dev/null +++ b/servant-server/Setup.lhs @@ -0,0 +1,165 @@ +\begin{code} +{-# LANGUAGE CPP #-} +#ifndef MIN_VERSION_Cabal +#define MIN_VERSION_Cabal(x,y,z) 0 +#endif +#ifndef MIN_VERSION_directory +#define MIN_VERSION_directory(x,y,z) 0 +#endif +#if MIN_VERSION_Cabal(1,24,0) +#define InstalledPackageId UnitId +#endif +module Main (main) where + +import Control.Monad ( when ) +import Data.List ( nub ) +import Distribution.Package ( InstalledPackageId ) +import Distribution.Package ( PackageId, Package (..), packageVersion ) +import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) +import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) +import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) +import Distribution.Simple.BuildPaths ( autogenModulesDir ) +import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag) +import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler ) +import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..)) +import Distribution.Text ( display , simpleParse ) +import System.FilePath ( () ) + +#if MIN_VERSION_Cabal(1,25,0) +import Distribution.Simple.BuildPaths ( autogenComponentModulesDir ) +#endif + +#if MIN_VERSION_directory(1,2,2) +import System.Directory (makeAbsolute) +#else +import System.Directory (getCurrentDirectory) +import System.FilePath (isAbsolute) + +makeAbsolute :: FilePath -> IO FilePath +makeAbsolute p | isAbsolute p = return p + | otherwise = do + cwd <- getCurrentDirectory + return $ cwd p +#endif + +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule flags pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + } + +generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule flags pkg lbi = do + let verbosity = fromFlag (buildVerbosity flags) + let distPref = fromFlag (buildDistPref flags) + + -- Package DBs + let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref "package.conf.inplace" ] + let dbFlags = "-hide-all-packages" : packageDbArgs dbStack + + withLibLBI pkg lbi $ \lib libcfg -> do + let libBI = libBuildInfo lib + + -- modules + let modules = exposedModules lib ++ otherModules libBI + -- it seems that doctest is happy to take in module names, not actual files! + let module_sources = modules + + -- We need the directory with library's cabal_macros.h! +#if MIN_VERSION_Cabal(1,25,0) + let libAutogenDir = autogenComponentModulesDir lbi libcfg +#else + let libAutogenDir = autogenModulesDir lbi +#endif + + -- Lib sources and includes + iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI + includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI + + -- CPP includes, i.e. include cabal_macros.h + let cppFlags = map ("-optP"++) $ + [ "-include", libAutogenDir ++ "/cabal_macros.h" ] + ++ cppOptions libBI + + -- Actually we need to check whether testName suite == "doctests" + -- pending https://github.com/haskell/cabal/pull/4229 getting into GHC HEAD tree + withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == "doctests") $ do + + -- get and create autogen dir +#if MIN_VERSION_Cabal(1,25,0) + let testAutogenDir = autogenComponentModulesDir lbi suitecfg +#else + let testAutogenDir = autogenModulesDir lbi +#endif + createDirectoryIfMissingVerbose verbosity True testAutogenDir + + -- write autogen'd file + rewriteFile (testAutogenDir "Build_doctests.hs") $ unlines + [ "module Build_doctests where" + , "" + -- -package-id etc. flags + , "pkgs :: [String]" + , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg) + , "" + , "flags :: [String]" + , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags) + , "" + , "module_sources :: [String]" + , "module_sources = " ++ show (map display module_sources) + ] + where + -- we do this check in Setup, as then doctests don't need to depend on Cabal + isOldCompiler = maybe False id $ do + a <- simpleParse $ showCompilerId $ compiler lbi + b <- simpleParse "7.5" + return $ packageVersion (a :: PackageId) < b + + formatDeps = map formatOne + formatOne (installedPkgId, pkgId) + -- The problem is how different cabal executables handle package databases + -- when doctests depend on the library + | packageId pkg == pkgId = "-package=" ++ display pkgId + | otherwise = "-package-id=" ++ display installedPkgId + + -- From Distribution.Simple.Program.GHC + packageDbArgs :: [PackageDB] -> [String] + packageDbArgs | isOldCompiler = packageDbArgsConf + | otherwise = packageDbArgsDb + + -- GHC <7.6 uses '-package-conf' instead of '-package-db'. + packageDbArgsConf :: [PackageDB] -> [String] + packageDbArgsConf dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs + (GlobalPackageDB:dbs) -> ("-no-user-package-conf") + : concatMap specific dbs + _ -> ierror + where + specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ] + specific _ = ierror + ierror = error $ "internal error: unexpected package db stack: " + ++ show dbstack + + -- GHC >= 7.6 uses the '-package-db' flag. See + -- https://ghc.haskell.org/trac/ghc/ticket/5977. + packageDbArgsDb :: [PackageDB] -> [String] + -- special cases to make arguments prettier in common scenarios + packageDbArgsDb dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) + | all isSpecific dbs -> concatMap single dbs + (GlobalPackageDB:dbs) + | all isSpecific dbs -> "-no-user-package-db" + : concatMap single dbs + dbs -> "-clear-package-db" + : concatMap single dbs + where + single (SpecificPackageDB db) = [ "-package-db=" ++ db ] + single GlobalPackageDB = [ "-global-package-db" ] + single UserPackageDB = [ "-user-package-db" ] + isSpecific (SpecificPackageDB _) = True + isSpecific _ = False + +testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] +testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys + +\end{code} diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 9179cf67..c8e7e6df 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -19,7 +19,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors category: Web -build-type: Simple +build-type: Custom cabal-version: >=1.10 tested-with: GHC >= 7.8 extra-source-files: @@ -31,6 +31,9 @@ source-repository head type: git location: http://github.com/haskell-servant/servant.git +custom-setup + setup-depends: + Cabal >=1.14, base, filepath, directory library exposed-modules: @@ -144,7 +147,7 @@ test-suite doctests , directory , filepath type: exitcode-stdio-1.0 - main-is: test/Doctests.hs + main-is: test/doctests.hs buildable: True default-language: Haskell2010 ghc-options: -Wall -threaded diff --git a/servant-server/test/Doctests.hs b/servant-server/test/Doctests.hs deleted file mode 100644 index 663f8768..00000000 --- a/servant-server/test/Doctests.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Main where - -import Data.List (isPrefixOf) -import System.Directory -import System.FilePath -import System.FilePath.Find -import Test.DocTest - -main :: IO () -main = do - files <- find always (extension ==? ".hs") "src" - mCabalMacrosFile <- getCabalMacrosFile - doctest $ "-isrc" : "-Iinclude" : - (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++ - "-XOverloadedStrings" : - "-XFlexibleInstances" : - "-XMultiParamTypeClasses" : - "-XDataKinds" : - "-XTypeOperators" : - files - -getCabalMacrosFile :: IO (Maybe FilePath) -getCabalMacrosFile = do - exists <- doesDirectoryExist "dist" - if exists - then do - contents <- getDirectoryContents "dist" - let rest = "build" "autogen" "cabal_macros.h" - whenExists $ case filter ("dist-sandbox-" `isPrefixOf`) contents of - [x] -> "dist" x rest - [] -> "dist" rest - xs -> error $ "ran doctests with multiple dist/dist-sandbox-xxxxx's: \n" - ++ show xs ++ "\nTry cabal clean" - else return Nothing - where - whenExists :: FilePath -> IO (Maybe FilePath) - whenExists file = do - exists <- doesFileExist file - return $ if exists - then Just file - else Nothing diff --git a/servant-server/test/doctests.hsc b/servant-server/test/doctests.hsc new file mode 100644 index 00000000..8bf2033b --- /dev/null +++ b/servant-server/test/doctests.hsc @@ -0,0 +1,61 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +----------------------------------------------------------------------------- +-- | +-- Module : Main (doctests) +-- Copyright : (C) 2012-14 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +-- This module provides doctests for a project based on the actual versions +-- of the packages it was built with. It requires a corresponding Setup.lhs +-- to be added to the project +----------------------------------------------------------------------------- +module Main where + +import Build_doctests (flags, pkgs, module_sources) +import Data.Foldable (traverse_) +import Test.DocTest + +##if defined(mingw32_HOST_OS) +##if defined(i386_HOST_ARCH) +##define USE_CP +import Control.Applicative +import Control.Exception +import Foreign.C.Types +foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool +foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt +##elif defined(x86_64_HOST_ARCH) +##define USE_CP +import Control.Applicative +import Control.Exception +import Foreign.C.Types +foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool +foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt +##endif +##endif + +-- | Run in a modified codepage where we can print UTF-8 values on Windows. +withUnicode :: IO a -> IO a +##ifdef USE_CP +withUnicode m = do + cp <- c_GetConsoleCP + (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp +##else +withUnicode m = m +##endif + +main :: IO () +main = withUnicode $ do + traverse_ putStrLn args + doctest args + where + args = + "-XOverloadedStrings" : + "-XFlexibleInstances" : + "-XMultiParamTypeClasses" : + "-XDataKinds" : + "-XTypeOperators" : + flags ++ pkgs ++ module_sources diff --git a/servant/Setup.hs b/servant/Setup.hs deleted file mode 100644 index 44671092..00000000 --- a/servant/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/servant/Setup.lhs b/servant/Setup.lhs new file mode 100644 index 00000000..0f89abf8 --- /dev/null +++ b/servant/Setup.lhs @@ -0,0 +1,165 @@ +\begin{code} +{-# LANGUAGE CPP #-} +#ifndef MIN_VERSION_Cabal +#define MIN_VERSION_Cabal(x,y,z) 0 +#endif +#ifndef MIN_VERSION_directory +#define MIN_VERSION_directory(x,y,z) 0 +#endif +#if MIN_VERSION_Cabal(1,24,0) +#define InstalledPackageId UnitId +#endif +module Main (main) where + +import Control.Monad ( when ) +import Data.List ( nub ) +import Distribution.Package ( InstalledPackageId ) +import Distribution.Package ( PackageId, Package (..), packageVersion ) +import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) +import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) +import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) +import Distribution.Simple.BuildPaths ( autogenModulesDir ) +import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag) +import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler ) +import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..)) +import Distribution.Text ( display , simpleParse ) +import System.FilePath ( () ) + +#if MIN_VERSION_Cabal(1,25,0) +import Distribution.Simple.BuildPaths ( autogenComponentModulesDir ) +#endif + +#if MIN_VERSION_directory(1,2,2) +import System.Directory (makeAbsolute) +#else +import System.Directory (getCurrentDirectory) +import System.FilePath (isAbsolute) + +makeAbsolute :: FilePath -> IO FilePath +makeAbsolute p | isAbsolute p = return p + | otherwise = do + cwd <- getCurrentDirectory + return $ cwd p +#endif + +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule flags pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + } + +generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule flags pkg lbi = do + let verbosity = fromFlag (buildVerbosity flags) + let distPref = fromFlag (buildDistPref flags) + + -- Package DBs + let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref "package.conf.inplace" ] + let dbFlags = "-hide-all-packages" : packageDbArgs dbStack + + withLibLBI pkg lbi $ \lib libcfg -> do + let libBI = libBuildInfo lib + + -- modules + let modules = exposedModules lib ++ otherModules libBI + -- it seems that doctest is happy to take in module names, not actual files! + let module_sources = modules + + -- We need the directory with library's cabal_macros.h! +#if MIN_VERSION_Cabal(1,25,0) + let libAutogenDir = autogenComponentModulesDir lbi libcfg +#else + let libAutogenDir = autogenModulesDir lbi +#endif + + -- Lib sources and includes + iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI + includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI + + -- CPP includes, i.e. include cabal_macros.h + let cppFlags = map ("-optP"++) $ + [ "-include", libAutogenDir ++ "/cabal_macros.h" ] + ++ cppOptions libBI + + -- Actually we need to check whether testName suite == "doctests" + -- pending https://github.com/haskell/cabal/pull/4229 getting into GHC HEAD tree + withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == "doctests") $ do + + -- get and create autogen dir +#if MIN_VERSION_Cabal(1,25,0) + let testAutogenDir = autogenComponentModulesDir lbi suitecfg +#else + let testAutogenDir = autogenModulesDir lbi +#endif + createDirectoryIfMissingVerbose verbosity True testAutogenDir + + -- write autogen'd file + rewriteFile (testAutogenDir "Build_doctests.hs") $ unlines + [ "module Build_doctests where" + , "" + -- -package-id etc. flags + , "pkgs :: [String]" + , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg) + , "" + , "flags :: [String]" + , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags) + , "" + , "module_sources :: [String]" + , "module_sources = " ++ show (map display module_sources) + ] + where + -- we do this check in Setup, as then doctests don't need to depend on Cabal + isOldCompiler = maybe False id $ do + a <- simpleParse $ showCompilerId $ compiler lbi + b <- simpleParse "7.5" + return $ packageVersion (a :: PackageId) < b + + formatDeps = map formatOne + formatOne (installedPkgId, pkgId) + -- The problem is how different cabal executables handle package databases + -- when doctests depend on the library + | packageId pkg == pkgId = "-package=" ++ display pkgId + | otherwise = "-package-id=" ++ display installedPkgId + + -- From Distribution.Simple.Program.GHC + packageDbArgs :: [PackageDB] -> [String] + packageDbArgs | isOldCompiler = packageDbArgsConf + | otherwise = packageDbArgsDb + + -- GHC <7.6 uses '-package-conf' instead of '-package-db'. + packageDbArgsConf :: [PackageDB] -> [String] + packageDbArgsConf dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs + (GlobalPackageDB:dbs) -> ("-no-user-package-conf") + : concatMap specific dbs + _ -> ierror + where + specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ] + specific _ = ierror + ierror = error $ "internal error: unexpected package db stack: " + ++ show dbstack + + -- GHC >= 7.6 uses the '-package-db' flag. See + -- https://ghc.haskell.org/trac/ghc/ticket/5977. + packageDbArgsDb :: [PackageDB] -> [String] + -- special cases to make arguments prettier in common scenarios + packageDbArgsDb dbstack = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) + | all isSpecific dbs -> concatMap single dbs + (GlobalPackageDB:dbs) + | all isSpecific dbs -> "-no-user-package-db" + : concatMap single dbs + dbs -> "-clear-package-db" + : concatMap single dbs + where + single (SpecificPackageDB db) = [ "-package-db=" ++ db ] + single GlobalPackageDB = [ "-global-package-db" ] + single UserPackageDB = [ "-user-package-db" ] + isSpecific (SpecificPackageDB _) = True + isSpecific _ = False + +testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] +testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys + +\end{code} diff --git a/servant/servant.cabal b/servant/servant.cabal index 2304391e..c760e00e 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -15,7 +15,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors category: Web -build-type: Simple +build-type: Custom cabal-version: >=1.10 tested-with: GHC >= 7.8 extra-source-files: @@ -25,6 +25,10 @@ source-repository head type: git location: http://github.com/haskell-servant/servant.git +custom-setup + setup-depends: + Cabal >=1.14, base, filepath, directory + library exposed-modules: Servant.API @@ -134,8 +138,9 @@ test-suite doctests , directory , filepath type: exitcode-stdio-1.0 - main-is: test/Doctests.hs + main-is: test/doctests.hs buildable: True default-language: Haskell2010 ghc-options: -Wall -threaded + build-tools: hsc2hs include-dirs: include diff --git a/servant/test/Doctests.hs b/servant/test/Doctests.hs deleted file mode 100644 index d9116823..00000000 --- a/servant/test/Doctests.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Main where - -import Data.List (isPrefixOf) -import System.Directory -import System.FilePath -import System.FilePath.Find -import Test.DocTest - -main :: IO () -main = do - files <- find always (extension ==? ".hs") "src" - tfiles <- find always (extension ==? ".hs") "test/Servant" - mCabalMacrosFile <- getCabalMacrosFile - doctest $ "-isrc" : "-Iinclude" : - (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++ - "-XOverloadedStrings" : - "-XFlexibleInstances" : - "-XMultiParamTypeClasses" : - (files ++ tfiles) - -getCabalMacrosFile :: IO (Maybe FilePath) -getCabalMacrosFile = do - exists <- doesDirectoryExist "dist" - if exists - then do - contents <- getDirectoryContents "dist" - let rest = "build" "autogen" "cabal_macros.h" - whenExists $ case filter ("dist-sandbox-" `isPrefixOf`) contents of - [x] -> "dist" x rest - [] -> "dist" rest - xs -> error $ "ran doctests with multiple dist/dist-sandbox-xxxxx's: \n" - ++ show xs ++ "\nTry cabal clean" - else return Nothing - where - whenExists :: FilePath -> IO (Maybe FilePath) - whenExists file = do - exists <- doesFileExist file - return $ if exists - then Just file - else Nothing diff --git a/servant/test/doctests.hsc b/servant/test/doctests.hsc new file mode 100644 index 00000000..4956d631 --- /dev/null +++ b/servant/test/doctests.hsc @@ -0,0 +1,59 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +----------------------------------------------------------------------------- +-- | +-- Module : Main (doctests) +-- Copyright : (C) 2012-14 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +-- This module provides doctests for a project based on the actual versions +-- of the packages it was built with. It requires a corresponding Setup.lhs +-- to be added to the project +----------------------------------------------------------------------------- +module Main where + +import Build_doctests (flags, pkgs, module_sources) +import Data.Foldable (traverse_) +import Test.DocTest + +##if defined(mingw32_HOST_OS) +##if defined(i386_HOST_ARCH) +##define USE_CP +import Control.Applicative +import Control.Exception +import Foreign.C.Types +foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool +foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt +##elif defined(x86_64_HOST_ARCH) +##define USE_CP +import Control.Applicative +import Control.Exception +import Foreign.C.Types +foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool +foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt +##endif +##endif + +-- | Run in a modified codepage where we can print UTF-8 values on Windows. +withUnicode :: IO a -> IO a +##ifdef USE_CP +withUnicode m = do + cp <- c_GetConsoleCP + (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp +##else +withUnicode m = m +##endif + +main :: IO () +main = withUnicode $ do + traverse_ putStrLn args + doctest args + where + args = + "-XOverloadedStrings" : + "-XFlexibleInstances" : + "-XMultiParamTypeClasses" : + flags ++ pkgs ++ module_sources