diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,13 +1,43 @@ +# Changelog + ## [Unreleased] + +## [0.0.0.10] - 2024-10-07 +### Fix +- **package:** add license-file descriptor to package.yaml + + + +## [0.0.0.9] - 2024-10-07 +### Chore +- reformat changelog configuration file +- **release:** 0.0.0.9 +- **release:** setup and document release process + +### Docs +- add GitHub release step to "Making Releases" section in README + +### Fix +- **deps:** update dependency boundaries, adopt new Nix shell, chores + +### Test +- add GitHub action for testing + +### Pull Requests +- Merge pull request [#20](https://github.com/telostat/haspara/issues/20) from telostat/19-find-a-solution-to-automate-releases +- Merge pull request [#18](https://github.com/telostat/haspara/issues/18) from telostat/vst/revisit-nix-upgrade-deps + + ## [0.0.0.8] - 2022-11-21 ### Chore - bump development version to 0.0.0.8 - **nix:** make it more convenient to test against different ghc versions - **nix:** make default haspara Nix package come with haddock +- **release:** 0.0.0.8 ### Fix - add explicit Aeson.ToJSON.toEncoding implementations @@ -38,9 +68,9 @@ ## [0.0.0.6] - 2022-11-17 ### Chore +- remove stylish-haskell configuration - drop Stack usage - bump development version to 0.0.0.6 -- remove stylish-haskell configuration - **deps:** park library dependencies under library section - **docs:** update development and release procedure in README - **nix:** use telos.nix @@ -90,12 +120,12 @@ ### Feat - add Haspara.Accounting.Side module - **accounting:** improve Ledger module definitions +- **accounting:** improve Balance module definitions - **accounting:** delineate value and quantity concepts wrt Amount - **accounting:** add Bounded instance to AccountKind - **accounting:** add TrialBalance definitions - **accounting:** add Amount and Balance definitions - **accounting:** improve the Haspara.Accounting.Side module -- **accounting:** improve Balance module definitions ### Refactor - **accounting:** remove Event definitions, revisit exports @@ -166,11 +196,11 @@ ## 0.0.0.0 - 2022-03-01 ### Chore - integrate git-chglog -- init repository - warn about unused packages during build - add synopsis and category to package info - update copyright notice - init codebase +- init repository - **deps:** upgrade to lts-18.17 - **docs:** update README - **release:** 0.0.0.0 @@ -183,7 +213,9 @@ - Merge pull request [#1](https://github.com/telostat/haspara/issues/1) from telostat/init -[Unreleased]: https://github.com/telostat/haspara/compare/0.0.0.8...HEAD +[Unreleased]: https://github.com/telostat/haspara/compare/0.0.0.10...HEAD +[0.0.0.10]: https://github.com/telostat/haspara/compare/0.0.0.9...0.0.0.10 +[0.0.0.9]: https://github.com/telostat/haspara/compare/0.0.0.8...0.0.0.9 [0.0.0.8]: https://github.com/telostat/haspara/compare/0.0.0.7...0.0.0.8 [0.0.0.7]: https://github.com/telostat/haspara/compare/0.0.0.6...0.0.0.7 [0.0.0.6]: https://github.com/telostat/haspara/compare/0.0.0.5...0.0.0.6 diff --git a/LICENSE b/LICENSE deleted file mode 100644 --- a/LICENSE +++ /dev/null @@ -1,22 +0,0 @@ -MIT License - -Copyright (c) 2021-2022 Telostat Pte Ltd - -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/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2021-2024 Telostat Pte Ltd + +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.md b/README.md --- a/README.md +++ b/README.md @@ -13,54 +13,27 @@ *haspara* is a Haskell library that provides monetary definitions and a rudimentary (and experimental) accounting functionality. -## Supported GHC Versions - -1. `ghc90` -1. `ghc92` - -At the moment, there is no particular reason for not supporting -`ghc94` except that required settings are not done yet in Nix support -files, in particular for Cabal dependency. - -## Testing Against GHC Versions - -You can use Nix support to test against different GHC versions: - -```sh -nix-build --arg compiler "\"ghc92\"" -nix-build --arg compiler "\"ghc90\"" -``` - -`nix-build` command will default to `ghc90`. Check `./default.nix` -file for the default `ghc` version in case that this documentation is -out of date. - ## Development -Before committing code to repository, reformat the code: - -```sh -fourmolu -i src/ test/ -``` - -Compile the codebase, check warnings and errors: - -```sh -cabal build -O0 -cabal test -O0 -cabal haddock -O0 -``` - -Run [hlint](https://github.com/ndmitchell/hlint): +Big, long build command for the impatient: ```sh -hlint src/ +hpack && + direnv reload && + fourmolu -i src/ test/ && + prettier --write . && + find . -iname "*.nix" -not -path "*/nix/sources.nix" -print0 | xargs --null nixpkgs-fmt && + hlint src/ test/ && + cabal build -O0 && + cabal run -O0 haspara -- --version && + cabal v1-test && + cabal haddock -O0 ``` -Run [weeder](https://hackage.haskell.org/package/weeder): +To test and build codebase in development environment, run: ```sh -weeder --require-hs-files +dev-test-build ``` ## Making Releases @@ -82,13 +55,7 @@ recompile the project, run tests and generate Haddock documentation: ```sh - hpack - cabal clean - cabal build -O0 - cabal test -O0 - cabal haddock -O0 - nix-build --arg compiler "\"ghc92\"" - nix-build --arg compiler "\"ghc90\"" + nix-shell --run "dev-test-build -c" ``` 4. Update [CHANGELOG.md](./CHANGELOG.md) file: @@ -108,22 +75,22 @@ 6. Create the package, upload to Hackage as a candidate first and check the result: ```sh - cabal clean - cabal build -O0 - cabal test -O0 - cabal haddock -O0 - cabal sdist - cabal upload + nix-shell --run "dev-test-build -c" + nix-shell --run "cabal sdist" + nix-shell --run "cabal upload dist-newstyle/sdist/haspara-.tar.gz" ``` 7. If the candidate package release works fine, release to Hackage: ```sh - cabal upload --publish + nix-shell --run "cabal upload --publish dist-newstyle/sdist/haspara-.tar.gz" ``` +8. Make sure that the release is available on [Hackage](https://hackage.haskell.org/package/haspara). +9. Make sure that the release is available on [GitHub](https://github.com/telostat/haspara/releases). + ## License -Copyright Telostat Pte Ltd (c) 2021-2022. +Copyright Telostat Pte Ltd (c) 2021-2024. This work is licensed under MIT license. See [LICENSE](./LICENSE). diff --git a/doctest.hs b/doctest.hs deleted file mode 100644 --- a/doctest.hs +++ /dev/null @@ -1,7 +0,0 @@ -import Test.DocTest (doctest) - - -main :: IO () -main = - doctest - ["-isrc" , "src"] diff --git a/haspara.cabal b/haspara.cabal --- a/haspara.cabal +++ b/haspara.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: haspara -version: 0.0.0.8 +version: 0.0.0.10 synopsis: A library providing definitions to work with monetary values. description: Please see the README on GitHub at category: Finance @@ -13,12 +13,13 @@ bug-reports: https://github.com/telostat/haspara/issues author: Vehbi Sinan Tunalioglu maintainer: vst@vsthost.com -copyright: Copyright (c) 2021-2022 Telostat Pte Ltd +copyright: Copyright (c) 2021-2024 Telostat Pte Ltd license: MIT -license-file: LICENSE +license-file: LICENSE.md build-type: Simple extra-source-files: README.md + LICENSE.md CHANGELOG.md source-repository head @@ -49,20 +50,20 @@ src ghc-options: -Wall -Wunused-packages build-depends: - aeson >=1.5.6.0 && <2.1 + aeson >=1.5.6.0 && <2.3 , base >=4.11 && <5 , containers >=0.6.4.1 && <0.7 , data-default ==0.7.* , exceptions >=0.10.4 && <0.11 , hashable >=1.3.0.0 && <1.5 - , megaparsec >=9.0.1 && <9.3 - , mtl >=2.2.2 && <2.3 - , refined >=0.6.3 && <0.7 + , megaparsec >=9.0.1 && <9.6 + , mtl >=2.2.2 && <2.4 + , refined >=0.6.3 && <0.9 , safe-decimal >=0.2.1.0 && <0.3 , scientific >=0.3.7.0 && <0.4 - , template-haskell >=2.16.0.0 && <2.19 - , text >=1.2.4.1 && <1.3 - , time >=1.9.3 && <1.12 + , template-haskell >=2.16.0.0 && <2.21 + , text >=1.2.4.1 && <2.2 + , time >=1.9.3 && <1.14 default-language: Haskell2010 test-suite haspara-doctest @@ -71,22 +72,23 @@ other-modules: Paths_haspara hs-source-dirs: - ./ - ghc-options: -threaded + test/doctest + ghc-options: -Wall -threaded build-depends: base >=4.11 && <5 , doctest + , haspara default-language: Haskell2010 test-suite haspara-test type: exitcode-stdio-1.0 - main-is: test.hs + main-is: Spec.hs other-modules: Tests.Haspara.Accounting.Inventory Paths_haspara hs-source-dirs: - test - ghc-options: -Wall -Wunused-packages -threaded + test/spec + ghc-options: -Wall -Wunused-packages -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.11 && <5 , containers diff --git a/src/Haspara/Quantity.hs b/src/Haspara/Quantity.hs --- a/src/Haspara/Quantity.hs +++ b/src/Haspara/Quantity.hs @@ -15,7 +15,6 @@ -- with fixed decimal points. module Haspara.Quantity where -import Control.Applicative (liftA2) import Control.Monad.Except (MonadError (throwError)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encoding as Aeson.Encoding @@ -91,7 +90,7 @@ -- Just 0.42 -- >>> Aeson.decode "0.425" :: Maybe (Quantity 2) -- Just 0.42 -instance (KnownNat s) => Aeson.FromJSON (Quantity s) where +instance KnownNat s => Aeson.FromJSON (Quantity s) where parseJSON = Aeson.withScientific "Quantity" (pure . mkQuantity) @@ -99,7 +98,7 @@ -- -- >>> Aeson.encode (mkQuantity 0.42 :: Quantity 2) -- "0.42" -instance (KnownNat s) => Aeson.ToJSON (Quantity s) where +instance KnownNat s => Aeson.ToJSON (Quantity s) where toJSON = Aeson.Number . D.toScientificDecimal . unQuantity toEncoding = Aeson.Encoding.scientific . D.toScientificDecimal . unQuantity @@ -126,7 +125,7 @@ -- Right 42.00 -- >>> arithM (fromInteger 42) :: Either SomeException (Quantity 2) -- Right 42.00 -instance (KnownNat s) => Num (D.Arith (Quantity s)) where +instance KnownNat s => Num (D.Arith (Quantity s)) where (+) = liftA2 (+) (-) = liftA2 (-) (*) = liftA2 (*) @@ -153,7 +152,7 @@ -- Right 42.00 -- >>> arithM (Arith a / Arith b / Arith c) :: Either SomeException (Quantity 2) -- Left divide by zero -instance (KnownNat s) => Fractional (D.Arith (Quantity s)) where +instance KnownNat s => Fractional (D.Arith (Quantity s)) where a / b = fmap MkQuantity $ fmap unQuantity a / fmap unQuantity b fromRational = fmap MkQuantity . D.fromRationalDecimalWithoutLoss @@ -318,7 +317,7 @@ -- Just 2.00 -- >>> divide (mkQuantity 0.42 :: Quantity 2) (mkQuantity (-0.21) :: Quantity 2) -- Just -2.00 -divide :: (KnownNat s) => Quantity s -> Quantity s -> Maybe (Quantity s) +divide :: KnownNat s => Quantity s -> Quantity s -> Maybe (Quantity s) divide (MkQuantity d1) (MkQuantity d2) = MkQuantity <$> D.divideDecimalWithRounding d1 d2 diff --git a/test/Tests/Haspara/Accounting/Inventory.hs b/test/Tests/Haspara/Accounting/Inventory.hs deleted file mode 100644 --- a/test/Tests/Haspara/Accounting/Inventory.hs +++ /dev/null @@ -1,182 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} - -module Tests.Haspara.Accounting.Inventory where - -import Data.Default (def) -import Data.Foldable (foldl') -import qualified Data.Sequence as Seq -import qualified Data.Time as Time -import Haspara.Accounting.Inventory (Inventory (..), InventoryEvent (..), InventoryHistoryItem (..), updateInventory, updateInventoryVP) -import Haspara.Quantity (Quantity) -import Test.Hspec (SpecWith, describe, hspec, it, shouldBe) - - --- * Core Definitions - - --- | Type definition for the inventory type used in this module. -type TestInventory = Inventory 8 12 2 - - --- | Type definition for the inventory type used in this module. -type TestInventoryEvent = InventoryEvent 8 12 - - --- | Type definition for the inventory history item used in this module. -type TestInventoryHistoryItem = InventoryHistoryItem 8 12 2 - - --- | Initial inventory. -initInventory :: TestInventory -initInventory = def @TestInventory - - -testInventory :: IO () -testInventory = hspec $ do - describe "Inventory Functionality" $ do - testInitialInventory - testInitialInventoryEvent - testInventoryCloseProfit - testInventoryAlternate - testInventoryScenario1 - - --- * Test Specs - - -testInitialInventory :: SpecWith () -testInitialInventory = - it "initial inventory is empty" $ do - inventoryTotal initInventory `shouldBe` 0 - inventoryCurrent initInventory `shouldBe` mempty - inventoryHistory initInventory `shouldBe` mempty - - -testInitialInventoryEvent :: SpecWith () -testInitialInventoryEvent = do - it "can add initial inventory increment event" $ do - let (historyItem, newInventory) = updateInventoryVP (day 1) 1 10 initInventory - - inventoryTotal newInventory `shouldBe` 10 - length (inventoryCurrent newInventory) `shouldBe` 1 - inventoryHistory newInventory `shouldBe` mempty - historyItem `shouldBe` mempty - - it "can add initial inventory decrement event" $ do - let (historyItem, newInventory) = updateInventoryVP (day 1) 1 (-10) initInventory - - inventoryTotal newInventory `shouldBe` (-10) - length (inventoryCurrent newInventory) `shouldBe` 1 - inventoryHistory newInventory `shouldBe` mempty - historyItem `shouldBe` mempty - - -testInventoryCloseProfit :: SpecWith () -testInventoryCloseProfit = do - it "can close initial stock item with no-profit" $ do - let (historyItem, newInventory) = updateManyVP [(day 1, 1, 10), (day 2, 1, -10)] - - inventoryTotal newInventory `shouldBe` 0 - inventoryCurrent newInventory `shouldBe` mempty - length (inventoryHistory newInventory) `shouldBe` 1 - length historyItem `shouldBe` 1 - foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 0 - - it "can close initial stock item with profit" $ do - let (historyItem, newInventory) = updateManyVP [(day 1, 1, 10), (day 2, 2, -10)] - - inventoryTotal newInventory `shouldBe` 0 - inventoryCurrent newInventory `shouldBe` mempty - length (inventoryHistory newInventory) `shouldBe` 1 - length historyItem `shouldBe` 1 - foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 10 - - it "can close initial stock item with loss" $ do - let (historyItem, newInventory) = updateManyVP [(day 1, 2, 10), (day 2, 1, -10)] - - inventoryTotal newInventory `shouldBe` 0 - inventoryCurrent newInventory `shouldBe` mempty - length (inventoryHistory newInventory) `shouldBe` 1 - length historyItem `shouldBe` 1 - foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` -10 - - -testInventoryAlternate :: SpecWith () -testInventoryAlternate = do - it "can switch from long to short" $ do - let (historyItem, newInventory) = updateManyVP [(day 1, 1, 10), (day 2, 1, -15)] - - inventoryTotal newInventory `shouldBe` -5 - length (inventoryCurrent newInventory) `shouldBe` 1 - length (inventoryHistory newInventory) `shouldBe` 1 - length historyItem `shouldBe` 1 - foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 0 - - it "can switch from short to long" $ do - let (historyItem, newInventory) = updateManyVP [(day 1, 1, -10), (day 2, 1, 15)] - - inventoryTotal newInventory `shouldBe` 5 - length (inventoryCurrent newInventory) `shouldBe` 1 - length (inventoryHistory newInventory) `shouldBe` 1 - length historyItem `shouldBe` 1 - foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 0 - - it "can alternate between long and short" $ do - let (historyItem, newInventory) = updateManyVP [(day 1, 1, 10), (day 2, 1, -15), (day 3, 1, 20)] - - inventoryTotal newInventory `shouldBe` 15 - length (inventoryCurrent newInventory) `shouldBe` 1 - length (inventoryHistory newInventory) `shouldBe` 2 - length historyItem `shouldBe` 1 - foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 0 - - -testInventoryScenario1 :: SpecWith () -testInventoryScenario1 = do - it "can perform complex stuff" $ do - let events = - [ (day 1, 1, 10) - , (day 2, 2, -15) - , (day 3, 1, 0) - , (day 4, 1, 5) - , (day 5, 1, 0) - , (day 6, 1, 5) - , (day 7, 1, -5) - , (day 8, 1, -15) - , (day 9, 1, -10) - , (day 10, 1, 25) - , (day 11, 1, 0) - , (day 12, 1, 15) - , (day 13, 2, 10) - , (day 14, 3, -10) - , (day 15, 4, -15) - ] - - let (historyItem, newInventory) = updateManyVP events - - inventoryTotal newInventory `shouldBe` 0 - inventoryTotal newInventory `shouldBe` foldl' (\a (_, _, x) -> a + x) 0 events - length (inventoryCurrent newInventory) `shouldBe` 0 - length (inventoryHistory newInventory) `shouldBe` 8 - length historyItem `shouldBe` 2 - foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 (inventoryHistory newInventory) `shouldBe` 70 - - --- * Helper Functions - - -day :: Integer -> Time.Day -day t = Time.addDays t (read "2020-01-01") - - -updateMany - :: [TestInventoryEvent] - -> (Seq.Seq TestInventoryHistoryItem, TestInventory) -updateMany = foldl' (\(_, s) i -> updateInventory i s) (mempty, initInventory) - - -updateManyVP - :: [(Time.Day, Quantity 8, Quantity 12)] - -> (Seq.Seq TestInventoryHistoryItem, TestInventory) -updateManyVP = updateMany . fmap (\(x, y, z) -> InventoryEvent x y z) diff --git a/test/doctest/doctest.hs b/test/doctest/doctest.hs new file mode 100644 --- /dev/null +++ b/test/doctest/doctest.hs @@ -0,0 +1,5 @@ +import Test.DocTest (doctest) + + +main :: IO () +main = doctest ["-isrc", "src"] diff --git a/test/spec/Spec.hs b/test/spec/Spec.hs new file mode 100644 --- /dev/null +++ b/test/spec/Spec.hs @@ -0,0 +1,6 @@ +import Tests.Haspara.Accounting.Inventory (testInventory) + + +main :: IO () +main = do + testInventory diff --git a/test/spec/Tests/Haspara/Accounting/Inventory.hs b/test/spec/Tests/Haspara/Accounting/Inventory.hs new file mode 100644 --- /dev/null +++ b/test/spec/Tests/Haspara/Accounting/Inventory.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} + +module Tests.Haspara.Accounting.Inventory where + +import Data.Default (def) +import Data.Foldable (foldl') +import qualified Data.Sequence as Seq +import qualified Data.Time as Time +import Haspara.Accounting.Inventory (Inventory (..), InventoryEvent (..), InventoryHistoryItem (..), updateInventory, updateInventoryVP) +import Haspara.Quantity (Quantity) +import Test.Hspec (SpecWith, describe, hspec, it, shouldBe) + + +-- * Core Definitions + + +-- | Type definition for the inventory type used in this module. +type TestInventory = Inventory 8 12 2 + + +-- | Type definition for the inventory type used in this module. +type TestInventoryEvent = InventoryEvent 8 12 + + +-- | Type definition for the inventory history item used in this module. +type TestInventoryHistoryItem = InventoryHistoryItem 8 12 2 + + +-- | Initial inventory. +initInventory :: TestInventory +initInventory = def @TestInventory + + +testInventory :: IO () +testInventory = hspec $ do + describe "Inventory Functionality" $ do + testInitialInventory + testInitialInventoryEvent + testInventoryCloseProfit + testInventoryAlternate + testInventoryScenario1 + + +-- * Test Specs + + +testInitialInventory :: SpecWith () +testInitialInventory = + it "initial inventory is empty" $ do + inventoryTotal initInventory `shouldBe` 0 + inventoryCurrent initInventory `shouldBe` mempty + inventoryHistory initInventory `shouldBe` mempty + + +testInitialInventoryEvent :: SpecWith () +testInitialInventoryEvent = do + it "can add initial inventory increment event" $ do + let (historyItem, newInventory) = updateInventoryVP (day 1) 1 10 initInventory + + inventoryTotal newInventory `shouldBe` 10 + length (inventoryCurrent newInventory) `shouldBe` 1 + inventoryHistory newInventory `shouldBe` mempty + historyItem `shouldBe` mempty + + it "can add initial inventory decrement event" $ do + let (historyItem, newInventory) = updateInventoryVP (day 1) 1 (-10) initInventory + + inventoryTotal newInventory `shouldBe` (-10) + length (inventoryCurrent newInventory) `shouldBe` 1 + inventoryHistory newInventory `shouldBe` mempty + historyItem `shouldBe` mempty + + +testInventoryCloseProfit :: SpecWith () +testInventoryCloseProfit = do + it "can close initial stock item with no-profit" $ do + let (historyItem, newInventory) = updateManyVP [(day 1, 1, 10), (day 2, 1, -10)] + + inventoryTotal newInventory `shouldBe` 0 + inventoryCurrent newInventory `shouldBe` mempty + length (inventoryHistory newInventory) `shouldBe` 1 + length historyItem `shouldBe` 1 + foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 0 + + it "can close initial stock item with profit" $ do + let (historyItem, newInventory) = updateManyVP [(day 1, 1, 10), (day 2, 2, -10)] + + inventoryTotal newInventory `shouldBe` 0 + inventoryCurrent newInventory `shouldBe` mempty + length (inventoryHistory newInventory) `shouldBe` 1 + length historyItem `shouldBe` 1 + foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 10 + + it "can close initial stock item with loss" $ do + let (historyItem, newInventory) = updateManyVP [(day 1, 2, 10), (day 2, 1, -10)] + + inventoryTotal newInventory `shouldBe` 0 + inventoryCurrent newInventory `shouldBe` mempty + length (inventoryHistory newInventory) `shouldBe` 1 + length historyItem `shouldBe` 1 + foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` -10 + + +testInventoryAlternate :: SpecWith () +testInventoryAlternate = do + it "can switch from long to short" $ do + let (historyItem, newInventory) = updateManyVP [(day 1, 1, 10), (day 2, 1, -15)] + + inventoryTotal newInventory `shouldBe` -5 + length (inventoryCurrent newInventory) `shouldBe` 1 + length (inventoryHistory newInventory) `shouldBe` 1 + length historyItem `shouldBe` 1 + foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 0 + + it "can switch from short to long" $ do + let (historyItem, newInventory) = updateManyVP [(day 1, 1, -10), (day 2, 1, 15)] + + inventoryTotal newInventory `shouldBe` 5 + length (inventoryCurrent newInventory) `shouldBe` 1 + length (inventoryHistory newInventory) `shouldBe` 1 + length historyItem `shouldBe` 1 + foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 0 + + it "can alternate between long and short" $ do + let (historyItem, newInventory) = updateManyVP [(day 1, 1, 10), (day 2, 1, -15), (day 3, 1, 20)] + + inventoryTotal newInventory `shouldBe` 15 + length (inventoryCurrent newInventory) `shouldBe` 1 + length (inventoryHistory newInventory) `shouldBe` 2 + length historyItem `shouldBe` 1 + foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 historyItem `shouldBe` 0 + + +testInventoryScenario1 :: SpecWith () +testInventoryScenario1 = do + it "can perform complex stuff" $ do + let events = + [ (day 1, 1, 10) + , (day 2, 2, -15) + , (day 3, 1, 0) + , (day 4, 1, 5) + , (day 5, 1, 0) + , (day 6, 1, 5) + , (day 7, 1, -5) + , (day 8, 1, -15) + , (day 9, 1, -10) + , (day 10, 1, 25) + , (day 11, 1, 0) + , (day 12, 1, 15) + , (day 13, 2, 10) + , (day 14, 3, -10) + , (day 15, 4, -15) + ] + + let (historyItem, newInventory) = updateManyVP events + + inventoryTotal newInventory `shouldBe` 0 + inventoryTotal newInventory `shouldBe` foldl' (\a (_, _, x) -> a + x) 0 events + length (inventoryCurrent newInventory) `shouldBe` 0 + length (inventoryHistory newInventory) `shouldBe` 8 + length historyItem `shouldBe` 2 + foldl' (\x y -> x + inventoryHistoryItemPnl y) 0 (inventoryHistory newInventory) `shouldBe` 70 + + +-- * Helper Functions + + +day :: Integer -> Time.Day +day t = Time.addDays t (read "2020-01-01") + + +updateMany + :: [TestInventoryEvent] + -> (Seq.Seq TestInventoryHistoryItem, TestInventory) +updateMany = foldl' (\(_, s) i -> updateInventory i s) (mempty, initInventory) + + +updateManyVP + :: [(Time.Day, Quantity 8, Quantity 12)] + -> (Seq.Seq TestInventoryHistoryItem, TestInventory) +updateManyVP = updateMany . fmap (\(x, y, z) -> InventoryEvent x y z) diff --git a/test/test.hs b/test/test.hs deleted file mode 100644 --- a/test/test.hs +++ /dev/null @@ -1,6 +0,0 @@ -import Tests.Haspara.Accounting.Inventory (testInventory) - - -main :: IO () -main = do - testInventory