├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── app └── Main.hs ├── ddd.cabal ├── src ├── Account │ ├── Checking.hs │ ├── Classes.hs │ └── Savings.hs ├── AccountRepository.hs ├── AccountRepositoryF.hs ├── Aliases.hs ├── ErrorList.hs ├── Lib.hs └── LoanApplication.hs ├── stack.yaml └── test └── Spec.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | .HTF/ -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell DDD Playground 2 | 3 | This repo contains random pieces of code loosely related to the book [Functional and Reactive Domain Modeling](https://www.manning.com/books/functional-and-reactive-domain-modeling), adapted for Haskell since I personally dislike Scala. It's not supposed to be used as a cohesive application - instead, it's more of a dumping ground for ideas as I read through the book. 4 | 5 | ### Key Insights 6 | 7 | - Use type classes for polymorphism; at first I thought it would be a good idea to use a simple sum type with the commonalities between all data types extracted to a separate product type, but it turns out type classes do a better job at "making impossible states impossible". 8 | 9 | - Defining entities in terms of a type class + a concrete type that implements it seems a bit heavy-handed at first, but pays of in the long run if polymorphism suddenly becomes necessary (or if the data type needs to be extended to "behave like" something else). This is the "I" on SOLID applied to FP. Not 100% convinced this is the best way to go as it may increase complexity early on, but it makes sense to at least consider. 10 | 11 | - "Smart constructors": hiding the default data constructors for a type and providing custom functions to replace them is good practice as it makes it impossible to create entities/values that do not make sense from a business point of view (ie. a date range where the end date happens before the start date). 12 | 13 | - Get well acquainted with the basics of category theory and learn to spot opportunities to use certain common abstractions. These are particularly useful: 14 | - `Semigroup`: useful when two values of a type have to be combined; 15 | - `Monoid`: useful when two values of a type have to be combined and an "identity" value is required (ie. as the initial accumulator value in a fold operation); 16 | - `Functor`: useful when a unary function has to be lifted into a computational context (ie. applying a function of type `Int -> a` to a value of type `Maybe Int` to get a `Maybe a`); 17 | - `Applicative`: useful when the result of an operation depends on executing several other individual, independent operations that can potentially be parallelized; from a source code perspective, applicatives are ideal candidates when a function of arbitrary arity has to be lifted into a computation context - in that sense, it's like a functor on steroids; 18 | - `Monad`: useful when the result of an operation depends on executing a chain of interdependent operations (in other words, a sequence of steps where each step needs the result of the previous one to be computed). 19 | 20 | - When figuring out which algebra to use, pick the weakest (most generic) possible to maximize reuse opportunities. This is particularly important when picking between using `Applicative` or `Monad` as the parallelizable nature of `Applicative` may also lead to performance improvements. 21 | 22 | - Functions that return monads can be composed just like regular functions with Kleisli composition; in Haskell, this is done with the `>=>` and `<=<` operators, ie. `(a -> m b) >=> (b -> m c) -> (a -> m c)`. 23 | - The Kleisli data type can be used to represent a computation that is waiting for a value to run and produce another value. Since Kleisli is a monad, operations of this type can be composed together in larger operations and then be all triggered at once by passing in the "missing" value; 24 | - The most common type of Kleisli seen in the wild is the `Reader` monad, which is usually used to inject environment configuration into a group of operations (ie. a database, global configuration parameters, a logger, etc); 25 | - The `State` monad is also a common specialization of Kleisli, and is used to inject some state (that can be modified) into a group of operations 26 | 27 | - The first step when modeling a domain service is defining its algebra (ie. a group of operations), expressed in terms of functions and types that follow the ubiquitous language. The actual types and concrete instances of the service come later. 28 | 29 | - If a domain service is used to represent a business process, its algebra should define functions that reflect the operations contained in that process. Pay special attention to function types so they "align", maximizing opportunities for composition. 30 | 31 | - Once the invariants of a service have been defined, use the type system to try and enforce them statically, ie. with phantom types. The ultimate goal is to make any code that would cause a business invariant violation to not even compile. 32 | 33 | - Separate code in modules and be mindful what they export. Ideally, a module will only export data types and functions that follow the ubiquitous language. Modules can also be used to enforce business invariants (ie. by not exporting default data constructors, providing smart constructors instead). 34 | 35 | - The book recommends exporting the algebra of a service in a module and its specific implementations in a separate module to allow for easy swapping of implementations in different contexts (ie. testing). Again, not 100% convinced that type classes should be used this much as it adds heaps of boilerplate and noise to an otherwise simple scenario. 36 | 37 | - Another way of separating algebra from implementation is using the `Free Monad` pattern. In that case, the module would expose composable, domain-specific functions that can be used as building blocks to a bigger computation, representing that computation as data (without actually performing it). Then, different interpreters can be written to actually execute the computation in whatever way they choose. 38 | - Free monads can be used to model operations that would normally be impure in a pure way by pushing the actual impurity down the line, to the interpreter level 39 | - Free monads are difficult to understand and grasp, so consider that before using them all over the place 40 | 41 | - Large applications are composed of multiple bounded contexts that often have to work together to achieve a meaningful purpose. Reactive models accept and embrace that fact by making the interactions between those contexts explicit, aiming for loose coupling, fault-tolerance and resilience. There are several strategies to achieve that, for example: 42 | - `Future`/`Promise` based APIs 43 | - Asynchronous messaging through `Message Queues` 44 | - `Streams` with demand-driven interaction between producers and consumers 45 | - Lightweight `Actors` with mailboxes and message-passing 46 | 47 | - By design, actors aren't great at maintaining type safety and referential transparency. They're used for supervision, which means exceptions outside of the control of the application could happen at runtime. In strong typed languages like Haskell and Scala, they might not be the best choice - consider alternatives. 48 | 49 | - Erlang (and by extension Elixir) are completely built on top of actors and use that as the single strategy for parallelism. In those languages, actors can be pushed to do more - for example, domain entities can be modeled as actors. This can be particularly helpful with event sourcing and CQRS approaches. _TODO: explore this concept in an Elixir repo._ 50 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Account.Savings (savingsAccount) 4 | import Aliases 5 | import Data.DateTime (getCurrentTime) 6 | import Data.Validation (AccValidation(..)) 7 | import Text.Read (readMaybe) 8 | 9 | main :: IO () 10 | main = do 11 | putStrLn "Opening savings account..." 12 | putStr "Account ID: " 13 | now <- getCurrentTime 14 | aId <- getLine 15 | interest <- getInterest 16 | case savingsAccount aId interest now of 17 | AccFailure errors -> do 18 | putStrLn "There were errors opening the account:" 19 | putStr $ show errors 20 | AccSuccess account -> do 21 | putStrLn "Account opened successfully!" 22 | putStrLn $ show account 23 | 24 | getInterest :: IO InterestRate 25 | getInterest = do 26 | putStr "Interest Rate: " 27 | interest <- getLine 28 | case readMaybe interest of 29 | Just interest' -> return interest' 30 | Nothing -> do 31 | putStrLn "Could not parse interest rate. Please try a decimal number." 32 | getInterest 33 | -------------------------------------------------------------------------------- /ddd.cabal: -------------------------------------------------------------------------------- 1 | name: ddd 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/githubuser/ddd#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Author name here 9 | maintainer: example@example.com 10 | copyright: 2017 Author name here 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Lib 19 | , Aliases 20 | , Account.Classes 21 | , Account.Checking 22 | , Account.Savings 23 | , ErrorList 24 | , AccountRepositoryF 25 | build-depends: base >= 4.7 && < 5 26 | , datetime 27 | , lens 28 | , validation 29 | , containers 30 | , free 31 | , transformers 32 | default-language: Haskell2010 33 | 34 | executable ddd-exe 35 | hs-source-dirs: app 36 | main-is: Main.hs 37 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 38 | build-depends: base 39 | , ddd 40 | , datetime 41 | , validation 42 | , containers 43 | , free 44 | , transformers 45 | default-language: Haskell2010 46 | 47 | test-suite ddd-test 48 | type: exitcode-stdio-1.0 49 | hs-source-dirs: test 50 | main-is: Spec.hs 51 | build-depends: base 52 | , ddd 53 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 54 | default-language: Haskell2010 55 | 56 | source-repository head 57 | type: git 58 | location: https://github.com/githubuser/ddd 59 | -------------------------------------------------------------------------------- /src/Account/Checking.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Account.Checking where 4 | 5 | import Account.Classes 6 | import Aliases 7 | import Control.Lens 8 | import Data.DateTime 9 | 10 | data CheckingAccount = CheckingAccount 11 | { _cAccountId :: String 12 | , _cName :: String 13 | , _cBalance :: Amount 14 | , _cDateOpen :: DateTime 15 | , _cDateClosed :: Maybe DateTime 16 | } 17 | 18 | makeLenses ''CheckingAccount 19 | 20 | instance Show CheckingAccount where 21 | show (CheckingAccount i n b _ _) = i ++ " - " ++ n ++ ": $" ++ (show b) 22 | 23 | instance Account CheckingAccount where 24 | accountId = cAccountId 25 | name = cName 26 | balance = cBalance 27 | dateClosed = cDateClosed 28 | -------------------------------------------------------------------------------- /src/Account/Classes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | 3 | module Account.Classes where 4 | 5 | import Aliases 6 | import Control.Lens 7 | import Data.DateTime 8 | 9 | data AccountError 10 | = InsufficientFunds 11 | | AccountClosed 12 | deriving (Eq, Show) 13 | 14 | class Account a where 15 | {-# MINIMAL (accountId, name, balance, dateClosed) #-} 16 | accountId :: Lens' a String 17 | name :: Lens' a String 18 | balance :: Lens' a Amount 19 | dateClosed :: Lens' a (Maybe DateTime) 20 | 21 | isClosed :: Account a => a -> Bool 22 | isClosed account 23 | | view dateClosed account == Nothing = False 24 | | otherwise = True 25 | 26 | credit :: Account a => a -> Amount -> Either AccountError a 27 | credit account amount 28 | | isClosed account = Left AccountClosed 29 | | otherwise = Right $ over balance (+ amount) account 30 | 31 | debit :: Account a => a -> Amount -> Either AccountError a 32 | debit account amount 33 | | isClosed account = Left AccountClosed 34 | | view balance account < amount = Left InsufficientFunds 35 | | otherwise = Right $ over balance (subtract amount) account 36 | 37 | transfer :: 38 | (Account a, Account b) => a -> b -> Amount -> Either AccountError (a, b) 39 | transfer source destination amount = do 40 | source' <- debit source amount 41 | destination' <- credit destination amount 42 | return (source', destination') 43 | 44 | class InterestBearingAccount a where 45 | {-# MINIMAL (interestRate) #-} 46 | interestRate :: Lens' a InterestRate 47 | -------------------------------------------------------------------------------- /src/Account/Savings.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Account.Savings 4 | ( SavingsAccount 5 | , ValidationError 6 | , savingsAccount 7 | ) where 8 | 9 | import Account.Classes 10 | import Aliases 11 | import Control.Lens 12 | import Data.DateTime 13 | import Data.Validation (AccValidation(..)) 14 | import ErrorList 15 | 16 | data ValidationError 17 | = AccountIdTooShort 18 | | NegativeInterest 19 | 20 | instance Show ValidationError where 21 | show AccountIdTooShort = "Account ID must be at least 10 characters long" 22 | show NegativeInterest = "Interest Rate must be positive" 23 | 24 | data SavingsAccount = SavingsAccount 25 | { _sId :: String 26 | , _sName :: String 27 | , _sBalance :: Amount 28 | , _sInterestRate :: InterestRate 29 | , _sDateOpen :: DateTime 30 | , _sDateClosed :: Maybe DateTime 31 | } 32 | 33 | makeLenses ''SavingsAccount 34 | 35 | instance Show SavingsAccount where 36 | show (SavingsAccount i n b _ _ _) = i ++ " - " ++ n ++ ": $" ++ (show b) 37 | 38 | instance Account SavingsAccount where 39 | accountId = sId 40 | name = sName 41 | balance = sBalance 42 | dateClosed = sDateClosed 43 | 44 | instance InterestBearingAccount SavingsAccount where 45 | interestRate = sInterestRate 46 | 47 | validateId :: String -> AccValidation (ErrorList ValidationError) String 48 | validateId aId 49 | | length aId < 10 = AccFailure $ ErrorList [AccountIdTooShort] 50 | | otherwise = AccSuccess aId 51 | 52 | validateInterestRate :: 53 | InterestRate -> AccValidation (ErrorList ValidationError) InterestRate 54 | validateInterestRate interest 55 | | interest <= 0 = AccFailure $ ErrorList [NegativeInterest] 56 | | otherwise = AccSuccess interest 57 | 58 | savingsAccount :: 59 | String 60 | -> InterestRate 61 | -> DateTime 62 | -> AccValidation (ErrorList ValidationError) SavingsAccount 63 | savingsAccount aId interest date = 64 | SavingsAccount <$> validateId aId <*> AccSuccess "Savings Account" <*> 65 | AccSuccess 0 <*> 66 | validateInterestRate interest <*> 67 | AccSuccess date <*> 68 | AccSuccess Nothing 69 | -------------------------------------------------------------------------------- /src/AccountRepository.hs: -------------------------------------------------------------------------------- 1 | module AccountRepository where 2 | 3 | import Data.Map (Map, (!), fromList, insert, lookup) 4 | import Prelude hiding (lookup) 5 | 6 | data MyAccount = MyAccount 7 | { accNumber :: String 8 | , accBalance :: Double 9 | } deriving (Show) 10 | 11 | class AccountRepository a where 12 | query :: a -> String -> Either [String] (Maybe MyAccount) 13 | store :: a -> MyAccount -> Either [String] (MyAccount, a) 14 | balance :: a -> String -> Either [String] Double 15 | balance repo accountNumber = 16 | case query repo accountNumber of 17 | Left errors -> Left errors 18 | Right Nothing -> Left ["No account with this number"] 19 | Right (Just account) -> Right $ accBalance account 20 | 21 | data InMemoryAccountRepository = 22 | Repo (Map String MyAccount) 23 | deriving (Show) 24 | 25 | instance AccountRepository InMemoryAccountRepository where 26 | query (Repo repo) accountNumber = Right $ lookup accountNumber repo 27 | store (Repo repo) account = 28 | Right $ (updatedRepo ! accountNumber, Repo updatedRepo) 29 | where 30 | accountNumber = accNumber account 31 | updatedRepo = insert accountNumber account repo 32 | 33 | go :: Either [String] (Maybe MyAccount, Maybe MyAccount, Double) 34 | go = do 35 | let repo = Repo (fromList []) 36 | acc <- query repo "thiago" 37 | (_, repo') <- store repo (MyAccount "thiago" 124.5) 38 | acc' <- query repo' "thiago" 39 | bal <- balance repo' "thiago" 40 | return (acc, acc', bal) 41 | -------------------------------------------------------------------------------- /src/AccountRepositoryF.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | {-# LANGUAGE TypeSynonymInstances #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | 6 | module AccountRepositoryF where 7 | 8 | import Control.Monad.Free 9 | import Control.Monad.Trans.Class 10 | import Control.Monad.Trans.State 11 | import Data.Map (Map, delete, empty, insert, lookup) 12 | import Prelude hiding (lookup) 13 | 14 | data AnAccount = AnAccount 15 | { accNumber :: String 16 | , accName :: String 17 | } deriving (Show) 18 | 19 | data AccountRepoActionF next 20 | = Query String 21 | (AnAccount -> next) 22 | | Store AnAccount 23 | next 24 | | Remove String 25 | next 26 | deriving (Functor) 27 | 28 | type AccountRepoAction = Free AccountRepoActionF 29 | 30 | query :: String -> AccountRepoAction AnAccount 31 | query accountNumber = liftF $ Query accountNumber id 32 | 33 | store :: AnAccount -> AccountRepoAction () 34 | store account = liftF $ Store account () 35 | 36 | remove :: String -> AccountRepoAction () 37 | remove accountNumber = liftF $ Remove accountNumber () 38 | 39 | update :: String -> (AnAccount -> AnAccount) -> AccountRepoAction () 40 | update accountNumber f = do 41 | account <- query accountNumber 42 | store (f account) 43 | 44 | open :: String -> String -> AccountRepoAction AnAccount 45 | open number name = do 46 | store $ AnAccount number name 47 | account <- query number 48 | return account 49 | 50 | -- 51 | class AccountRepository r where 52 | apply :: AccountRepoAction a -> r a 53 | 54 | -- 55 | type InMemoryRepo = Map String AnAccount 56 | 57 | type InMemoryRepoState = StateT InMemoryRepo (Either [String]) 58 | 59 | instance AccountRepository InMemoryRepoState where 60 | apply action = 61 | case action of 62 | Free (Query accountNumber next) -> do 63 | maybeAccount <- gets (lookup accountNumber) 64 | case maybeAccount of 65 | Nothing -> lift $ Left ["Account does not exist"] 66 | Just account -> apply (next account) 67 | Free (Store account next) -> 68 | (modify $ insert (accNumber account) account) >> apply next 69 | Free (Remove accountNumber next) -> 70 | (modify $ delete accountNumber) >> apply next 71 | Pure a -> return a 72 | 73 | -- 74 | emptyRepo :: InMemoryRepo 75 | emptyRepo = empty 76 | 77 | anAccount :: AnAccount 78 | anAccount = AnAccount "123" "Thiago" 79 | 80 | changeName :: String -> AnAccount -> AnAccount 81 | changeName name account = account {accName = name} 82 | 83 | testCompS :: AccountRepoAction () 84 | testCompS = do 85 | open "123" "Thiago" 86 | open "456" "Campezzi" 87 | remove "456" 88 | open "789" "Mr. Bean" 89 | update "123" (changeName "Mr. Happy") 90 | 91 | testCompF :: AccountRepoAction () 92 | testCompF = do 93 | query "abc" 94 | testCompS 95 | 96 | testApplyS :: Either [String] ((), InMemoryRepo) 97 | testApplyS = runStateT (apply testCompS) emptyRepo 98 | 99 | testApplyF :: Either [String] ((), InMemoryRepo) 100 | testApplyF = runStateT (apply testCompF) emptyRepo 101 | -------------------------------------------------------------------------------- /src/Aliases.hs: -------------------------------------------------------------------------------- 1 | module Aliases where 2 | 3 | type Amount = Double 4 | 5 | type InterestRate = Double 6 | -------------------------------------------------------------------------------- /src/ErrorList.hs: -------------------------------------------------------------------------------- 1 | module ErrorList where 2 | 3 | import Data.Semigroup 4 | 5 | newtype ErrorList a = 6 | ErrorList [a] 7 | 8 | instance Semigroup (ErrorList a) where 9 | ErrorList x <> ErrorList y = ErrorList $ x <> y 10 | 11 | instance (Show a) => Show (ErrorList a) where 12 | show (ErrorList []) = "" 13 | show (ErrorList (x:xs)) = "- " ++ (show x) ++ "\n" ++ (show (ErrorList xs)) 14 | -------------------------------------------------------------------------------- /src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib where 2 | 3 | import Account.Checking 4 | import Account.Savings 5 | import Data.DateTime 6 | import Data.Validation (AccValidation(..)) 7 | import ErrorList 8 | 9 | testDate :: DateTime 10 | testDate = fromGregorian 2017 6 19 22 30 00 11 | 12 | testCheckingAccount :: CheckingAccount 13 | testCheckingAccount = 14 | CheckingAccount "CHK-124" "Checking Account" 500 testDate Nothing 15 | 16 | testSavingsAccount :: AccValidation (ErrorList ValidationError) SavingsAccount 17 | testSavingsAccount = savingsAccount "SAVINGS-001" 0.02 testDate 18 | -------------------------------------------------------------------------------- /src/LoanApplication.hs: -------------------------------------------------------------------------------- 1 | module LoanApplication where 2 | 3 | import Data.DateTime (DateTime, fromGregorian) 4 | 5 | data Applied 6 | 7 | data Approved 8 | 9 | data Enriched 10 | 11 | data LoanApplication a = LoanApplication 12 | { date :: DateTime 13 | , name :: String 14 | , purpose :: String 15 | , repayIn :: Int 16 | , actualRepaymentYears :: Maybe Int 17 | , startDate :: Maybe DateTime 18 | , loanNo :: Maybe String 19 | , emi :: Maybe Double 20 | } deriving (Show) 21 | 22 | applyLoan :: String -> String -> Int -> DateTime -> LoanApplication Applied 23 | applyLoan name' purpose' repayIn' date' = 24 | LoanApplication date' name' purpose' repayIn' Nothing Nothing Nothing Nothing 25 | 26 | approve :: LoanApplication Applied -> Maybe (LoanApplication Approved) 27 | approve loan = 28 | Just 29 | loan 30 | { loanNo = Just "SomeLoanNumber" 31 | , actualRepaymentYears = Just 15 32 | , startDate = Just $ fromGregorian 2017 07 03 23 10 00 33 | } 34 | 35 | enrich :: LoanApplication Approved -> Maybe (LoanApplication Enriched) 36 | enrich loan = do 37 | actualRepaymentYears' <- actualRepaymentYears loan 38 | return loan {emi = Just $ fromIntegral actualRepaymentYears'} 39 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | extra-package-dbs: [] 3 | packages: 4 | - '.' 5 | extra-deps: 6 | - datetime-0.3.1 7 | resolver: lts-8.18 8 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | --------------------------------------------------------------------------------