data-forced (empty) → 0.1.0.0

raw patch · 5 files changed

+177/−0 lines, 5 filesdep +HUnitdep +basedep +containers

Dependencies added: HUnit, base, containers, data-elevator, data-forced, deepseq

Files

CHANGELOG.md +5/−0
LICENSE +20/−0
data-forced.cabal +58/−0
src/Data/Forced.hs +43/−0
test/Main.hs +51/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for data-elevator-forced++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2023 Ruben Astudillo++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ data-forced.cabal view

@@ -0,0 +1,58 @@+cabal-version:      3.0+name:               data-forced+version:            0.1.0.0+synopsis:           Specify that lifted values were forced to WHNF or NF.+license:            MIT+license-file:       LICENSE+author:             Ruben Astudillo+maintainer:         ruben.astud@gmail.com+copyright:          2023+category:           Data+build-type:         Simple+extra-doc-files:    CHANGELOG.md+description:+  Alternative to bang patterns using CBV functions and unlifted data types.+  Tag your values to maintain the invariant that they were forced. Avoid+  liveness leaks on long running data structures.++  > import Data.Map.Lazy as ML -- Spine strict+  > +  > -- No references on added leafs even though it is a lazy map.+  > basicEvent :: ML.Map Char (ForcedWHNF Int) -> IO (ML.Map Char (ForcedWHNF Int))+  > basicEvent map0 = do+  >   let val0 :: Strict (ForcedWHNF Int)+  >       -- val0 = strictlyWHNF (error "argument evaluated") -- would fail+  >       val0 = strictlyWHNF (2 + 2)+  >       -- CBV function, 2 + 2 reduced before val0 is bound.+  >       Strict val1 = val0  -- De-structure+  >       map1 = ML.insert 'a' val1 map0+  >   pure map1+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:  Data.Forced+    -- other-modules:+    -- other-extensions:+    build-depends:    base ^>=4.16.4.0,+                      data-elevator >=0.1.0.0,+                      deepseq >= 1.4.6.0+    hs-source-dirs:   src+    default-language: GHC2021++test-suite data-forced-test+    import:           warnings+    default-language: GHC2021+    -- other-modules:+    -- other-extensions:+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base ^>=4.16.4.0,+        containers,+        HUnit,+        data-forced

+ src/Data/Forced.hs view

@@ -0,0 +1,43 @@+{-# Language ExplicitForAll, UnliftedDatatypes, PatternSynonyms, GADTSyntax #-}++module Data.Forced+  ( Strict(..)+  , ForcedWHNF+  , pattern ForcedWHNF+  , ForcedNF+  , pattern ForcedNF+  , strictlyWHNF+  , strictlyNF+  ) where++import Data.Elevator ( UnliftedType, LiftedType )+import Control.DeepSeq++type Strict :: LiftedType -> UnliftedType+data Strict a where+  Strict :: !a -> Strict a++{- The invariants of @ForcedWHNF@ and @ForcedNF@ depends on the constructors+not being exported. The only way to construct these value is through the CBV+functions. Pattern matching is done via a unidirectional pattern.+-}+newtype ForcedWHNF a = ForcedOuter a++pattern ForcedWHNF :: forall a. a -> ForcedWHNF a+pattern ForcedWHNF a <- ForcedOuter a++newtype ForcedNF a = ForcedFull a++pattern ForcedNF :: forall a. a -> ForcedNF a+pattern ForcedNF a <- ForcedFull a++{- | This is a CBV function. Evaluates the argument to WHNF before+returning.+-}+strictlyWHNF :: forall a. a -> Strict (ForcedWHNF a)+strictlyWHNF a = Strict (ForcedOuter a)++{- | This is a CBV function. Evaluates the argument to NF before returning.+-}+strictlyNF :: forall a. NFData a => a -> Strict (ForcedNF a)+strictlyNF a = Strict (ForcedFull (rnf a `seq` a))

+ test/Main.hs view

@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-unused-binds #-}+module Main (main) where++import qualified Data.Map.Lazy as ML+import Data.Forced+import Test.HUnit ( (~:), runTestTT, Counts, Test(TestList) )+import Control.Exception (catch, ErrorCall (..))++main :: IO Counts+main = runTestTT tests++tests :: Test+tests = TestList+  [ "test1" ~: "noThunksForWHNF" ~: errorCalledWithMsg "argument evaluated" noThunksForWHNF+  , "test2" ~: "thunksForWHNFMaybe" ~: thunksForWHNFMaybe+  , "test3" ~: "noThunksForNFMaybe" ~: errorCalledWithMsg "argument evaluated" noThunksForNFMaybe+  ]++errorCalledWithMsg :: String -> IO a -> IO Bool+errorCalledWithMsg msg io =+  catch (False <$ io) (\(ErrorCall msg1) -> pure (msg == msg1))++noThunksForWHNF :: IO ()+noThunksForWHNF = do+  let map0 :: ML.Map Char (ForcedWHNF Int)+      map0 = ML.empty+      val0 :: Strict (ForcedWHNF Int)+      val0 = strictlyWHNF (error "argument evaluated")+      Strict val1 = val0+      map1 = ML.insert 'a' val1 map0+  pure ()++thunksForWHNFMaybe :: IO ()+thunksForWHNFMaybe = do+  let map0 :: ML.Map Char (ForcedWHNF (Maybe Int))+      map0 = ML.empty+      val0 :: Strict (ForcedWHNF (Maybe Int))+      val0 = strictlyWHNF (const (Just (error "argument evaluated")) 'a')+      Strict val1 = val0+      map1 = ML.insert 'a' val1 map0+  pure ()++noThunksForNFMaybe :: IO ()+noThunksForNFMaybe = do+  let map0 :: ML.Map Char (ForcedNF (Maybe Int))+      map0 = ML.empty+      val0 :: Strict (ForcedNF (Maybe Int))+      val0 = strictlyNF ((+1) <$> Just (error "argument evaluated" :: Int))+      Strict val = val0+      map1 = ML.insert 'a' val map0+  pure ()