diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +## [_Unreleased_](https://github.com/freckle/memo-map/compare/v__...main) + +## [v0.0.0.0](https://github.com/freckle/memo-map/tree/v0.0.0.0) + +First tagged release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2025 Freckle + +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. diff --git a/README.lhs b/README.lhs new file mode 100644 --- /dev/null +++ b/README.lhs @@ -0,0 +1,79 @@ +# memo-map + +Utility for memoizing an effectful function (e.g. database query) using a map. + +## Example + + + +```haskell +import MemoMap +``` + +For demonstration, a silly little function that performs an effect and returns a value: + +```haskell +f :: Int -> IO Int +f x = do + putStrLn ("f " <> show x) + pure (x * 10) +``` + +If `f` may be applied to the same argument repeatedly, perhaps it would be advantageous +to save the results from a previous application rather than repeating the action. + + + +### Create a MemoMap + +Turn `f` into a `MemoMap`. + +```haskell + mm <- newMemoMap f +``` + +### Use the memoized function + +Use `runMemoMap mm` instead of `f` to run a _memoized_ version of `f`. + +```haskell + print =<< runMemoMap mm 2 + print =<< runMemoMap mm 2 + print =<< runMemoMap mm 3 +``` + +Output: + + f 2 + 20 + 20 + f 3 + 30 + +### Inspect the cache + +You can also use `getMemoMap` to inspect the stored values. + +```haskell + print =<< getMemoMap mm +``` + +Output: + + fromList [(2,20),(3,30)] + +--- + +[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,79 @@ +# memo-map + +Utility for memoizing an effectful function (e.g. database query) using a map. + +## Example + + + +```haskell +import MemoMap +``` + +For demonstration, a silly little function that performs an effect and returns a value: + +```haskell +f :: Int -> IO Int +f x = do + putStrLn ("f " <> show x) + pure (x * 10) +``` + +If `f` may be applied to the same argument repeatedly, perhaps it would be advantageous +to save the results from a previous application rather than repeating the action. + + + +### Create a MemoMap + +Turn `f` into a `MemoMap`. + +```haskell + mm <- newMemoMap f +``` + +### Use the memoized function + +Use `runMemoMap mm` instead of `f` to run a _memoized_ version of `f`. + +```haskell + print =<< runMemoMap mm 2 + print =<< runMemoMap mm 2 + print =<< runMemoMap mm 3 +``` + +Output: + + f 2 + 20 + 20 + f 3 + 30 + +### Inspect the cache + +You can also use `getMemoMap` to inspect the stored values. + +```haskell + print =<< getMemoMap mm +``` + +Output: + + fromList [(2,20),(3,30)] + +--- + +[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE) diff --git a/memo-map.cabal b/memo-map.cabal new file mode 100644 --- /dev/null +++ b/memo-map.cabal @@ -0,0 +1,80 @@ +cabal-version: 1.18 +name: memo-map +version: 0.0.0.0 +license: MIT +license-file: LICENSE +maintainer: Freckle Education +homepage: https://github.com/freckle/memo-map#readme +bug-reports: https://github.com/freckle/memo-map/issues +synopsis: Memoization in a Map +description: + Utility for memoizing an effectful function (e.g. database query) using a Map. + +category: Memoization +build-type: Simple +extra-source-files: package.yaml +extra-doc-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/freckle/memo-map + +library + exposed-modules: MemoMap + hs-source-dirs: src + other-modules: Paths_memo_map + default-language: GHC2021 + default-extensions: + BangPatterns DataKinds DerivingStrategies GADTs + GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses + NoFieldSelectors NoImplicitPrelude NoMonomorphismRestriction + OverloadedRecordDot OverloadedStrings StandaloneDeriving + TypeApplications TypeFamilies + + ghc-options: + -fwrite-ide-info -Weverything -Wno-all-missed-specialisations + -Wno-missed-specialisations -Wno-missing-exported-signatures + -Wno-missing-import-lists -Wno-missing-local-signatures + -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe + -Wno-missing-kind-signatures -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module + + build-depends: + base >=4.16.4.0 && <5, + containers >=0.6.5.1, + unliftio >=0.2.25.0 + + if impl(ghc >=9.8) + ghc-options: + -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures + +test-suite readme + type: exitcode-stdio-1.0 + main-is: README.lhs + other-modules: Paths_memo_map + default-language: GHC2021 + default-extensions: + BangPatterns DataKinds DerivingStrategies GADTs + GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses + NoFieldSelectors NoImplicitPrelude NoMonomorphismRestriction + OverloadedRecordDot OverloadedStrings StandaloneDeriving + TypeApplications TypeFamilies + + ghc-options: + -fwrite-ide-info -Weverything -Wno-all-missed-specialisations + -Wno-missed-specialisations -Wno-missing-exported-signatures + -Wno-missing-import-lists -Wno-missing-local-signatures + -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe + -Wno-missing-kind-signatures -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module -pgmL markdown-unlit + + build-depends: + base >=4.16.4.0 && <5, + markdown-unlit >=0.5.1, + memo-map + + if impl(ghc >=9.8) + ghc-options: + -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -0,0 +1,72 @@ +name: memo-map +version: 0.0.0.0 +maintainer: Freckle Education +category: Memoization +github: freckle/memo-map +synopsis: Memoization in a Map +description: | + Utility for memoizing an effectful function (e.g. database query) using a Map. + +extra-doc-files: + - README.md + - CHANGELOG.md + +extra-source-files: + - package.yaml + +ghc-options: + - -fwrite-ide-info + - -Weverything + - -Wno-all-missed-specialisations + - -Wno-missed-specialisations + - -Wno-missing-exported-signatures # re-enables missing-signatures + - -Wno-missing-import-lists + - -Wno-missing-local-signatures + - -Wno-monomorphism-restriction + - -Wno-safe + - -Wno-unsafe + - -Wno-missing-kind-signatures + - -Wno-missing-safe-haskell-mode + - -Wno-prepositive-qualified-module + +when: + - condition: "impl(ghc >= 9.8)" + ghc-options: + - -Wno-missing-role-annotations + - -Wno-missing-poly-kind-signatures + +dependencies: + - base < 5 + +language: GHC2021 + +default-extensions: + - BangPatterns + - DataKinds + - DerivingStrategies + - GADTs + - GeneralizedNewtypeDeriving + - LambdaCase + - MultiParamTypeClasses + - NoFieldSelectors + - NoImplicitPrelude + - NoMonomorphismRestriction + - OverloadedRecordDot + - OverloadedStrings + - StandaloneDeriving + - TypeApplications + - TypeFamilies + +library: + source-dirs: src + dependencies: + - containers + - unliftio + +tests: + readme: + main: README.lhs + ghc-options: -pgmL markdown-unlit + dependencies: + - memo-map + - markdown-unlit diff --git a/src/MemoMap.hs b/src/MemoMap.hs new file mode 100644 --- /dev/null +++ b/src/MemoMap.hs @@ -0,0 +1,66 @@ +module MemoMap + ( -- * MemoMap type + MemoMap (..) + , newMemoMap + , runMemoMap + , getMemoMap + + -- * Simplified usage + , memoize + ) where + +import Prelude + +import Data.Map (Map) +import Data.Map.Strict qualified as Map +import UnliftIO + +newMapCache :: forall a b m. MonadIO m => m (IORef (Map a b)) +newMapCache = newIORef Map.empty + +-- | Create with 'newMemoMap', use with 'runMemoMap' +data MemoMap m a b = MemoMap + { cacheRef :: IORef (Map a b) + -- ^ Mutable reference to memoized results + , uncachedFunction :: a -> m b + -- ^ Original unmemoized action + } + +newMemoMap + :: forall a b m1 m2 + . MonadIO m1 + => (a -> m2 b) + -> m1 (MemoMap m2 a b) +newMemoMap uncachedFunction = do + cacheRef <- newMapCache + pure MemoMap {cacheRef, uncachedFunction} + +runMemoMap + :: forall a b m + . (MonadUnliftIO m, Ord a) + => MemoMap m a b + -> a + -> m b +runMemoMap MemoMap {cacheRef, uncachedFunction} a = + withRunInIO $ \runInIO -> do + m <- readIORef cacheRef + case Map.lookup a m of + Nothing -> do + b <- runInIO $ uncachedFunction a + writeIORef cacheRef $ Map.insert a b m + pure b + Just b -> + pure b + +getMemoMap :: MonadIO m => MemoMap m a b -> m (Map a b) +getMemoMap = liftIO . readIORef . (.cacheRef) + +-- | Create a memoized variant of an effectful function (using 'MemoMap' internally) +memoize + :: forall a b m1 m2 + . (MonadIO m1, MonadUnliftIO m2, Ord a) + => (a -> m2 b) + -> m1 (a -> m2 b) +memoize uncachedFunction = do + cacheRef <- newMapCache + pure $ runMemoMap MemoMap {cacheRef, uncachedFunction}