Skip to content

Commit

Permalink
Merge remote-tracking branch 'mango4/main'. change a bunch of stuff to $
Browse files Browse the repository at this point in the history
  • Loading branch information
ekmett committed Mar 29, 2024
2 parents 2374767 + 99e6fa3 commit 18519f8
Show file tree
Hide file tree
Showing 3 changed files with 47 additions and 29 deletions.
45 changes: 29 additions & 16 deletions .github/workflows/ci.yml
Original file line number Diff line number Diff line change
@@ -1,22 +1,35 @@
name: ci
on:
name: haskell ci
on:
push:
pull_request:
schedule:
- cron: '0 3 * * 6' # 3am Saturday
workflow_dispatch:
jobs:
test:
generate-matrix:
name: "Generate matrix from cabal"
outputs:
matrix: ${{ steps.set-matrix.outputs.matrix }}
runs-on: ubuntu-latest
steps:
- name: Extract the tested GHC versions
id: set-matrix
uses: kleidukos/get-tested@v0.1.7.0
with:
cabal-file: placeholder.cabal
ubuntu-version: latest
macos-version: latest
version: 0.1.7.0
tests:
name: ${{ matrix.ghc }} on ${{ matrix.os }}
needs: generate-matrix
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
os: [ubuntu-latest, macOS-latest, windows-latest]
ghc: ['9.8', '9.6', '9.4']
steps:
- uses: actions/checkout@v2
- uses: haskell/actions/setup@v2
id: setup-haskell
with:
ghc-version: ${{ matrix.ghc }}
- run: cabal new-build all
- run: cabal new-test --test-option=--color=always --test-show-details=always test:placeholder-test
matrix: ${{ fromJSON(needs.generate-matrix.outputs.matrix) }}
steps:
- uses: actions/checkout@v4
- uses: haskell-actions/setup@v2
id: setup-haskell
with:
ghc-version: ${{ matrix.ghc }}
- run: cabal new-build all
- run: cabal new-test --test-option=--color=always --test-show-details=always test:placeholder-test
1 change: 1 addition & 0 deletions placeholder.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ copyright: Copyright (c) 2024 Edward Kmett
stability: experimental
category: Control
build-type: Simple
tested-with: GHC ==9.4.8 || ==9.6.4 || ==9.8.1
extra-doc-files:
README.md,
CHANGELOG.md
Expand Down
30 changes: 17 additions & 13 deletions src/Control/Placeholder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ >= 980
Expand All @@ -15,6 +16,9 @@
#define WARNING_IN_XTODO WARNING
#endif

{- | The 'Control.Placeholder' module implements various functions to indicate
unfinished or generally unimplemented code
-}
module Control.Placeholder
(
-- * Combinators
Expand Down Expand Up @@ -53,7 +57,7 @@ pattern TodoException :: TodoException
pattern TodoException <- TodoExceptionWithLocation _ where
TodoException = TodoExceptionWithLocation missingLocation

-- | This is the 'Exception' thrown by 'unimplmented', 'Unimplemented', and 'unimplementedIO'.
-- | This is the 'Exception' thrown by 'unimplemented', 'Unimplemented', and 'unimplementedIO'.
newtype UnimplementedException = UnimplementedExceptionWithLocation String
deriving (Typeable, Exception)

Expand All @@ -67,13 +71,13 @@ pattern UnimplementedException <- UnimplementedExceptionWithLocation _ where

-- | robust retrieval of the current callstack suitable for custom exception types
withCallStack :: Exception a => (String -> a) -> CallStack -> SomeException
withCallStack f stk = unsafeDupablePerformIO $ do
withCallStack f stk = unsafeDupablePerformIO do
ccsStack <- currentCallStack
let
implicitParamCallStack = prettyCallStackLines stk
ccsCallStack = showCCSStack ccsStack
stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
return $ toException (f stack)
pure $ toException $ f stack

{- | 'todo' indicates unfinished code.
Expand Down Expand Up @@ -102,18 +106,18 @@ superComplexFunction 'Nothing' = 'pure' 42
superComplexFunction ('Just' a) = 'todo'
@
-}
todo :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
todo = raise# (withCallStack TodoExceptionWithLocation ?callStack)
todo :: forall {r :: RuntimeRep} (a :: TYPE r). HasCallStack => a
todo = raise# $ withCallStack TodoExceptionWithLocation ?callStack
{-# WARNING_IN_XTODO todo "'todo' left in code" #-}

{- | 'todoIO' indicates unfinished code that should live in the IO monad.
{- | 'todoIO' indicates unfinished code that lives in the IO monad.
It should be used similarly to how 'throwIO' should be used rather than 'throw' in IO
to throw at the time the IO action is run rather than at the time it is created.
-}
todoIO :: HasCallStack => IO a
todoIO = IO (raiseIO# (withCallStack TodoExceptionWithLocation ?callStack))
todoIO = IO $ raiseIO# $ withCallStack TodoExceptionWithLocation ?callStack
{-# WARNING_IN_XTODO todoIO "'todoIO' left in code" #-}

{- | 'TODO' indicates unfinished code or an unfinished pattern match
Expand All @@ -126,17 +130,17 @@ There remain some circumstances where you can only use 'todo', however, they ari
-}
pattern TODO :: HasCallStack => () => a
pattern TODO <- (raise# (withCallStack TodoExceptionWithLocation ?callStack) -> _unused) where
TODO = raise# (withCallStack TodoExceptionWithLocation ?callStack)
TODO = raise# $ withCallStack TodoExceptionWithLocation ?callStack
{-# WARNING_IN_XTODO TODO "'TODO' left in code" #-}
{-# COMPLETE TODO #-}

{- | 'unimplemented' indicates that the relevant code is unimplemented. Unlike 'todo', it is expected that this _may_ remain in code
long term, and so no warning is supplied. Usecases might include places where a typeclass would theoretically require a member to be
long term, and so no warning is supplied. Use cases might include places where a typeclass would theoretically require a member to be
implemented, but where the resulting violation is actually intended.
-}

unimplemented :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
unimplemented = raise# (withCallStack UnimplementedExceptionWithLocation ?callStack)
unimplemented :: forall {r :: RuntimeRep} (a :: TYPE r). HasCallStack => a
unimplemented = raise# $ withCallStack UnimplementedExceptionWithLocation ?callStack

{- | 'unimplementedIO' indicates that the method is unimplemented, but it lives in IO, and so only throws when actually run, rather
than when it is constructed. Unlike 'todoIO' it does not provide a compile-time warning, as it is expected that this _may_ remain in
Expand All @@ -145,15 +149,15 @@ code long term.
-}

unimplementedIO :: HasCallStack => IO a
unimplementedIO = IO (raiseIO# (withCallStack UnimplementedExceptionWithLocation ?callStack))
unimplementedIO = IO $ raiseIO# $ withCallStack UnimplementedExceptionWithLocation ?callStack

{- | 'Unimplemented' can be used in most circumstances 'unimplemented' can, but it can also be used in pattern position to indicate cases
haven't been considered yet. Unlike 'TODO' it does not provide a compile-time warning, as it is expected that this _may_ remain in code long term.
-}
pattern Unimplemented :: HasCallStack => () => a
pattern Unimplemented <- (raise# (withCallStack UnimplementedExceptionWithLocation ?callStack) -> _unused) where
Unimplemented = raise# (withCallStack UnimplementedExceptionWithLocation ?callStack)
Unimplemented = raise# $ withCallStack UnimplementedExceptionWithLocation ?callStack
{-# COMPLETE Unimplemented #-}

missingLocation :: String
Expand Down

0 comments on commit 18519f8

Please sign in to comment.