From 0bcaa726756ab8c1a6295ad6f697b98183dd30d8 Mon Sep 17 00:00:00 2001 From: Li-yao Xia Date: Wed, 29 May 2024 23:09:40 +0200 Subject: [PATCH 1/4] Make putStrLn more atomic with line or block buffering --- src/Data/Text/IO.hs | 10 ++++++---- src/Data/Text/Internal/Fusion.hs | 32 +++++++++++++++++++++++++++++++- src/Data/Text/Lazy/IO.hs | 6 ++++-- 3 files changed, 41 insertions(+), 7 deletions(-) diff --git a/src/Data/Text/IO.hs b/src/Data/Text/IO.hs index a4569bc3d..77a9c0be5 100644 --- a/src/Data/Text/IO.hs +++ b/src/Data/Text/IO.hs @@ -51,7 +51,7 @@ import qualified Control.Exception as E import Control.Monad (liftM2, when) import Data.IORef (readIORef, writeIORef) import qualified Data.Text as T -import Data.Text.Internal.Fusion (stream) +import Data.Text.Internal.Fusion (stream, streamLn) import Data.Text.Internal.Fusion.Types (Step(..), Stream(..)) import Data.Text.Internal.IO (hGetLineWith, readChunk) import GHC.IO.Buffer (Buffer(..), BufferState(..), RawCharBuffer, CharBuffer, @@ -174,13 +174,15 @@ hGetLine = hGetLineWith T.concat -- | Write a string to a handle. hPutStr :: Handle -> Text -> IO () +hPutStr h = hPutStr' h . stream + -- This function is lifted almost verbatim from GHC.IO.Handle.Text. -hPutStr h t = do +hPutStr' :: Handle -> Stream Char -> IO () +hPutStr' h str = do (buffer_mode, nl) <- wantWritableHandle "hPutStr" h $ \h_ -> do bmode <- getSpareBuffer h_ return (bmode, haOutputNL h_) - let str = stream t case buffer_mode of (NoBuffering, _) -> hPutChars h str (LineBuffering, buf) -> writeLines h nl buf str @@ -276,7 +278,7 @@ commitBuffer hdl !raw !sz !count flush release = -- | Write a string to a handle, followed by a newline. hPutStrLn :: Handle -> Text -> IO () -hPutStrLn h t = hPutStr h t >> hPutChar h '\n' +hPutStrLn h = hPutStr' h . streamLn -- | The 'interact' function takes a function of type @Text -> Text@ -- as its argument. The entire input from the standard input device is diff --git a/src/Data/Text/Internal/Fusion.hs b/src/Data/Text/Internal/Fusion.hs index d003b60cd..b26b4aa16 100644 --- a/src/Data/Text/Internal/Fusion.hs +++ b/src/Data/Text/Internal/Fusion.hs @@ -25,6 +25,7 @@ module Data.Text.Internal.Fusion -- * Creation and elimination , stream + , streamLn , unstream , reverseStream @@ -49,7 +50,7 @@ module Data.Text.Internal.Fusion , countChar ) where -import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int, +import Prelude (Bool(..), Char, Eq(..), Maybe(..), Monad(..), Int, Num(..), Ord(..), ($), otherwise) import Data.Bits (shiftL, shiftR) @@ -98,6 +99,35 @@ stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 2) len) _ -> U8.chr4 n0 n1 n2 n3 {-# INLINE [0] stream #-} +-- | /O(n)/ @'streamLn' t = 'stream' (t <> \'\\n\')@ +-- +-- @since 2.1.2 +streamLn :: +#if defined(ASSERTS) + HasCallStack => +#endif + Text -> Stream Char +streamLn (Text arr off len) = Stream next off (betweenSize (len `shiftR` 2) (len + 1)) + where + !end = off+len + next !i + | i > end = Done + | i == end = Yield '\n' (i + 1) + | otherwise = Yield chr (i + l) + where + n0 = A.unsafeIndex arr i + n1 = A.unsafeIndex arr (i + 1) + n2 = A.unsafeIndex arr (i + 2) + n3 = A.unsafeIndex arr (i + 3) + + l = U8.utf8LengthByLeader n0 + chr = case l of + 1 -> unsafeChr8 n0 + 2 -> U8.chr2 n0 n1 + 3 -> U8.chr3 n0 n1 n2 + _ -> U8.chr4 n0 n1 n2 n3 +{-# INLINE [0] streamLn #-} + -- | /O(n)/ Converts 'Text' into a 'Stream' 'Char', but iterates -- backwards through the text. -- diff --git a/src/Data/Text/Lazy/IO.hs b/src/Data/Text/Lazy/IO.hs index 2ebd7eef3..1a24bd23c 100644 --- a/src/Data/Text/Lazy/IO.hs +++ b/src/Data/Text/Lazy/IO.hs @@ -49,7 +49,7 @@ import qualified Control.Exception as E import Control.Monad (when) import Data.IORef (readIORef) import Data.Text.Internal.IO (hGetLineWith, readChunk) -import Data.Text.Internal.Lazy (chunk, empty) +import Data.Text.Internal.Lazy (Text(..), chunk, empty) import GHC.IO.Buffer (isEmptyBuffer) import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException) import GHC.IO.Handle.Internals (augmentIOError, hClose_help, @@ -133,7 +133,9 @@ hPutStr h = mapM_ (T.hPutStr h) . L.toChunks -- | Write a string to a handle, followed by a newline. hPutStrLn :: Handle -> Text -> IO () -hPutStrLn h t = hPutStr h t >> hPutChar h '\n' +hPutStrLn h Empty = hPutChar h '\n' +hPutStrLn h (Chunk t Empty) = T.hPutStrLn h t -- print the newline after the last chunk atomically +hPutStrLn h (Chunk t ts) = T.hPutStr h t >> hPutStrLn h ts -- | The 'interact' function takes a function of type @Text -> Text@ -- as its argument. The entire input from the standard input device is From 21318ac4821b347f45335fffa6688dafc1e09602 Mon Sep 17 00:00:00 2001 From: Li-yao Xia Date: Thu, 30 May 2024 10:22:06 +0200 Subject: [PATCH 2/4] Deduplicate code of stream and streamLn --- src/Data/Text/Internal/Fusion.hs | 40 +++++++++++++------------------- 1 file changed, 16 insertions(+), 24 deletions(-) diff --git a/src/Data/Text/Internal/Fusion.hs b/src/Data/Text/Internal/Fusion.hs index b26b4aa16..866222c74 100644 --- a/src/Data/Text/Internal/Fusion.hs +++ b/src/Data/Text/Internal/Fusion.hs @@ -51,7 +51,7 @@ module Data.Text.Internal.Fusion ) where import Prelude (Bool(..), Char, Eq(..), Maybe(..), Monad(..), Int, - Num(..), Ord(..), ($), + Num(..), Ord(..), ($), (&&), otherwise) import Data.Bits (shiftL, shiftR) import Data.Text.Internal (Text(..)) @@ -79,24 +79,7 @@ stream :: HasCallStack => #endif Text -> Stream Char -stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 2) len) - where - !end = off+len - next !i - | i >= end = Done - | otherwise = Yield chr (i + l) - where - n0 = A.unsafeIndex arr i - n1 = A.unsafeIndex arr (i + 1) - n2 = A.unsafeIndex arr (i + 2) - n3 = A.unsafeIndex arr (i + 3) - - l = U8.utf8LengthByLeader n0 - chr = case l of - 1 -> unsafeChr8 n0 - 2 -> U8.chr2 n0 n1 - 3 -> U8.chr3 n0 n1 n2 - _ -> U8.chr4 n0 n1 n2 n3 +stream t = stream' t False {-# INLINE [0] stream #-} -- | /O(n)/ @'streamLn' t = 'stream' (t <> \'\\n\')@ @@ -107,13 +90,22 @@ streamLn :: HasCallStack => #endif Text -> Stream Char -streamLn (Text arr off len) = Stream next off (betweenSize (len `shiftR` 2) (len + 1)) +streamLn t = stream' t True + +-- | Shared implementation of 'stream' and 'streamLn'. +stream' :: +#if defined(ASSERTS) + HasCallStack => +#endif + Text -> Bool -> Stream Char +stream' (Text arr off len) addNl = Stream next off (betweenSize (len `shiftR` 2) maxLen) where + maxLen = if addNl then len + 1 else len !end = off+len next !i - | i > end = Done - | i == end = Yield '\n' (i + 1) - | otherwise = Yield chr (i + l) + | i < end = Yield chr (i + l) + | addNl && i == end = Yield '\n' (i + 1) + | otherwise = Done where n0 = A.unsafeIndex arr i n1 = A.unsafeIndex arr (i + 1) @@ -126,7 +118,7 @@ streamLn (Text arr off len) = Stream next off (betweenSize (len `shiftR` 2) (len 2 -> U8.chr2 n0 n1 3 -> U8.chr3 n0 n1 n2 _ -> U8.chr4 n0 n1 n2 n3 -{-# INLINE [0] streamLn #-} +{-# INLINE [0] stream' #-} -- | /O(n)/ Converts 'Text' into a 'Stream' 'Char', but iterates -- backwards through the text. From b500f08d08f05a5924d39274e92d908d80283e7a Mon Sep 17 00:00:00 2001 From: Li-yao Xia Date: Thu, 30 May 2024 10:21:50 +0200 Subject: [PATCH 3/4] Move hPutStream to Data.Text.Internal.IO --- src/Data/Text/IO.hs | 122 +++-------------------------------- src/Data/Text/Internal/IO.hs | 117 +++++++++++++++++++++++++++++++-- 2 files changed, 119 insertions(+), 120 deletions(-) diff --git a/src/Data/Text/IO.hs b/src/Data/Text/IO.hs index 77a9c0be5..3d5a4446e 100644 --- a/src/Data/Text/IO.hs +++ b/src/Data/Text/IO.hs @@ -45,24 +45,18 @@ module Data.Text.IO import Data.Text (Text) import Prelude hiding (appendFile, getContents, getLine, interact, putStr, putStrLn, readFile, writeFile) -import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout, +import System.IO (Handle, IOMode(..), openFile, stdin, stdout, withFile) import qualified Control.Exception as E import Control.Monad (liftM2, when) -import Data.IORef (readIORef, writeIORef) +import Data.IORef (readIORef) import qualified Data.Text as T import Data.Text.Internal.Fusion (stream, streamLn) -import Data.Text.Internal.Fusion.Types (Step(..), Stream(..)) -import Data.Text.Internal.IO (hGetLineWith, readChunk) -import GHC.IO.Buffer (Buffer(..), BufferState(..), RawCharBuffer, CharBuffer, - emptyBuffer, isEmptyBuffer, newCharBuffer) -import qualified GHC.IO.Buffer +import Data.Text.Internal.IO (hGetLineWith, readChunk, hPutStream) +import GHC.IO.Buffer (CharBuffer, isEmptyBuffer) import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType)) -import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle, - wantWritableHandle) -import GHC.IO.Handle.Text (commitBuffer') -import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..), - HandleType(..), Newline(..)) +import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle) +import GHC.IO.Handle.Types (BufferMode(..), Handle__(..), HandleType(..)) import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell) import System.IO.Error (isEOFError) @@ -174,111 +168,11 @@ hGetLine = hGetLineWith T.concat -- | Write a string to a handle. hPutStr :: Handle -> Text -> IO () -hPutStr h = hPutStr' h . stream - --- This function is lifted almost verbatim from GHC.IO.Handle.Text. -hPutStr' :: Handle -> Stream Char -> IO () -hPutStr' h str = do - (buffer_mode, nl) <- - wantWritableHandle "hPutStr" h $ \h_ -> do - bmode <- getSpareBuffer h_ - return (bmode, haOutputNL h_) - case buffer_mode of - (NoBuffering, _) -> hPutChars h str - (LineBuffering, buf) -> writeLines h nl buf str - (BlockBuffering _, buf) -> writeBlocks (nl == CRLF) h buf str - -hPutChars :: Handle -> Stream Char -> IO () -hPutChars h (Stream next0 s0 _len) = loop s0 - where - loop !s = case next0 s of - Done -> return () - Skip s' -> loop s' - Yield x s' -> hPutChar h x >> loop s' - --- The following functions are largely lifted from GHC.IO.Handle.Text, --- but adapted to a coinductive stream of data instead of an inductive --- list. --- --- We have several variations of more or less the same code for --- performance reasons. Splitting the original buffered write --- function into line- and block-oriented versions gave us a 2.1x --- performance improvement. Lifting out the raw/cooked newline --- handling gave a few more percent on top. - -writeLines :: Handle -> Newline -> CharBuffer -> Stream Char -> IO () -writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0 - where - outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int) - where - inner !s !n = - case next0 s of - Done -> commit n False{-no flush-} True{-release-} >> return () - Skip s' -> inner s' n - Yield x s' - | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s - | x == '\n' -> do - n' <- if nl == CRLF - then do n1 <- writeCharBuf raw len n '\r' - writeCharBuf raw len n1 '\n' - else writeCharBuf raw len n x - commit n' True{-needs flush-} False >>= outer s' - | otherwise -> writeCharBuf raw len n x >>= inner s' - commit = commitBuffer h raw len - -writeBlocks :: Bool -> Handle -> CharBuffer -> Stream Char -> IO () -writeBlocks isCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0 - where - outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int) - where - inner !s !n = - case next0 s of - Done -> commit n False{-no flush-} True{-release-} >> return () - Skip s' -> inner s' n - Yield x s' - | isCRLF && x == '\n' && n + 1 < len -> do - n1 <- writeCharBuf raw len n '\r' - writeCharBuf raw len n1 '\n' >>= inner s' - | n < len -> writeCharBuf raw len n x >>= inner s' - | otherwise -> commit n True{-needs flush-} False >>= outer s - commit = commitBuffer h raw len - --- | Only modifies the raw buffer and not the buffer attributes -writeCharBuf :: RawCharBuffer -> Int -> Int -> Char -> IO Int -writeCharBuf bufRaw bufSize n c = E.assert (n >= 0 && n < bufSize) $ - GHC.IO.Buffer.writeCharBuf bufRaw n c - --- This function is completely lifted from GHC.IO.Handle.Text. -getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer) -getSpareBuffer Handle__{haCharBuffer=ref, - haBuffers=spare_ref, - haBufferMode=mode} - = do - case mode of - NoBuffering -> return (mode, error "no buffer!") - _ -> do - bufs <- readIORef spare_ref - buf <- readIORef ref - case bufs of - BufferListCons b rest -> do - writeIORef spare_ref rest - return ( mode, emptyBuffer b (bufSize buf) WriteBuffer) - BufferListNil -> do - new_buf <- newCharBuffer (bufSize buf) WriteBuffer - return (mode, new_buf) - - --- This function is modified from GHC.Internal.IO.Handle.Text. -commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool - -> IO CharBuffer -commitBuffer hdl !raw !sz !count flush release = - wantWritableHandle "commitAndReleaseBuffer" hdl $ - commitBuffer' raw sz count flush release -{-# INLINE commitBuffer #-} +hPutStr h = hPutStream h . stream -- | Write a string to a handle, followed by a newline. hPutStrLn :: Handle -> Text -> IO () -hPutStrLn h = hPutStr' h . streamLn +hPutStrLn h = hPutStream h . streamLn -- | The 'interact' function takes a function of type @Text -> Text@ -- as its argument. The entire input from the standard input device is diff --git a/src/Data/Text/Internal/IO.hs b/src/Data/Text/Internal/IO.hs index 8a26f87b4..5c9fea8b8 100644 --- a/src/Data/Text/Internal/IO.hs +++ b/src/Data/Text/Internal/IO.hs @@ -18,6 +18,7 @@ module Data.Text.Internal.IO ( hGetLineWith , readChunk + , hPutStream ) where import qualified Control.Exception as E @@ -28,12 +29,15 @@ import Data.Text.Internal.Fusion.Types (Step(..), Stream(..)) import Data.Text.Internal.Fusion.Size (exactSize, maxSize) import Data.Text.Unsafe (inlinePerformIO) import Foreign.Storable (peekElemOff) -import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL, - bufferElems, charSize, isEmptyBuffer, readCharBuf, - withRawBuffer, writeCharBuf) -import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_) -import GHC.IO.Handle.Types (Handle__(..), Newline(..)) -import System.IO (Handle) +import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBuffer, RawCharBuffer, + bufferAdjustL, bufferElems, charSize, emptyBuffer, + isEmptyBuffer, newCharBuffer, readCharBuf, withRawBuffer, + writeCharBuf) +import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_, + wantWritableHandle) +import GHC.IO.Handle.Text (commitBuffer') +import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..), Newline(..)) +import System.IO (Handle, hPutChar) import System.IO.Error (isEOFError) import qualified Data.Text as T @@ -162,5 +166,106 @@ readChunk hh@Handle__{..} buf = do writeIORef haCharBuffer (bufferAdjustL r buf') return t +-- | Print a @Stream Char@. +hPutStream :: Handle -> Stream Char -> IO () +-- This function is lifted almost verbatim from GHC.IO.Handle.Text. +hPutStream h str = do + (buffer_mode, nl) <- + wantWritableHandle "hPutStr" h $ \h_ -> do + bmode <- getSpareBuffer h_ + return (bmode, haOutputNL h_) + case buffer_mode of + (NoBuffering, _) -> hPutChars h str + (LineBuffering, buf) -> writeLines h nl buf str + (BlockBuffering _, buf) -> writeBlocks (nl == CRLF) h buf str + +hPutChars :: Handle -> Stream Char -> IO () +hPutChars h (Stream next0 s0 _len) = loop s0 + where + loop !s = case next0 s of + Done -> return () + Skip s' -> loop s' + Yield x s' -> hPutChar h x >> loop s' + +-- The following functions are largely lifted from GHC.IO.Handle.Text, +-- but adapted to a coinductive stream of data instead of an inductive +-- list. +-- +-- We have several variations of more or less the same code for +-- performance reasons. Splitting the original buffered write +-- function into line- and block-oriented versions gave us a 2.1x +-- performance improvement. Lifting out the raw/cooked newline +-- handling gave a few more percent on top. + +writeLines :: Handle -> Newline -> CharBuffer -> Stream Char -> IO () +writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0 + where + outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int) + where + inner !s !n = + case next0 s of + Done -> commit n False{-no flush-} True{-release-} >> return () + Skip s' -> inner s' n + Yield x s' + | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s + | x == '\n' -> do + n' <- if nl == CRLF + then do n1 <- writeCharBuf' raw len n '\r' + writeCharBuf' raw len n1 '\n' + else writeCharBuf' raw len n x + commit n' True{-needs flush-} False >>= outer s' + | otherwise -> writeCharBuf' raw len n x >>= inner s' + commit = commitBuffer h raw len + +writeBlocks :: Bool -> Handle -> CharBuffer -> Stream Char -> IO () +writeBlocks isCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0 + where + outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int) + where + inner !s !n = + case next0 s of + Done -> commit n False{-no flush-} True{-release-} >> return () + Skip s' -> inner s' n + Yield x s' + | isCRLF && x == '\n' && n + 1 < len -> do + n1 <- writeCharBuf' raw len n '\r' + writeCharBuf' raw len n1 '\n' >>= inner s' + | n < len -> writeCharBuf' raw len n x >>= inner s' + | otherwise -> commit n True{-needs flush-} False >>= outer s + commit = commitBuffer h raw len + +-- | Only modifies the raw buffer and not the buffer attributes +writeCharBuf' :: RawCharBuffer -> Int -> Int -> Char -> IO Int +writeCharBuf' bufRaw bufSize n c = E.assert (n >= 0 && n < bufSize) $ + writeCharBuf bufRaw n c + +-- This function is completely lifted from GHC.IO.Handle.Text. +getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer) +getSpareBuffer Handle__{haCharBuffer=ref, + haBuffers=spare_ref, + haBufferMode=mode} + = do + case mode of + NoBuffering -> return (mode, error "no buffer!") + _ -> do + bufs <- readIORef spare_ref + buf <- readIORef ref + case bufs of + BufferListCons b rest -> do + writeIORef spare_ref rest + return ( mode, emptyBuffer b (bufSize buf) WriteBuffer) + BufferListNil -> do + new_buf <- newCharBuffer (bufSize buf) WriteBuffer + return (mode, new_buf) + + +-- This function is modified from GHC.Internal.IO.Handle.Text. +commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool + -> IO CharBuffer +commitBuffer hdl !raw !sz !count flush release = + wantWritableHandle "commitAndReleaseBuffer" hdl $ + commitBuffer' raw sz count flush release +{-# INLINE commitBuffer #-} + sizeError :: String -> a sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size" From 836e4400e47e941a850f39ef21656906dd0d0f31 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Sat, 1 Jun 2024 18:49:59 +0100 Subject: [PATCH 4/4] Drop CI job for Ubuntu 16.04 (xenial) It starts causing troubles, and, given that Ubuntu 16.04 is three years over its End of Standard Support, I don't feel like we should care much about it. --- .github/workflows/haskell-ci-xenial.yaml | 162 ----------------------- 1 file changed, 162 deletions(-) delete mode 100644 .github/workflows/haskell-ci-xenial.yaml diff --git a/.github/workflows/haskell-ci-xenial.yaml b/.github/workflows/haskell-ci-xenial.yaml deleted file mode 100644 index 66fc2ecff..000000000 --- a/.github/workflows/haskell-ci-xenial.yaml +++ /dev/null @@ -1,162 +0,0 @@ -# This is haskell-ci script on xenial using one GHC -# This way we test a bit older environment -# -name: Haskell-CI Xenial -on: - - push - - pull_request -jobs: - linux: - name: Haskell-CI - Xenial - ${{ matrix.compiler }} - runs-on: ubuntu-20.04 - container: - image: buildpack-deps:xenial - continue-on-error: ${{ matrix.allow-failure }} - strategy: - matrix: - include: - - compiler: ghc-8.2.2 - compilerKind: ghc - compilerVersion: 8.2.2 - setup-method: ghcup - allow-failure: false - fail-fast: false - steps: - - name: apt - run: | - apt-get update - apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev - mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.4/x86_64-linux-ghcup-0.1.19.4 > "$HOME/.ghcup/bin/ghcup" - chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 - env: - HCKIND: ${{ matrix.compilerKind }} - HCNAME: ${{ matrix.compiler }} - HCVER: ${{ matrix.compilerVersion }} - - name: Set PATH and environment variables - run: | - echo "$HOME/.cabal/bin" >> $GITHUB_PATH - echo "LANG=C.UTF-8" >> "$GITHUB_ENV" - echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" - echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" - HCDIR=/opt/$HCKIND/$HCVER - HC=$HOME/.ghcup/bin/$HCKIND-$HCVER - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') - echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" - echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" - echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" - echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" - echo "GHCJSARITH=0" >> "$GITHUB_ENV" - env: - HCKIND: ${{ matrix.compilerKind }} - HCNAME: ${{ matrix.compiler }} - HCVER: ${{ matrix.compilerVersion }} - - name: env - run: | - env - - name: write cabal config - run: | - mkdir -p $CABAL_DIR - cat >> $CABAL_CONFIG < cabal-plan.xz - echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - - xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan - rm -f cabal-plan.xz - chmod a+x $HOME/.cabal/bin/cabal-plan - cabal-plan --version - - name: checkout - uses: actions/checkout@v3 - with: - path: source - - name: initial cabal.project for sdist - run: | - touch cabal.project - echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project - cat cabal.project - - name: sdist - run: | - mkdir -p sdist - $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist - - name: unpack - run: | - mkdir -p unpacked - find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; - - name: generate cabal.project - run: | - PKGDIR_text="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/text-[0-9.]*')" - echo "PKGDIR_text=${PKGDIR_text}" >> "$GITHUB_ENV" - rm -f cabal.project cabal.project.local - touch cabal.project - touch cabal.project.local - echo "packages: ${PKGDIR_text}" >> cabal.project - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package text" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi - cat >> cabal.project <> cabal.project.local - cat cabal.project - cat cabal.project.local - - name: dump install plan - run: | - $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all - cabal-plan - - name: cache - uses: actions/cache@v3 - with: - key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} - path: ~/.cabal/store - restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- - - name: install dependencies - run: | - $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all - $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all - - name: build w/o tests - run: | - $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all - - name: build - run: | - $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always - - name: tests - run: | - $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct - - name: cabal check - run: | - cd ${PKGDIR_text} || false - ${CABAL} -vnormal check - - name: unconstrained build - run: | - rm -f cabal.project.local - $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all