├── Chapter4. IO in Haskell ├── Exercises │ ├── 05. Todo list │ │ ├── todo.txt │ │ ├── remainingTasks.txt │ │ └── problem.txt │ ├── 04. Files and Handles │ │ ├── what.txt │ │ ├── goodbye.txt │ │ ├── hello.txt │ │ ├── stats.dat │ │ ├── hello_file.hs │ │ ├── goodbye.hs │ │ ├── dumpFile.hs │ │ └── fileCounts.hs │ ├── 03. Lazy IO │ │ ├── sum_lazy.hs │ │ └── lazy.hs │ ├── 01. Basic IO Operations │ │ ├── Reverse.hs │ │ ├── ReturnKeyword.hs │ │ ├── Computation.hs │ │ ├── DoNotation.hs │ │ ├── Hello.hs │ │ └── Pizza.hs │ └── 02. Programming with actions │ │ ├── toDoList.hs │ │ ├── sequence.hs │ │ └── Fir.hs ├── readme.md └── A brief introduction.md ├── Chapter6. Computational effects ├── Examples │ ├── Writer │ │ └── 01.Writer.hs │ ├── State │ │ ├── 01.State.hs │ │ └── 02.Stack.hs │ └── Reader │ │ ├── 02.RulesAlgebra.hs │ │ ├── 05.MindTrickReader.hs │ │ ├── .vscode │ │ └── tasks.json │ │ ├── 04.MindTrick.hs │ │ ├── 06.MindTrickMonadReader.hs │ │ ├── 07.MessagingPipeline.hs │ │ ├── 01.Reader.hs │ │ ├── 03.RulesAlgebraWithLenses.hs │ │ ├── 10.GqlQueries2.hs │ │ ├── 09.GqlQueries.hs │ │ ├── 11.GqlQueries3.hs │ │ └── 12.GqlQueries4.hs ├── logo.jpg └── readme.md ├── Chapter8. JavaScript libraries ├── Sample │ ├── pipeline-algebra │ │ ├── .gitignore │ │ ├── .vscode │ │ │ ├── settings.json │ │ │ └── launch.json │ │ ├── jest.config.js │ │ ├── jsconfig.json │ │ ├── tslint.json │ │ ├── src │ │ │ ├── algebra.js │ │ │ ├── algebra.d.ts │ │ │ └── __tests__ │ │ │ │ └── algebra.tests.js │ │ ├── .eslintrc.json │ │ ├── package.json │ │ ├── tsconfig.json │ │ └── babel.config.js │ └── pure-validations │ │ ├── .gitignore │ │ ├── .vscode │ │ ├── settings.json │ │ └── launch.json │ │ ├── jest.config.js │ │ ├── jsconfig.json │ │ ├── tslint.json │ │ ├── src │ │ ├── primitiveValidators.js │ │ ├── __tests__ │ │ │ ├── ValidationResult.tests.js │ │ │ └── combinators.test.js │ │ ├── algebra.js │ │ └── combinators.js │ │ ├── .eslintrc.json │ │ ├── package.json │ │ ├── tsconfig.json │ │ └── babel.config.js ├── logo.jpg └── readme.md ├── logo.jpg ├── logo.png ├── Chapter2. The foundation ├── Exercises │ ├── 01.Recursion │ │ ├── 08.Repeat.hs │ │ ├── 01.Factorial.hs │ │ ├── 07.Reverse.hs │ │ ├── 04.Replicate.hs │ │ ├── 06.Skip.hs │ │ ├── 05.Take.hs │ │ ├── 09.Cycle.hs │ │ ├── 02.Fibonacci.hs │ │ ├── 10.Elem.hs │ │ ├── 03.Maximum.hs │ │ └── 11.Quicksort.hs │ └── 02.Hofs │ │ ├── 02.Filter.hs │ │ ├── 01.Map.hs │ │ ├── 03.Folds.hs │ │ └── 04.WhyFp.hs └── readme.md ├── Chapter7. FSharp microservices ├── logo.png ├── Sample │ └── NBB.Invoices.FSharp │ │ ├── Directory.Build.props │ │ ├── dependencies.props │ │ ├── NBB.Invoices.FSharp.Worker │ │ ├── Properties │ │ │ └── launchSettings.json │ │ ├── appsettings.json │ │ ├── NBB.Invoices.FSharp.Worker.fsproj │ │ └── Program.fs │ │ ├── NBB.Invoices.FSharp.Api │ │ ├── Properties │ │ │ └── launchSettings.json │ │ ├── appsettings.json │ │ ├── web.config │ │ ├── NBB.Invoices.FSharp.Api.fsproj │ │ ├── HttpHandlers.fs │ │ └── Program.fs │ │ ├── NBB.Invoices.FSharp │ │ ├── DataAccess.fs │ │ ├── Invoice │ │ │ ├── Script.fsx │ │ │ ├── Domain.fs │ │ │ ├── Application.fs │ │ │ └── Data.fs │ │ ├── NBB.Invoices.FSharp.fsproj │ │ └── Application.fs │ │ ├── .gitignore │ │ └── NBB.Invoices.FSharp.sln └── readme.md ├── Chapter3. Haskell's Type System ├── Exercises │ ├── 07.Guards.hs │ ├── 06.FunctionComposition.hs │ ├── 01. Built-in types │ │ ├── 04.ConvertingNumbers.hs │ │ ├── 03.TypeVariables.hs │ │ ├── 01.BasicTypes.hs │ │ └── 02.FunctionTypes.hs │ ├── 04. Parameterized types │ │ └── 01.ParameterizedTypes.hs │ ├── 02. Types algebra │ │ ├── 04.RecordTypes.hs │ │ ├── 03.ProductTypes.hs │ │ ├── 02.SumTypes.hs │ │ └── 01.TypeSynonims.hs │ ├── 05. Algebraic structures │ │ ├── 02.Monoid.hs │ │ └── 01.SemiGroup.hs │ └── 03. Type classes │ │ └── 01.TypeClasses.hs └── readme.md ├── Chapter5. Functors Applicatives & Monads ├── Examples │ ├── 01.Functor.hs │ ├── 03.FunctorInstances.hs │ ├── 02.Clean.hs │ ├── 03.Monad.hs │ └── 04.DataSource.hs └── readme.md ├── Chapter1. Inception ├── Exercises │ ├── 04.ChurchPairs.md │ ├── 01.ChurchBooleans.md │ ├── 02.ChurchNumerals.md │ ├── 05.ChurchLists.md │ └── 03.Factorial-a-la-1940.md └── readme.md └── README.md /Chapter4. IO in Haskell/Exercises/05. Todo list/todo.txt: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Writer/01.Writer.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/05. Todo list/remainingTasks.txt: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/04. Files and Handles/what.txt: -------------------------------------------------------------------------------- 1 | Hello world! -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/.gitignore: -------------------------------------------------------------------------------- 1 | node_modules 2 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/.gitignore: -------------------------------------------------------------------------------- 1 | node_modules 2 | -------------------------------------------------------------------------------- /logo.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/osstotalsoft/functional-guy/HEAD/logo.jpg -------------------------------------------------------------------------------- /logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/osstotalsoft/functional-guy/HEAD/logo.png -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/08.Repeat.hs: -------------------------------------------------------------------------------- 1 | repeat' x = x : repeat' x -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/04. Files and Handles/goodbye.txt: -------------------------------------------------------------------------------- 1 | Good bye world! 2 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/04. Files and Handles/hello.txt: -------------------------------------------------------------------------------- 1 | Hello world! 2 | Good bye world! -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/01.Factorial.hs: -------------------------------------------------------------------------------- 1 | factorial 0 = 1 2 | factorial n = n * factorial (n -1) -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/07.Reverse.hs: -------------------------------------------------------------------------------- 1 | reverse' [] = [] 2 | reverse' (x:xs) = reverse' xs ++ [x] -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/04.Replicate.hs: -------------------------------------------------------------------------------- 1 | replicate' 0 _ = [] 2 | replicate' n x = x : replicate' (n -1) x -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/06.Skip.hs: -------------------------------------------------------------------------------- 1 | skip' 0 xs = xs 2 | skip' _ [] = [] 3 | skip' n (_ : xs) = skip' (n -1) xs -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/05.Take.hs: -------------------------------------------------------------------------------- 1 | take' 0 _ = [] 2 | take' _ [] = [] 3 | take' n (x : xs) = x : take' (n -1) xs -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/09.Cycle.hs: -------------------------------------------------------------------------------- 1 | cycle' (x : xs) = x : cycle' (xs ++ [x]) 2 | 3 | test = take 5 . cycle' $ [1, 2] -------------------------------------------------------------------------------- /Chapter6. Computational effects/logo.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/osstotalsoft/functional-guy/HEAD/Chapter6. Computational effects/logo.jpg -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/osstotalsoft/functional-guy/HEAD/Chapter7. FSharp microservices/logo.png -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/logo.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/osstotalsoft/functional-guy/HEAD/Chapter8. JavaScript libraries/logo.jpg -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/02.Fibonacci.hs: -------------------------------------------------------------------------------- 1 | fibonacci 0 = 0 2 | fibonacci 1 = 1 3 | fibonacci n = fibonacci (n -1) + fibonacci (n -2) -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/Directory.Build.props: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/10.Elem.hs: -------------------------------------------------------------------------------- 1 | elem' _ [] = False 2 | elem' n (x : xs) = if n == x then True else elem' n xs 3 | 4 | test = 10000 `elem'` [1 ..] -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/03.Maximum.hs: -------------------------------------------------------------------------------- 1 | maximum' [] = error "maximum of empty list" 2 | maximum' [x] = x 3 | maximum' (x : xs) = max x (maximum' xs) 4 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/07.Guards.hs: -------------------------------------------------------------------------------- 1 | fizzBuzz n 2 | | n `mod` 3 == 0 && n `mod` 5 == 0 = "FizzBuzz" 3 | | n `mod` 3 == 0 = "Fizz" 4 | | n `mod` 5 == 0 = "Buzz" 5 | | otherwise = "Nothing" -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/02.Hofs/02.Filter.hs: -------------------------------------------------------------------------------- 1 | filter' _ [] = [] 2 | filter' f (x : xs) = if f x then x : filter' f xs else filter' f xs 3 | 4 | filterEven = filter' even 5 | 6 | filterGt0 = filter' (> 0) -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/dependencies.props: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5.2.1 4 | 5 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/06.FunctionComposition.hs: -------------------------------------------------------------------------------- 1 | inc :: Num a => a -> a 2 | inc x = x + 1 3 | 4 | double :: Num a => a -> a 5 | double x = x * 2 6 | 7 | incTheDouble x = inc (double x) 8 | 9 | incTheDouble' = inc . double -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "javascript.validate.enable": false, 3 | "javascript.format.enable": true, 4 | "prettier.printWidth": 150, 5 | "typescript.format.enable": false 6 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/jest.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | "verbose": true, 3 | testPathIgnorePatterns: ["/build/"], 4 | name: "pipeline-algebra", 5 | displayName: "pipeline-algebra" 6 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "javascript.validate.enable": false, 3 | "javascript.format.enable": true, 4 | "prettier.printWidth": 150, 5 | "typescript.format.enable": false 6 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/jest.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | "verbose": true, 3 | testPathIgnorePatterns: ["/build/"], 4 | name: "pure-validations", 5 | displayName: "pure-validations" 6 | } -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/03. Lazy IO/sum_lazy.hs: -------------------------------------------------------------------------------- 1 | toInts :: String -> [Int] 2 | toInts = map read . lines 3 | 4 | main :: IO () 5 | main = do 6 | userInput <- getContents 7 | let numbers = toInts userInput 8 | print (sum numbers) -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/04. Files and Handles/stats.dat: -------------------------------------------------------------------------------- 1 | hello.txt chars: 28 words: 5 lines: 2 2 | what.txt chars: 12 words: 2 lines: 1 3 | what.txt chars: 12 words: 2 lines: 1 4 | what.txt chars: 12 words: 2 lines: 1 5 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/04. Files and Handles/hello_file.hs: -------------------------------------------------------------------------------- 1 | import System.IO 2 | 3 | -- openFile :: FilePath -> IOMode -> IO Handle 4 | 5 | main :: IO () 6 | main = do 7 | myFile <- openFile "hello.txt" ReadMode 8 | hClose myFile 9 | putStrLn "done!" -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/01.Recursion/11.Quicksort.hs: -------------------------------------------------------------------------------- 1 | quicksort [] = [] 2 | quicksort (x : xs) = 3 | quicksort smallerThanX ++ [x] ++ quicksort biggerThanX 4 | where 5 | smallerThanX = filter (<= x) xs 6 | biggerThanX = filter (> x) xs 7 | 8 | test = quicksort $ reverse [1 .. 10] -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/02.Hofs/01.Map.hs: -------------------------------------------------------------------------------- 1 | incAll' [] = [] 2 | incAll' (x : xs) = x + 1 : incAll' xs 3 | 4 | doubleAll' [] = [] 5 | doubleAll' (x : xs) = x * 2 : doubleAll' xs 6 | 7 | map' _ [] = [] 8 | map' f (x : xs) = f x : map' f xs 9 | 10 | incAll = map (+ 1) 11 | 12 | doubleAll = map (* 2) -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/02.Hofs/03.Folds.hs: -------------------------------------------------------------------------------- 1 | foldl' _ a [] = a 2 | foldl' f a (x : xs) = foldl' f (f a x) xs 3 | 4 | foldr' _ a [] = a 5 | foldr' f a (x : xs) = f x (foldr' f a xs) 6 | 7 | sum' = foldr' (+) 0 8 | 9 | prod' = foldr' (*) 1 10 | 11 | testSum = sum' [1 .. 100] 12 | 13 | testProd = prod' [1 .. 10] -------------------------------------------------------------------------------- /Chapter5. Functors Applicatives & Monads/Examples/01.Functor.hs: -------------------------------------------------------------------------------- 1 | factorial :: Integer -> Integer 2 | factorial 0 = 1 3 | factorial n = n * factorial (n -1) 4 | 5 | maybeValue :: Maybe Integer 6 | maybeValue = Just 5 7 | 8 | ioValue :: IO Integer 9 | ioValue = do 10 | putStrLn "give me a number pls" 11 | read <$> getLine 12 | 13 | 14 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/01. Basic IO Operations/Reverse.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = do 3 | line <- getLine 4 | if null line 5 | then return () 6 | else do 7 | putStrLn $ reverseWords line 8 | main 9 | 10 | reverseWords :: String -> String 11 | reverseWords = unwords . map reverse . words 12 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/01. Built-in types/04.ConvertingNumbers.hs: -------------------------------------------------------------------------------- 1 | --myAverage aList = sum aList / length aList 2 | myAverage aList = sum aList / fromIntegral (length aList) 3 | myAverage' aList = sum aList `div` length aList 4 | 5 | 6 | half n = n / 2 7 | half' n = fromIntegral n / 2 8 | half'' = (`div` 2) 9 | 10 | 11 | y = 2 :: Int 12 | x = toInteger y -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/01. Basic IO Operations/ReturnKeyword.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = do 3 | return () 4 | return "HAHAHA" 5 | line <- getLine 6 | return "BLAH BLAH BLAH" 7 | return 4 8 | putStrLn line 9 | 10 | 11 | main' :: IO () 12 | main' = do 13 | a <- return "hell" 14 | b <- return "yeah!" 15 | putStrLn $ a ++ " " ++ b -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Worker/Properties/launchSettings.json: -------------------------------------------------------------------------------- 1 | { 2 | "profiles": { 3 | "NBB.Invoices.FSharp.Worker": { 4 | "commandName": "Project", 5 | "dotnetRunMessages": "true", 6 | "environmentVariables": { 7 | "DOTNET_ENVIRONMENT": "Development" 8 | } 9 | } 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/01. Built-in types/03.TypeVariables.hs: -------------------------------------------------------------------------------- 1 | --polymorhic fn 2 | identity :: a -> a 3 | identity x = x 4 | 5 | myChar :: Char 6 | myChar = identity 'a' 7 | 8 | myInteger :: Integer 9 | myInteger = identity 1 10 | 11 | 12 | --another polymorphic fn 13 | makeTriple :: a -> b -> c -> (a, b, c) 14 | makeTriple x y z = (x, y, z) 15 | 16 | myCar = makeTriple "BMW" "X5" 3.0 -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Api/Properties/launchSettings.json: -------------------------------------------------------------------------------- 1 | { 2 | "profiles": { 3 | "NBB.Invoices.FSharp.Api": { 4 | "commandName": "Project", 5 | "environmentVariables": { 6 | "ASPNETCORE_ENVIRONMENT": "Development" 7 | }, 8 | "applicationUrl": "https://localhost:5001;http://localhost:5000" 9 | } 10 | } 11 | } -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/04. Parameterized types/01.ParameterizedTypes.hs: -------------------------------------------------------------------------------- 1 | newtype Box a = Box a 2 | 3 | intInaBox = Box 1 4 | 5 | stringInABox = Box "candy" 6 | 7 | data Pair a b = Pair a b 8 | 9 | intAndBool :: Pair Integer Bool 10 | intAndBool = Pair 1 True 11 | 12 | oneAnd :: b -> Pair Integer b 13 | oneAnd = Pair 1 14 | 15 | oneAndGHello :: Pair Integer String 16 | oneAndGHello = oneAnd "hello" -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Api/appsettings.json: -------------------------------------------------------------------------------- 1 | { 2 | "Messaging": { 3 | "Env": "DEV", 4 | "Source": "Invoices.FSharp.Worker", 5 | "Nats": { 6 | "natsUrl": "YOUR_NATS_URL", 7 | "cluster": "faas-cluster", 8 | "clientId": "functional_guy", 9 | "qGroup": "NBB.Invoices.Worker", 10 | "durableName": "durable" 11 | } 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Worker/appsettings.json: -------------------------------------------------------------------------------- 1 | { 2 | "Messaging": { 3 | "Env": "DEV", 4 | "Source": "Invoices.FSharp.Worker", 5 | "Nats": { 6 | "natsUrl": "YOUR_NATS_URL", 7 | "cluster": "faas-cluster", 8 | "clientId": "functional_guy", 9 | "qGroup": "NBB.Invoices.Worker", 10 | "durableName": "durable" 11 | } 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/jsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "baseUrl": "./", 4 | "paths": { 5 | // "@totalsoft/zion": ["./packages/zion/src"], 6 | // "@totalsoft/zion/*": ["./packages/zion/src/*"], 7 | // "@totalsoft/react-state-lens": ["./packages/react-state-lens/src"], 8 | // "@totalsoft/react-state-lens/*": ["./packages/react-state-lens/src/*"] 9 | } 10 | } 11 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/jsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "baseUrl": "./", 4 | "paths": { 5 | // "@totalsoft/zion": ["./packages/zion/src"], 6 | // "@totalsoft/zion/*": ["./packages/zion/src/*"], 7 | // "@totalsoft/react-state-lens": ["./packages/react-state-lens/src"], 8 | // "@totalsoft/react-state-lens/*": ["./packages/react-state-lens/src/*"] 9 | } 10 | } 11 | } -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/01. Basic IO Operations/Computation.hs: -------------------------------------------------------------------------------- 1 | readAnIntegerFromAFile :: IO Int 2 | readAnIntegerFromAFile = return 2 3 | 4 | getMessage :: Int -> String 5 | getMessage int = "My computation resulted in: " ++ show int 6 | 7 | newComputation :: IO () 8 | newComputation = do 9 | int <- readAnIntegerFromAFile -- we "bind" the result of readAnIntegerFromAFile to a name, 'int' 10 | putStrLn $ getMessage int -- 'int' holds a value of type Int 11 | -------------------------------------------------------------------------------- /Chapter5. Functors Applicatives & Monads/readme.md: -------------------------------------------------------------------------------- 1 | # Chapter5. Functors Applicatives & Monads 2 | 3 | ## Goals 4 | - Understand the Functor type class 5 | - Understand the Applicative type class 6 | - Understand the Monad type class 7 | 8 | ## Curricula 9 | - Get Programming with Haskell - Unit 5 10 | 11 | ## Examples 12 | - [`Computational Effects in C#`](https://github.com/oncicaradupopovici/CSharpEffects) 13 | - See folder [`Examples`](./Examples) 14 | 15 | 16 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/02. Types algebra/04.RecordTypes.hs: -------------------------------------------------------------------------------- 1 | data Cube = Cube 2 | { width :: Int, 3 | height :: Int, 4 | depth :: Int 5 | } 6 | 7 | cube1 = Cube {width = 1, height = 1, depth = 1} 8 | 9 | cube2 = Cube 1 1 1 10 | 11 | cube3 = cube2 {depth = 2} 12 | 13 | w1 = width cube1 14 | 15 | w2 = width cube2 16 | 17 | 18 | show'' :: Cube -> String 19 | show'' cube = show (width cube) ++ " " ++ show (height cube) ++ " " ++ show (depth cube) -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/02. Programming with actions/toDoList.hs: -------------------------------------------------------------------------------- 1 | todoList :: [IO ()] 2 | todoList = [putChar 'a', 3 | do putChar 'b' 4 | putChar 'c', 5 | do c <- getChar 6 | putChar c] 7 | 8 | 9 | sequence_' :: Monad m => [m ()] -> m [()] 10 | sequence_' [] = return [()] 11 | sequence_'(a:as) = do a 12 | sequence as 13 | 14 | 15 | putStr' :: [Char] -> IO () 16 | putStr' s = sequence_ (map putChar s) -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Api/web.config: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /Chapter1. Inception/Exercises/04.ChurchPairs.md: -------------------------------------------------------------------------------- 1 | # Church pairs 2 | Church pairs are the Church encoding of the pair (two-tuple) type. The pair is represented as a function that takes a function argument. When given its argument it will apply the argument to the two components of the pair. The definition in lambda calculus is, 3 | ``` 4 | pair = λx.λy.λz.zxy 5 | fst = λp.p(λx.λy.x) 6 | snd = λp.p(λx.λy.y) 7 | ``` 8 | 9 | ## Exercises: 10 | ``` 11 | fst (pair a b) = ... 12 | snd (pair a b) = ... 13 | ``` -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp/DataAccess.fs: -------------------------------------------------------------------------------- 1 | module NBB.Invoices.FSharp.DataAccess 2 | 3 | open NBB.Invoices.FSharp.Invoice 4 | open Microsoft.Extensions.DependencyInjection 5 | open NBB.Core.Effects 6 | 7 | let addServices connectionString (services: IServiceCollection) = 8 | services 9 | .AddSideEffectHandler(InvoiceRepositoryImpl.handle connectionString) 10 | .AddSideEffectHandler(InvoiceRepositoryImpl.handle connectionString) -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/tslint.json: -------------------------------------------------------------------------------- 1 | { 2 | "defaultSeverity": "error", 3 | "extends": ["dtslint/dtslint.json"], 4 | "jsRules": {}, 5 | "rules": { 6 | "deprecation": true, 7 | "file-name-casing": [true, "camel-case"], 8 | "no-empty-interface": false, 9 | "no-unnecessary-generics": true, 10 | "no-redundant-jsdoc": false, 11 | "interface-over-type-literal": false, 12 | "semicolon": [true, "always", "ignore-bound-class-methods"] 13 | } 14 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/tslint.json: -------------------------------------------------------------------------------- 1 | { 2 | "defaultSeverity": "error", 3 | "extends": ["dtslint/dtslint.json"], 4 | "jsRules": {}, 5 | "rules": { 6 | "deprecation": true, 7 | "file-name-casing": [true, "camel-case"], 8 | "no-empty-interface": false, 9 | "no-unnecessary-generics": true, 10 | "no-redundant-jsdoc": false, 11 | "interface-over-type-literal": false, 12 | "semicolon": [true, "always", "ignore-bound-class-methods"] 13 | } 14 | } -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/02. Types algebra/03.ProductTypes.hs: -------------------------------------------------------------------------------- 1 | data CreditCardInfo = CreditCardInfo String String 2 | 3 | show' :: CreditCardInfo -> String 4 | show' (CreditCardInfo cardNumber cvc) = cardNumber ++ " " ++ cvc 5 | 6 | 7 | --mixing with type synonims 8 | data Cube' = Cube' Int Int Int 9 | 10 | 11 | type Width = Int 12 | 13 | type Height = Int 14 | 15 | type Depth = Int 16 | 17 | data Cube = Cube Width Height Depth 18 | 19 | show'' :: Cube -> String 20 | show'' (Cube w h d) = show w ++ " " ++ show h ++ " " ++ show d -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/04. Files and Handles/goodbye.hs: -------------------------------------------------------------------------------- 1 | import System.IO 2 | 3 | main :: IO () 4 | main = do 5 | helloFile <- openFile "hello.txt" ReadMode 6 | firstLine <- hGetLine helloFile -- get the first line from hello.txt file 7 | putStrLn firstLine 8 | secondLine <- hGetLine helloFile -- get the second line from hello.txt file 9 | goodbyeFile <- openFile "goodbye.txt" WriteMode 10 | hPutStrLn goodbyeFile secondLine 11 | hClose helloFile 12 | hClose goodbyeFile 13 | putStrLn "done!" 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/01. Basic IO Operations/DoNotation.hs: -------------------------------------------------------------------------------- 1 | helloPerson :: String -> String 2 | helloPerson name = "Hello" ++ " " ++ name ++ "!" 3 | 4 | 5 | main :: IO () 6 | main = putStrLn "Hello! What's your name?" >> 7 | getLine >>= 8 | (\name -> 9 | return (helloPerson name)) >>= 10 | putStrLn 11 | 12 | 13 | -- main' :: IO () 14 | -- main' = putStrLn "Hello! What's your name?" >> 15 | -- getLine >>= 16 | -- (return . helloPerson) >>= 17 | -- putStrLn 18 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/.gitignore: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | # This .gitignore file was automatically created by Microsoft(R) Visual Studio. 3 | ################################################################################ 4 | 5 | /.vs 6 | /.idea 7 | */**/bin 8 | */**/obj 9 | **/packages 10 | */**/*.csproj.user 11 | TestResults 12 | */**/BenchmarkDotNet.Artifacts 13 | **/*.DotSettings.user 14 | */**/appsettings.Development.json 15 | *.user 16 | *.suo 17 | .fake 18 | .ionide -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/02. Programming with actions/sequence.hs: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | main :: IO () 6 | main = do 7 | a <- getLine 8 | b <- getLine 9 | c <- getLine 10 | print [a,b,c] 11 | 12 | 13 | -- Or we could do this: 14 | 15 | 16 | list :: [Char] 17 | list = ['H','e','l','l','o'] 18 | 19 | 20 | iolist :: [IO ()] 21 | iolist = map putChar list 22 | 23 | 24 | main'' = sequence iolist 25 | 26 | 27 | main' :: IO () 28 | main' = do 29 | rs <- sequence [getLine, getLine, return "5"] 30 | print rs 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/src/algebra.js: -------------------------------------------------------------------------------- 1 | import { curry, flip, reduce } from 'ramda' 2 | 3 | export const run = curry((ctx, middleware) => middleware(ctx, () => Promise.resolve())) 4 | 5 | export const empty = curry((_ctx, next) => next()) 6 | 7 | export const append = curry((left, right, ctx, next) => left(ctx, () => right(ctx, next))) 8 | 9 | export const use = flip(append) 10 | 11 | export const concat = reduce(append, empty) 12 | 13 | export const parallel = curry((first, second, ctx, next) => Promise.all([first |> run(ctx), second |> run(ctx)]).then(_ => next())) -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/05. Todo list/problem.txt: -------------------------------------------------------------------------------- 1 | Ne propunem sa facem un todo list 2 | 1. inseram taskuri in fisierul todo.txt 3 | 2. stergem taskuri din fisierul todo.txt 4 | 5 | De exemplu, fisierul todo.txt are urmatoarele taskuri: 6 | Task 1 7 | Task 2 8 | Task 3 9 | 10 | Trebuie sa facem un program in care trebuie sa introducem linia pe care vrem sa o stergem. 11 | 12 | These are your TODO items: 13 | 0 - task 1 14 | 1 - task 3 15 | Which one do you want to delete? 16 | 1 17 | 18 | Dupa ce am sters taskul selectat, taskurile ramase trebuiesc salvate in alt fisier ‘remainingTasks.txt’ 19 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/05. Algebraic structures/02.Monoid.hs: -------------------------------------------------------------------------------- 1 | instance Semigroup Integer where 2 | (<>) = (+) 3 | 4 | instance Monoid Integer where 5 | mempty = 0 6 | 7 | 8 | --mconcat polymorhic fn 9 | x = mconcat [1 .. 10] 10 | 11 | y = mconcat $ map (replicate 3) [1 .. 10] 12 | 13 | 14 | -- how probably mconcat is written 15 | mconcat' :: Monoid a => [a] -> a 16 | mconcat' = foldr (<>) mempty 17 | 18 | --more contraints means more power 19 | fn1 :: a -> a 20 | fn1 a = a 21 | 22 | fn2 :: Semigroup a => a -> a 23 | fn2 a = a <> a 24 | 25 | fn3 :: Monoid a => a -> a 26 | fn3 a = a <> mempty 27 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/02. Programming with actions/Fir.hs: -------------------------------------------------------------------------------- 1 | import Data.List ( intersperse ) 2 | import System.Environment ( getArgs ) 3 | 4 | line :: Int -> Int -> [Char] 5 | line total n = spaces ++ stars 6 | where 7 | spaces = replicate (total - n) ' ' 8 | stars = intersperse ' ' $ replicate n '*' 9 | 10 | 11 | tree :: Int -> [String] 12 | tree n = map (line n) [1 .. n] 13 | 14 | main :: IO () 15 | main = do 16 | [arg] <- getArgs 17 | let fn2 = mapM_ putStrLn 18 | let fn1 = tree . read 19 | let fn = fn2 . tree . read 20 | mapM_ putStrLn . tree . read $ arg 21 | putStrLn "R7D 4ever!" 22 | 23 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/01. Built-in types/01.BasicTypes.hs: -------------------------------------------------------------------------------- 1 | --simple built-in types 2 | myInt :: Int 3 | myInt = 2 4 | 5 | myInteger :: Integer 6 | myInteger = 2 7 | 8 | myDouble :: Double 9 | myDouble = 2.2 10 | 11 | myBool :: Bool 12 | myBool = True 13 | 14 | myChar :: Char 15 | myChar = 'a' 16 | 17 | --lists 18 | myCharList :: [Char] 19 | myCharList = ['a'] 20 | 21 | alsoMyCharList :: [Char] 22 | alsoMyCharList = "aaa" 23 | 24 | myString :: String 25 | myString = "sdsd" 26 | 27 | myIntegerList :: [Integer] 28 | myIntegerList = [1, 2, 3] 29 | 30 | --touples 31 | myTouple :: (String, String, Double) 32 | myTouple = ("BMW", "X5", 3.0) -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/03. Lazy IO/lazy.hs: -------------------------------------------------------------------------------- 1 | -- import System.Environment 2 | -- import Control.Monad 3 | -- main :: IO () 4 | -- main = do 5 | -- args <- getArgs 6 | -- let linesToRead = if length args > 0 7 | -- then read (head args) 8 | -- else 0 :: Int 9 | -- numbers <- replicateM linesToRead getLine 10 | -- let ints = map read numbers :: [Int] 11 | -- print (sum ints) 12 | 13 | 14 | main :: IO () 15 | main = do 16 | userInput <- getContents 17 | print userInput -- press Crts+Z to close the stream 18 | 19 | -- main' :: IO () 20 | -- main' = do 21 | -- userInput <- getContents 22 | -- mapM_ print userInput 23 | 24 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/src/primitiveValidators.js: -------------------------------------------------------------------------------- 1 | import { ValidationResult } from './algebra' 2 | 3 | const { Success, Failure } = ValidationResult; 4 | 5 | //primitive validators 6 | export const required = x => 7 | x !== null && x !== undefined && (typeof x === "string" ? x !== "" : true) 8 | ? Success(x) 9 | : Failure(["required"]) 10 | 11 | export const email = x => { 12 | const regex = /^(([^<>()[\]\\.,;:\s@"]+(\.[^<>()[\]\\.,;:\s@"]+)*)|(".+"))@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\])|(([a-zA-Z\-0-9]+\.)+[a-zA-Z]{2,}))$/ 13 | return regex.test(String(x).toLowerCase()) 14 | ? Success(x) 15 | : Failure(["not an email"]) 16 | } 17 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/.eslintrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "env": { 3 | "browser": true, 4 | "es6": true, 5 | "node": true 6 | }, 7 | "extends": [ 8 | "eslint:recommended", 9 | "plugin:jest/recommended" 10 | ], 11 | "parser": "babel-eslint", 12 | "plugins": [ 13 | "babel", 14 | "jest" 15 | ], 16 | "globals": { 17 | "Atomics": "readonly", 18 | "SharedArrayBuffer": "readonly" 19 | }, 20 | "parserOptions": { 21 | "ecmaVersion": 2018, 22 | "sourceType": "module" 23 | }, 24 | "rules": { 25 | "no-unused-vars": [2, {"args": "after-used", "argsIgnorePattern": "^_"}] 26 | } 27 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/.eslintrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "env": { 3 | "browser": true, 4 | "es6": true, 5 | "node": true 6 | }, 7 | "extends": [ 8 | "eslint:recommended", 9 | "plugin:jest/recommended" 10 | ], 11 | "parser": "babel-eslint", 12 | "plugins": [ 13 | "babel", 14 | "jest" 15 | ], 16 | "globals": { 17 | "Atomics": "readonly", 18 | "SharedArrayBuffer": "readonly" 19 | }, 20 | "parserOptions": { 21 | "ecmaVersion": 2018, 22 | "sourceType": "module" 23 | }, 24 | "rules": { 25 | "no-unused-vars": [2, {"args": "after-used", "argsIgnorePattern": "^_"}] 26 | } 27 | } -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/01. Built-in types/02.FunctionTypes.hs: -------------------------------------------------------------------------------- 1 | --function types 2 | myFunc :: Integer -> Integer 3 | myFunc n = n * 2 4 | 5 | makeCar :: String -> String -> Double -> (String, String, Double) 6 | makeCar make model cc = (make, model, cc) 7 | 8 | -- currying and partial application 9 | myCar :: (String, String, Double) 10 | myCar = makeCar "BMW" "X5" 3.0 11 | 12 | myBmw :: String -> Double -> (String, String, Double) 13 | myBmw = makeCar "BMW" 14 | 15 | myX5 :: Double -> (String, String, Double) 16 | myX5 = myBmw "X5" 17 | 18 | myX5_30 :: (String, String, Double) 19 | myX5_30 = myX5 3.0 20 | 21 | 22 | --hof with function param 23 | ifEven :: (Int -> Int) -> Int -> Int 24 | ifEven f n = 25 | if even n 26 | then f n 27 | else n -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/04. Files and Handles/dumpFile.hs: -------------------------------------------------------------------------------- 1 | import System.IO( Handle, FilePath, IOMode( ReadMode ), 2 | openFile, hGetLine, hPutStr, hClose, hIsEOF, stderr ) 3 | 4 | import Control.Monad( when ) 5 | 6 | dumpFile :: (Show t, Num t) => Handle -> [Char] -> t -> IO () 7 | dumpFile handle filename lineNumber = do 8 | end <- hIsEOF handle 9 | when ( not end ) $ do 10 | line <- hGetLine handle 11 | putStrLn $ filename ++ ":" ++ show lineNumber ++ ": " ++ line 12 | dumpFile handle filename $ lineNumber + 1 13 | 14 | main :: IO () 15 | main = do 16 | hPutStr stderr "Type a filename: " 17 | filename <- getLine 18 | handle <- openFile filename ReadMode 19 | dumpFile handle filename 1 20 | hClose handle 21 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/State/01.State.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | 3 | newtype State s a = State {runState :: s -> (s, a)} 4 | 5 | instance Functor (State s) where 6 | fmap f k = 7 | State 8 | ( \s -> 9 | let (s', a) = runState k s 10 | b = f a 11 | in (s', b) 12 | ) 13 | 14 | instance Applicative (State s) where 15 | pure a = State (,a) 16 | sf <*> sa = 17 | State 18 | ( \s -> 19 | let (s', f) = runState sf s 20 | (s'', a) = runState sa s' 21 | in (s'', f a) 22 | ) 23 | 24 | instance Monad (State s) where 25 | sa >>= f = 26 | State 27 | ( \s -> 28 | let (s', a) = runState sa s 29 | in runState (f a) s' 30 | ) 31 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/03. Type classes/01.TypeClasses.hs: -------------------------------------------------------------------------------- 1 | class Printable a where 2 | toString :: a -> String 3 | 4 | data Icecream = Chocolate | Vanilla deriving (Show) 5 | 6 | instance Printable Icecream where 7 | toString Chocolate = "Chocolate" 8 | toString Vanilla = "Vanilla" 9 | 10 | choco = toString Chocolate 11 | 12 | choco' = show Chocolate 13 | 14 | pretyPrint :: Printable a => a -> String 15 | pretyPrint x = "[" ++ toString x ++ "]" 16 | 17 | 18 | class Mappable f where 19 | map' :: (a -> b) -> f a -> f b 20 | 21 | instance Mappable Maybe where 22 | map' f (Just a) = Just (f a) 23 | map' f Nothing = Nothing 24 | 25 | instance Mappable [] where 26 | map' f [] = [] 27 | map' f (x:xs) = f x : map' f xs 28 | 29 | instance Mappable ((->)a) where 30 | map' f v = f . v 31 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp/Invoice/Script.fsx: -------------------------------------------------------------------------------- 1 | #r "nuget: NBB.Application.Mediator.FSharp" 2 | #r "nuget: NBB.Core.Effects.FSharp" 3 | #r "nuget: NBB.Core.Evented.FSharp" 4 | 5 | #load "Domain.fs" 6 | #load "Application.fs" 7 | 8 | open NBB.Invoices.FSharp.Invoice 9 | open System 10 | 11 | open CreateInvoice 12 | let createInvoiceCmd = { 13 | clientId = Guid.NewGuid() 14 | contractId = Guid.NewGuid() 15 | amount = 100m 16 | } 17 | 18 | let createInvoiceEffect = handle createInvoiceCmd 19 | printfn "%A" createInvoiceEffect 20 | 21 | open MarkInvoiceAsPayed 22 | let markInvoiceAsPayedCmd = { 23 | invoiceId = Guid.NewGuid() 24 | paymentId = Guid.NewGuid() 25 | } 26 | 27 | let markInvoiceAsPayedEff = handle markInvoiceAsPayedCmd 28 | printfn "%A" markInvoiceAsPayedEff -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/src/algebra.d.ts: -------------------------------------------------------------------------------- 1 | export type Middleware = ( 2 | ctx: TContext, 3 | next: () => Promise 4 | ) => Promise; 5 | 6 | export function run( 7 | ctx: TContext, 8 | middleware: Middleware): Promise; 9 | 10 | export let empty: Middleware; 11 | 12 | export function append( 13 | left: Middleware, 14 | right: Middleware 15 | ): Middleware; 16 | 17 | export function use( 18 | right: Middleware, 19 | left: Middleware 20 | ): Middleware; 21 | 22 | export function concat( 23 | xs: Array> 24 | ): Middleware; 25 | 26 | export function parallel( 27 | first: Middleware, 28 | second: Middleware 29 | ): Middleware; 30 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/src/__tests__/ValidationResult.tests.js: -------------------------------------------------------------------------------- 1 | import { ValidationResult } from '../algebra' 2 | import { required, email } from '../primitiveValidators' 3 | import { map, inc, toUpper, chain } from 'ramda' 4 | 5 | const { Success, Failure } = ValidationResult; 6 | 7 | describe("ValidationResult tests:", () => { 8 | it("Functor map: ", () => { 9 | expect(Success(7) |> map(inc)).toStrictEqual(Success(8)) 10 | expect(Failure(["some", "msgs"]) |> map(toUpper)).toStrictEqual(Failure(["some", "msgs"])) 11 | }) 12 | 13 | it("Monad bind(chain): ", () => { 14 | const composedValidator = x => x |> required |> chain(email) 15 | expect("" |> composedValidator).toStrictEqual(Failure(["required"])) 16 | expect("notAnEmail" |> composedValidator).toStrictEqual(Failure(["not an email"])) 17 | }) 18 | }) -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/02.RulesAlgebra.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import Control.Monad.Reader 3 | 4 | type Rule a = a -> a -> a 5 | 6 | -- implementation 7 | data Person = Person {personId :: Int, fName :: String, lName :: String, fullName :: String, version :: Int} 8 | 9 | rule1 :: Rule Person 10 | rule1 model prevModel = 11 | if fName model /= fName prevModel 12 | then model {fullName = fName model ++ " " ++ lName model} 13 | else model 14 | 15 | rule2 :: Rule Person 16 | rule2 model = do 17 | prevModel <- ask 18 | let newModel = if fName model /= fName prevModel then model {version = version model + 1} else model 19 | return newModel 20 | 21 | rule3 :: Rule Person 22 | rule3 model = do 23 | return $ if lName model == "Popovici" then model {personId = 7} else model 24 | 25 | composedRule :: Rule Person 26 | composedRule = rule1 >=> rule2 >=> rule3 -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/02. Types algebra/02.SumTypes.hs: -------------------------------------------------------------------------------- 1 | --simple sum types 2 | data Bool' = True' | False' deriving (Show) 3 | 4 | data Sex = Male | Female 5 | 6 | --pattern matching on data constructors 7 | greet :: Sex -> String 8 | greet Male = "Sir" 9 | greet Female = "M'lady" 10 | 11 | --mixing type synonims with sum types 12 | data PaymentMethod' = CreditCard' (String, String) | Cash' 13 | 14 | type CardNumber = String 15 | 16 | type CVC = String 17 | 18 | type CardInfo = (CardNumber, CVC) 19 | 20 | data PaymentMethod = CreditCard CardInfo | Cash 21 | 22 | myPaymentMethod1 = CreditCard ("my-card-number", "cvc") 23 | 24 | myPaymentMethod2 = Cash 25 | 26 | --pattern matching on data constructors 27 | acceptPayment :: Double -> PaymentMethod -> String 28 | acceptPayment amount (CreditCard (cardNumber, cvc)) = show (amount, cardNumber, cvc) 29 | acceptPayment amount Cash = show (amount, "cash") 30 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Api/NBB.Invoices.FSharp.Api.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net5.0 5 | NBB_Invoices_c9e28d3a-7681-452a-9dbe-a52a9b6a0900 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Worker/NBB.Invoices.FSharp.Worker.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net5.0 5 | NBB_Invoices_c9e28d3a-7681-452a-9dbe-a52a9b6a0900 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | -------------------------------------------------------------------------------- /Chapter2. The foundation/Exercises/02.Hofs/04.WhyFp.hs: -------------------------------------------------------------------------------- 1 | sum' [] = 0 2 | sum' (x : xs) = x + sum' xs 3 | 4 | prod' [] = 1 5 | prod' (x : xs) = x * prod' xs 6 | 7 | --sum' = foldr' (+) 0 8 | --prod' = foldr' (*) 1 9 | 10 | foldr' _ a [] = a 11 | foldr' f a (x : xs) = f x (foldr' f a xs) 12 | 13 | anyTrue = foldr' (||) False 14 | 15 | alltrue = foldr' (&&) False 16 | 17 | -- [1, 2, 3] = 1:2:3:[] 18 | -- foldr (+) 0 [1, 2, 3] = 1+2+3+0 19 | 20 | copy = foldr' (:) [] 21 | 22 | append a b = foldr' (:) b a 23 | 24 | length = foldr' count 0 25 | where 26 | count _ n = n + 1 27 | 28 | doubleall = foldr' doubleandcons [] 29 | where 30 | doubleandcons n list = (2 * n) : list 31 | 32 | doubleandcons = fandcons double 33 | where 34 | double n = 2 * n 35 | fandcons f el list = f el : list 36 | 37 | --fandcons f = (:) . f 38 | 39 | doubleall' = foldr' ((:) . double) [] 40 | where 41 | double n = 2 * n 42 | 43 | --doubleall' = map double 44 | map' f = foldr' ((:) . f) [] 45 | -------------------------------------------------------------------------------- /Chapter1. Inception/Exercises/01.ChurchBooleans.md: -------------------------------------------------------------------------------- 1 | # Church Booleans 2 | Church Booleans are the Church encoding of the Boolean values true and false. Some programming languages use these as an implementation model for Boolean arithmetic; examples are Smalltalk and Pico. 3 | 4 | Boolean logic may be considered as a choice. The Church encoding of true and false are functions of two parameters: 5 | - true chooses the first parameter. 6 | - false chooses the second parameter. 7 | 8 | ``` 9 | true = λa.λb.a 10 | false = λa.λb.b 11 | ``` 12 | Let's write an if-then-else function using this booleans: 13 | ``` 14 | ifte = λc.λt.λe.cte 15 | 16 | ifte true = (λc.λt.λe.cte)(λa.λb.a) 17 | = (λt.λe.(λa.λb.a)te) 18 | = λt.λe.(λb.t)e 19 | = λt.λe.t 20 | = true 21 | 22 | ifte false = false 23 | ``` 24 | 25 | ## Combinators 26 | ``` 27 | and = λp.λq.pqp 28 | or = λp.λq.ppq 29 | ``` 30 | 31 | ## Exercises 32 | ``` 33 | and true false = ... 34 | or false true = ... 35 | ``` 36 | 37 | 38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/02. Types algebra/01.TypeSynonims.hs: -------------------------------------------------------------------------------- 1 | --Function type wiyhout type synonims 2 | patientInfo :: String -> String -> Int -> Int -> String 3 | patientInfo fname lname age height = name ++ " " ++ ageHeight 4 | where 5 | name = lname ++ ", " ++ fname 6 | ageHeight = "(" ++ show age ++ "yrs. " ++ show height ++ "in.)" 7 | 8 | --type synonims 9 | type FirstName = String 10 | 11 | type LastName = String 12 | 13 | type Age = Int 14 | 15 | type Height = Int 16 | 17 | type PatientName = (FirstName, LastName) 18 | 19 | type PatienInfo = String 20 | 21 | firstName :: PatientName -> FirstName 22 | firstName = fst 23 | 24 | lastName :: PatientName -> LastName 25 | lastName = snd 26 | 27 | 28 | --same function using type synonims 29 | patientInfo' :: PatientName -> Age -> Height -> PatienInfo 30 | patientInfo' name age height = fullName ++ " " ++ ageHeight 31 | where 32 | fullName = lastName name ++ ", " ++ firstName name 33 | ageHeight = "(" ++ show age ++ "yrs. " ++ show height ++ "in.)" 34 | -------------------------------------------------------------------------------- /Chapter1. Inception/Exercises/02.ChurchNumerals.md: -------------------------------------------------------------------------------- 1 | # Church Numerals 2 | Church numerals are the representations of natural numbers under Church encoding. The higher-order function that represents natural number n is a function that maps any function f to its n-fold composition. 3 | 4 | ``` 5 | zero = λf.λx.x 6 | one = λf.λx.fx 7 | two = λf.λx.f(fx) 8 | three = λf.λx.f(f(fx)) 9 | ``` 10 | 11 | You can recover normal integer by applying the church numerals functions to the succ function and 0. 12 | 13 | ``` 14 | succ = λx.x+1 15 | show = λn.n(λx.x+1)0 16 | 17 | show one = (λn.n(λx.x+1)0)(λf.λx.fx) 18 | = (λf.λx.fx)(λx.x+1)0 19 | = (λx.(λx.x+1)x)0 20 | = (λx.x+1)0 21 | = 0+1 22 | = 1 23 | ``` 24 | 25 | ## Combinators 26 | ``` 27 | add = λm.λn.λf.λx.mf(nfx) 28 | succ = λn.λf.λx.f(nfx) 29 | pred = λn.λf.λx.n(λg.λh.h(gf))(λu.x)(λu.u) 30 | mult = λm.λn.λf.λx.m(nf)x 31 | ``` 32 | 33 | ## Exercises 34 | ``` 35 | one add two = ... 36 | two mult one = ... 37 | ``` 38 | 39 | 40 | 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/01. Basic IO Operations/Hello.hs: -------------------------------------------------------------------------------- 1 | import Data.Char (toUpper) 2 | 3 | helloPerson :: String -> String 4 | helloPerson name = "Hello" ++ " " ++ name ++ "!" 5 | 6 | main :: IO () 7 | 8 | main' :: IO () 9 | main' = 10 | putStrLn "Hello! What's your name?" 11 | >> getLine 12 | >>= ( \firstName -> 13 | putStrLn "What's your last name?" 14 | >> getLine 15 | >>= ( \lastName -> 16 | let bigFirstName = map toUpper firstName 17 | bigLastName = map toUpper lastName 18 | in putStrLn $ "hey " ++ bigFirstName ++ " " ++ bigLastName ++ ", how are you?" 19 | ) 20 | ) 21 | 22 | 23 | main = do 24 | putStrLn "What's your first name?" 25 | firstName <- getLine 26 | 27 | putStrLn "What's your last name?" 28 | lastName <- getLine 29 | let bigFirstName = map toUpper firstName 30 | bigLastName = map toUpper lastName 31 | putStrLn $ "hey " ++ bigFirstName ++ " " ++ bigLastName ++ ", how are you?" -------------------------------------------------------------------------------- /Chapter1. Inception/Exercises/05.ChurchLists.md: -------------------------------------------------------------------------------- 1 | # Church lists 2 | A list is either empty, or consists of a head (any lambda expression) and a tail (another list). 3 | ``` 4 | type List_of a = Nil | Cons a List_of a 5 | 6 | Nil = λc.λn. n 7 | Cons = λh.λt.λc.λn c h (t c n) 8 | 9 | ``` 10 | 11 | ## Examples 12 | ``` 13 | [] = Nil 14 | [1] = Cons 1 Nil 15 | [1,2,3] = Cons 1 (Cons 2 (Cons 3 Nil)) 16 | ``` 17 | 18 | ## Combinators 19 | ``` 20 | isNill = λl.l (λh.λt.false) true 21 | head = λl.l (λh.λt.h) false 22 | tail = λl.λc.λn.l (λh.λt.λg.g h (t c)) (λt.n) (λh.λt.t) 23 | ``` 24 | 25 | ### Right fold 26 | ``` 27 | (foldr f x) Nil = x 28 | (foldr f x) (Cons h t) = f h ((foldr f x) t) 29 | 30 | ``` 31 | We can re-write as: 32 | ``` 33 | foldr f x l = (isNill l) ? x : f (head l) ((foldr f x) (tail l))) 34 | ``` 35 | Using the Y combinator: 36 | ``` 37 | foldr' f x = λg.λl.((isNill l) ? x : f (head l) (g (tail l)))) 38 | foldr f x = Y foldr' 39 | ``` 40 | 41 | 42 | ## Exercises: 43 | ``` 44 | isNill Nill = ... 45 | isNill (Cons a Nill) = ... 46 | head (Cons a Nill) = ... 47 | ``` -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/04. Files and Handles/fileCounts.hs: -------------------------------------------------------------------------------- 1 | import System.Environment ( getArgs ) 2 | 3 | getCounts :: String -> (Int,Int,Int) 4 | getCounts input = (charCount, wordCount, lineCount) 5 | where charCount = length input 6 | wordCount = (length . words) input 7 | lineCount = (length . lines) input 8 | 9 | 10 | countsText :: (Int,Int,Int) -> String 11 | countsText (cc,wc,lc) = unwords ["chars: " 12 | , show cc 13 | , " words: " 14 | , show wc 15 | , " lines: " 16 | , show lc] 17 | 18 | -- GHCi> (countsText . getCounts) "this is\n some text" 19 | -- "chars: 18 words: 4 lines: 2" 20 | 21 | 22 | -- ./fileCounts hello.txt 23 | 24 | main :: IO () 25 | main = do 26 | args <- getArgs 27 | let fileName = head args 28 | input <- readFile fileName 29 | let summary = (countsText . getCounts) input 30 | appendFile "stats.dat" (mconcat [fileName, " ",summary, "\n"]) 31 | putStrLn summary -------------------------------------------------------------------------------- /Chapter1. Inception/Exercises/03.Factorial-a-la-1940.md: -------------------------------------------------------------------------------- 1 | # Factorial à la 1940 2 | ``` 3 | fact n = 4 | ifte (isZero n) 5 | one 6 | (mul n (fact (decr n))) 7 | 8 | 9 | isZero n = 10 | n (\_->false) true 11 | ``` 12 | 13 | ## Recursion in Lambda Calcullus 14 | We can perform a “trick” to define a function fact that satisfies the recursive equation above. First, let’s define a new function fact' 15 | that looks like fact, but takes an additional argument f. We assume that the function f will be instantiated with an actual parameter of... fact'. 16 | ``` 17 | fact' = λf.λn. if n=0 then 1 else n * (f f (n-1)) 18 | fact = fact' fact' 19 | 20 | ``` 21 | 22 | ### The Y Combinator 23 | [Fixed-point combinators in JavaScript: Memoizing recursive functions](http://matt.might.net/articles/implementation-of-recursive-fixed-point-y-combinator-in-javascript-for-memoization/) 24 | 25 | ``` 26 | Y = λg.(λx.g(x x)) (λx.g (x x)) 27 | fact' = λf.λn.(1, if n = 0; else n * (f (n−1))) 28 | fact = Y fact' 29 | ``` 30 | 31 | ## Exercises 32 | ``` 33 | fact' = ... 34 | fact = ... 35 | ``` 36 | 37 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Api/HttpHandlers.fs: -------------------------------------------------------------------------------- 1 | module NBB.Invoices.FSharp.Api.HttpHandlers 2 | 3 | open System 4 | open Microsoft.AspNetCore.Http 5 | open FSharp.Control.Tasks 6 | open Giraffe 7 | open NBB.Core.Effects 8 | open NBB.Application.Mediator.FSharp 9 | open NBB.Invoices.FSharp.Invoice 10 | 11 | 12 | let asyncCommandResponse : HttpHandler = 13 | let response = 14 | {| CommandId = Guid.NewGuid() 15 | CorrelationId = Guid.NewGuid() |} 16 | 17 | json response 18 | 19 | let sendCommand (cmd: 'a :> ICommand) (next: HttpFunc) (ctx: HttpContext) = 20 | task { 21 | let effect = Mediator.sendCommand cmd 22 | let interpreter = ctx.GetService() 23 | do! interpreter.Interpret(effect) 24 | 25 | return! next ctx 26 | } 27 | 28 | let cmd<'a when 'a :> ICommand> = 29 | bindJson<'a> sendCommand >=> asyncCommandResponse 30 | 31 | 32 | let invoiceHandler : HttpHandler = 33 | POST 34 | >=> choose [ route "/create" >=> cmd 35 | route "/pay" >=> cmd ] 36 | -------------------------------------------------------------------------------- /Chapter5. Functors Applicatives & Monads/Examples/03.FunctorInstances.hs: -------------------------------------------------------------------------------- 1 | newtype DataSource i o = DataSource 2 | { run :: i -> IO (Maybe o) 3 | } 4 | 5 | mapDs :: (a -> b) -> DataSource i a -> DataSource i b 6 | mapDs fn ds = DataSource (fmap (fmap fn) . run ds) 7 | 8 | instance Functor (DataSource i) where 9 | fmap = mapDs 10 | 11 | factorial :: Integer -> Integer 12 | factorial 0 = 1 13 | factorial n = n * factorial (n -1) 14 | 15 | ds1 :: DataSource Integer Integer 16 | ds1 = 17 | DataSource 18 | ( \id -> do 19 | putStrLn "Doing some sql query" 20 | return $ Just id 21 | ) 22 | 23 | ds2 :: DataSource Integer [Integer] 24 | ds2 = 25 | DataSource 26 | ( \id -> do 27 | putStrLn "Doing some sql query" 28 | return $ Just [1 .. id] 29 | ) 30 | 31 | ds3 :: DataSource Integer String 32 | ds3 = 33 | DataSource 34 | ( \_ -> do 35 | putStrLn "Doing some sql query" 36 | return Nothing 37 | ) 38 | 39 | x :: DataSource Integer Integer 40 | x = factorial <$> ds1 41 | 42 | y :: DataSource Integer [Integer] 43 | y = fmap (fmap factorial) ds2 44 | 45 | z :: DataSource Integer Int 46 | z = length <$> ds3 47 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "pure-validations", 3 | "version": "1.0.0", 4 | "description": "Validations algebra", 5 | "main": "index.js", 6 | "scripts": { 7 | "test": "jest --watchAll" 8 | }, 9 | "author": "Functional Guy", 10 | "license": "MIT", 11 | "dependencies": { 12 | "daggy": "^1.5.0", 13 | "fantasy-land": "^5.0.0", 14 | "ramda": "^0.27.1", 15 | "@totalsoft/zion": "^5.0.9" 16 | }, 17 | "devDependencies": { 18 | "@babel/cli": "^7.5.5", 19 | "@babel/core": "^7.5.5", 20 | "@babel/plugin-proposal-optional-chaining": "^7.2.0", 21 | "@babel/plugin-proposal-pipeline-operator": "^7.5.0", 22 | "@babel/plugin-transform-modules-commonjs": "^7.6.0", 23 | "@babel/plugin-transform-runtime": "^7.6.2", 24 | "@babel/preset-env": "^7.5.5", 25 | "babel-eslint": "^10.0.2", 26 | "babel-jest": "^24.9.0", 27 | "babel-plugin-module-resolver": "^3.0.0", 28 | "cross-env": "^6.0.3", 29 | "eslint": "^6.2.0", 30 | "eslint-plugin-babel": "^5.3.0", 31 | "eslint-plugin-jest": "^22.16.0", 32 | "jest": "^26.6.3", 33 | "prettier-eslint": "^9.0.0", 34 | "tern": "0.24.2" 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp/NBB.Invoices.FSharp.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | net5.0 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/readme.md: -------------------------------------------------------------------------------- 1 | # Chapter4. I/O in Haskell 2 | 3 | ## Goals 4 | After completing this chapter four, you'll be able to: 5 | - Understand how Haskell handles I/O by using IO types 6 | - Use do-notation to perform I/O(Understanding of the underlying monad theory is not necessary to program using the I/O system) 7 | - Write pure programs that interact with the real world 8 | - Access command-line arguments 9 | - Use the traditional approach to interacting through I/O 10 | - Write I/O code using lazy evaluation to make I/O easier 11 | - Work with file handles in Haskell 12 | - Read from and write to files 13 | 14 | ## Curricula 15 | - https://www.haskell.org/tutorial/io.html 16 | - https://wiki.haskell.org/Introduction_to_IO 17 | 18 | ## Alternative Curricula 19 | - http://learnyouahaskell.com/input-and-output 20 | - https://en.wikibooks.org/wiki/Haskell/Understanding_monads/IO 21 | 22 | ## A more thorough Curricula 23 | - [Learn you a Haskell from great good! - Chapter 8. Input and Output] 24 | - [Practical Haskell - Part III. Dealing with Files: IO and Conduit] 25 | - [Get programming with Haskell - Chapter 4. IO in Haskell] 26 | - [Real World Haskell - Chapter 7. Input and Output] 27 | 28 | ## Exercises 29 | - See folder [`Exercises`](./Exercises) -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/readme.md: -------------------------------------------------------------------------------- 1 | # Chapter8. Javascript libraries 2 | 3 | 4 | 5 | ## Goals 6 | - Recognize the functional aspects of the language 7 | - Get to know some functional javascript libraries like [`Ramda`](https://ramdajs.com/) 8 | - Implement algebraic structures with respect to the [`Fantasy Land Specification`](https://github.com/fantasyland/fantasy-land) 9 | - Look under the hood of the functional javascript libraries from [`osstotalsoft\jsbb`](https://github.com/osstotalsoft/jsbb) 10 | 11 | ## Curricula 12 | - [The Rise and Fall and Rise of Functional Programming](https://medium.com/javascript-scene/the-rise-and-fall-and-rise-of-functional-programming-composable-software-c2d91b424c8c) 13 | - [Professor frisby's mostly adequate guide](https://mostly-adequate.gitbooks.io/mostly-adequate-guide) 14 | - [Fantasy Land](https://github.com/fantasyland/fantasy-land/blob/master/README.md) 15 | - [Fantas, Eel, and Specification](http://www.tomharding.me/fantasy-land/) 16 | - [Eric Elliott - Composing Software: The Book](https://medium.com/javascript-scene/composing-software-the-book-f31c77fc3ddc) 17 | - [James Sinclair Blog](https://jrsinclair.com) 18 | 19 | ## Examples 20 | - See folder [`Sample`](./Sample) 21 | 22 | 23 | 24 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/Exercises/01. Basic IO Operations/Pizza.hs: -------------------------------------------------------------------------------- 1 | type Pizza = (Double,Double) 2 | 3 | areaGivenDiameter :: Double -> Double 4 | areaGivenDiameter size = pi*(size/2)^2 5 | 6 | costPerInch :: Pizza -> Double 7 | costPerInch (size, cost) = cost / areaGivenDiameter size 8 | 9 | comparePizzas :: Pizza -> Pizza -> Pizza 10 | comparePizzas p1 p2 = if costP1 < costP2 11 | then p1 12 | else p2 13 | where costP1 = costPerInch p1 14 | costP2 = costPerInch p2 15 | 16 | 17 | describePizza :: Pizza -> String 18 | describePizza (size,cost) = "The " ++ show size ++ " pizza " ++ "is cheaper at " ++ show costSqInch ++ " per square inch" 19 | where costSqInch = costPerInch (size,cost) 20 | 21 | 22 | main :: IO () 23 | main = do 24 | putStrLn "What is the size of pizza 1" 25 | size1 <- getLine 26 | putStrLn "What is the cost of pizza 1" 27 | cost1 <- getLine 28 | putStrLn "What is the size of pizza 2" 29 | size2 <- getLine 30 | putStrLn "What is the cost of pizza 2" 31 | cost2 <- getLine 32 | let pizza1 = (read size1, read cost1) 33 | let pizza2 = (read size2, read cost2) 34 | let betterPizza = comparePizzas pizza1 pizza2 35 | putStrLn (describePizza betterPizza) -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/05.MindTrickReader.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import Control.Monad.Reader 3 | 4 | -- Think of any number. 5 | -- Double the number. 6 | -- Add 9 with result. 7 | -- Subtract 3 with the result. 8 | -- Divide the result by 2. 9 | -- Subtract the number with the first number started with. 10 | -- The answer will always be 3. 11 | 12 | 13 | thinkOfANumber :: Integer -> Reader Integer Integer 14 | thinkOfANumber = return 15 | 16 | doubleTheNumber :: Integer -> Reader Integer Integer 17 | doubleTheNumber = return . (2 *) 18 | 19 | 20 | add9 :: Integer -> Reader Integer Integer 21 | add9 = return . (9 +) 22 | 23 | substract3 :: Integer -> Reader Integer Integer 24 | substract3 x = return $ x -3 25 | 26 | divideBy2 :: Integer -> Reader Integer Integer 27 | divideBy2 x = return $ x `div` 2 28 | 29 | 30 | substractTheFirstNumberYouStartedWith :: Integer -> Reader Integer Integer 31 | substractTheFirstNumberYouStartedWith x = do 32 | theNumberYouStartedWith <- ask 33 | return $ x - theNumberYouStartedWith 34 | 35 | mindTrick' :: Integer -> Reader Integer Integer 36 | mindTrick' = thinkOfANumber >=> doubleTheNumber >=> add9 >=> substract3 >=> divideBy2 >=> substractTheFirstNumberYouStartedWith 37 | 38 | mindTrick :: Integer -> Integer 39 | mindTrick x = runReader (mindTrick' x) x -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | 2 | { 3 | // Automatically created by phoityne-vscode extension. 4 | 5 | "version": "2.0.0", 6 | "presentation": { 7 | "reveal": "always", 8 | "panel": "new" 9 | }, 10 | "tasks": [ 11 | { 12 | // F7 13 | "group": { 14 | "kind": "build", 15 | "isDefault": true 16 | }, 17 | "label": "haskell build", 18 | "type": "shell", 19 | //"command": "cabal configure && cabal build" 20 | "command": "stack build" 21 | }, 22 | { 23 | // F6 24 | "group": "build", 25 | "type": "shell", 26 | "label": "haskell clean & build", 27 | //"command": "cabal clean && cabal configure && cabal build" 28 | "command": "stack clean && stack build" 29 | //"command": "stack clean ; stack build" // for powershell 30 | }, 31 | { 32 | // F8 33 | "group": { 34 | "kind": "test", 35 | "isDefault": true 36 | }, 37 | "type": "shell", 38 | "label": "haskell test", 39 | //"command": "cabal test" 40 | "command": "stack test" 41 | }, 42 | { 43 | // F6 44 | "isBackground": true, 45 | "type": "shell", 46 | "label": "haskell watch", 47 | "command": "stack build --test --no-run-tests --file-watch" 48 | } 49 | ] 50 | } 51 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "pipeline-algebra", 3 | "version": "1.0.0", 4 | "description": "Sample pipeline algebra", 5 | "main": "index.js", 6 | "scripts": { 7 | "test": "jest --watchAll", 8 | "tslint": "tslint -p tsconfig.json \"src/*.ts\"" 9 | }, 10 | "author": "Functional Guy", 11 | "license": "MIT", 12 | "dependencies": { 13 | "@totalsoft/zion": "^5.0.9", 14 | "daggy": "^1.5.0", 15 | "fantasy-land": "^5.0.0", 16 | "ramda": "^0.27.1" 17 | }, 18 | "devDependencies": { 19 | "@babel/cli": "^7.5.5", 20 | "@babel/core": "^7.5.5", 21 | "@babel/plugin-proposal-optional-chaining": "^7.2.0", 22 | "@babel/plugin-proposal-pipeline-operator": "^7.5.0", 23 | "@babel/plugin-transform-modules-commonjs": "^7.6.0", 24 | "@babel/plugin-transform-runtime": "^7.6.2", 25 | "@babel/preset-env": "^7.5.5", 26 | "babel-eslint": "^10.0.2", 27 | "babel-jest": "^24.9.0", 28 | "babel-plugin-module-resolver": "^3.0.0", 29 | "cross-env": "^6.0.3", 30 | "dtslint": "^4.1.6", 31 | "eslint": "^6.2.0", 32 | "eslint-plugin-babel": "^5.3.0", 33 | "eslint-plugin-jest": "^22.16.0", 34 | "jest": "^26.6.3", 35 | "jest-extended": "^0.11.5", 36 | "prettier-eslint": "^9.0.0", 37 | "tern": "0.24.2", 38 | "typescript": "^4.4.2" 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/04.MindTrick.hs: -------------------------------------------------------------------------------- 1 | -- Think of any number. 2 | -- Double the number. 3 | -- Add 9 with result. 4 | -- Subtract 3 with the result. 5 | -- Divide the result by 2. 6 | -- Subtract the number with the first number started with. 7 | -- The answer will always be 3. 8 | 9 | mindTrick :: Integer -> Integer 10 | mindTrick x = (x * 2 + 9 -3) `div` 2 - x 11 | 12 | -- rewrite it as a pipeline of functions 13 | thinkOfANumber :: Integer -> Integer 14 | thinkOfANumber = id 15 | 16 | doubleTheNumber :: Integer -> Integer 17 | doubleTheNumber = (2 *) 18 | 19 | add9 :: Integer -> Integer 20 | add9 = (9 +) 21 | 22 | substract3 :: Integer -> Integer 23 | substract3 x = x -3 24 | 25 | divideBy2 :: Integer -> Integer 26 | divideBy2 x = x `div` 2 27 | 28 | substractTheFirstNumberYouStartedWith :: Integer -> Integer -> Integer 29 | substractTheFirstNumberYouStartedWith x theNumberYouStartedWith = x - theNumberYouStartedWith 30 | 31 | (>>>) :: (a -> b) -> (b -> c) -> a -> c 32 | f >>> g = g . f 33 | 34 | mindTrick' :: Integer -> Integer -> Integer 35 | mindTrick' = thinkOfANumber >>> doubleTheNumber >>> add9 >>> substract3 >>> divideBy2 >>> substractTheFirstNumberYouStartedWith 36 | 37 | mindTrick'' :: Integer -> Integer 38 | mindTrick'' x = thinkOfANumber >>> doubleTheNumber >>> add9 >>> substract3 >>> divideBy2 >>> (`substractTheFirstNumberYouStartedWith` x) $ x 39 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/06.MindTrickMonadReader.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import Control.Monad.Reader 3 | 4 | -- Think of any number. 5 | -- Double the number. 6 | -- Add 9 with result. 7 | -- Subtract 3 with the result. 8 | -- Divide the result by 2. 9 | -- Subtract the number with the first number started with. 10 | -- The answer will always be 3. 11 | 12 | 13 | thinkOfANumber :: Integer -> Integer -> Integer 14 | thinkOfANumber = return 15 | 16 | doubleTheNumber :: Integer -> Integer -> Integer 17 | doubleTheNumber = return . (2 *) 18 | 19 | 20 | add9 :: Integer -> Integer -> Integer 21 | add9 = return . (9 +) 22 | 23 | substract3 :: Integer -> Integer -> Integer 24 | substract3 x = return $ x -3 25 | 26 | divideBy2 :: Integer -> Integer -> Integer 27 | divideBy2 x = return $ x `div` 2 28 | 29 | 30 | substractTheFirstNumberYouStartedWith :: Integer -> Integer -> Integer 31 | substractTheFirstNumberYouStartedWith x = do 32 | theNumberYouStartedWith <- ask 33 | return $ x - theNumberYouStartedWith 34 | 35 | mindTrick' :: Integer -> Integer -> Integer 36 | mindTrick' = thinkOfANumber >=> doubleTheNumber >=> add9 >=> substract3 >=> divideBy2 >=> substractTheFirstNumberYouStartedWith 37 | --mindtrick 4 = (4,4) >=> (4,4) >=> (8,4)>=> (17,4) >=> (14,4) >=> (7,4) 38 | mindTrick :: Integer -> Integer 39 | mindTrick x = mindTrick' x x -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "module": "commonjs", 4 | "target": "es5", 5 | "lib": ["es6", "dom"], 6 | "jsx": "react", 7 | "moduleResolution": "node", 8 | "forceConsistentCasingInFileNames": true, 9 | "strict": true, 10 | "noEmit": true, 11 | "experimentalDecorators": true, 12 | "baseUrl": "./", 13 | "allowSyntheticDefaultImports": true, 14 | "noErrorTruncation": true, 15 | "allowJs": true, 16 | "paths": { 17 | // "@totalsoft/change-tracking": ["./packages/change-tracking/src"], 18 | // "@totalsoft/change-tracking-react": ["./packages/change-tracking-react/src"], 19 | // "@totalsoft/pure-validations": ["./packages/pure-validations/src"], 20 | // "@totalsoft/pure-validations-react": ["./packages/pure-validations-react/src"], 21 | // "@totalsoft/rules-algebra": ["./packages/rules-algebra/src"], 22 | // "@totalsoft/rules-algebra-react": ["./packages/rules-algebra-react/src"], 23 | // "@totalsoft/react-state-lens": ["./packages/react-state-lens/src"], 24 | // "@totalsoft/react-state-lens/lensProxy": ["./packages/react-state-lens/src/lensProxy"], 25 | // "@totalsoft/zion": ["./packages/zion/src"], 26 | // "@totalsoft/zion/*": ["./packages/zion/src/*"] 27 | } 28 | }, 29 | "exclude": ["**/build/"] 30 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "module": "commonjs", 4 | "target": "es5", 5 | "lib": ["es6", "dom"], 6 | "jsx": "react", 7 | "moduleResolution": "node", 8 | "forceConsistentCasingInFileNames": true, 9 | "strict": true, 10 | "noEmit": true, 11 | "experimentalDecorators": true, 12 | "baseUrl": "./", 13 | "allowSyntheticDefaultImports": true, 14 | "noErrorTruncation": true, 15 | "allowJs": true, 16 | "paths": { 17 | // "@totalsoft/change-tracking": ["./packages/change-tracking/src"], 18 | // "@totalsoft/change-tracking-react": ["./packages/change-tracking-react/src"], 19 | // "@totalsoft/pipeline-algebra": ["./packages/pipeline-algebra/src"], 20 | // "@totalsoft/pipeline-algebra-react": ["./packages/pipeline-algebra-react/src"], 21 | // "@totalsoft/rules-algebra": ["./packages/rules-algebra/src"], 22 | // "@totalsoft/rules-algebra-react": ["./packages/rules-algebra-react/src"], 23 | // "@totalsoft/react-state-lens": ["./packages/react-state-lens/src"], 24 | // "@totalsoft/react-state-lens/lensProxy": ["./packages/react-state-lens/src/lensProxy"], 25 | // "@totalsoft/zion": ["./packages/zion/src"], 26 | // "@totalsoft/zion/*": ["./packages/zion/src/*"] 27 | } 28 | }, 29 | "exclude": ["**/build/", "**/node_modules"] 30 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/.vscode/launch.json: -------------------------------------------------------------------------------- 1 | { 2 | // Use IntelliSense to learn about possible attributes. 3 | // Hover to view descriptions of existing attributes. 4 | // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 5 | "version": "0.2.0", 6 | "configurations": [ 7 | { 8 | "type": "node", 9 | "request": "launch", 10 | "name": "Jest All", 11 | "program": "${workspaceFolder}/node_modules/.bin/jest", 12 | "args": ["--runInBand"], 13 | "console": "integratedTerminal", 14 | "internalConsoleOptions": "neverOpen", 15 | "disableOptimisticBPs": true, 16 | "windows": { 17 | "program": "${workspaceFolder}/node_modules/jest/bin/jest", 18 | } 19 | }, 20 | { 21 | "type": "node", 22 | "request": "launch", 23 | "name": "Jest Current File", 24 | "program": "${workspaceFolder}/node_modules/.bin/jest", 25 | "args": [ 26 | "${fileBasenameNoExtension}", 27 | "--config", 28 | "jest.config.js" 29 | ], 30 | "console": "integratedTerminal", 31 | "internalConsoleOptions": "neverOpen", 32 | "disableOptimisticBPs": true, 33 | "windows": { 34 | "program": "${workspaceFolder}/node_modules/jest/bin/jest", 35 | } 36 | } 37 | ] 38 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/.vscode/launch.json: -------------------------------------------------------------------------------- 1 | { 2 | // Use IntelliSense to learn about possible attributes. 3 | // Hover to view descriptions of existing attributes. 4 | // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 5 | "version": "0.2.0", 6 | "configurations": [ 7 | { 8 | "type": "node", 9 | "request": "launch", 10 | "name": "Jest All", 11 | "program": "${workspaceFolder}/node_modules/.bin/jest", 12 | "args": ["--runInBand"], 13 | "console": "integratedTerminal", 14 | "internalConsoleOptions": "neverOpen", 15 | "disableOptimisticBPs": true, 16 | "windows": { 17 | "program": "${workspaceFolder}/node_modules/jest/bin/jest", 18 | } 19 | }, 20 | { 21 | "type": "node", 22 | "request": "launch", 23 | "name": "Jest Current File", 24 | "program": "${workspaceFolder}/node_modules/.bin/jest", 25 | "args": [ 26 | "${fileBasenameNoExtension}", 27 | "--config", 28 | "jest.config.js" 29 | ], 30 | "console": "integratedTerminal", 31 | "internalConsoleOptions": "neverOpen", 32 | "disableOptimisticBPs": true, 33 | "windows": { 34 | "program": "${workspaceFolder}/node_modules/jest/bin/jest", 35 | } 36 | } 37 | ] 38 | } -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/src/algebra.js: -------------------------------------------------------------------------------- 1 | import { taggedSum } from "daggy" 2 | import * as fl from "fantasy-land" 3 | import { map, compose, concat } from "ramda" 4 | 5 | //data ValidationResult a = Success a | Failure [String] 6 | export const ValidationResult = taggedSum("ValidationResult", { 7 | Success: ["value"], 8 | Failure: ["errors"] 9 | }); 10 | const { Success, Failure } = ValidationResult; 11 | 12 | /* Functor ValidationResult */ { 13 | ValidationResult.prototype[fl.map] = function (f) { 14 | return this.cata({ 15 | Success: compose(Success, f), 16 | Failure: Failure 17 | }) 18 | } 19 | 20 | } 21 | 22 | /* Apply ValidationResult */ { 23 | ValidationResult.prototype[fl.ap] = function (fn) { 24 | return this.cata({ 25 | Success: a => fn |> map(f => f(a)), 26 | Failure: errors => fn.cata({ 27 | Success: _ => Failure(errors), 28 | Failure: errors2 => Failure(concat(errors2, errors)) 29 | }) 30 | }) 31 | } 32 | } 33 | 34 | /* Applicative ValidationResult */ { 35 | ValidationResult[fl.of] = Success; 36 | } 37 | 38 | /* Chain ValidationResult */ { 39 | ValidationResult.prototype[fl.chain] = function (f) { 40 | return this.cata({ 41 | Success: f, 42 | Failure: errors => Failure(errors) 43 | }) 44 | } 45 | } 46 | 47 | 48 | 49 | //type Validator a = a -> ValidationResult a 50 | 51 | 52 | 53 | 54 | 55 | -------------------------------------------------------------------------------- /Chapter4. IO in Haskell/A brief introduction.md: -------------------------------------------------------------------------------- 1 | ## Separating the Pure from the Impure 2 | By now, you’re used to the fact that Haskell is a purely functional language. 3 | Instead of giving the computer a series of steps to execute, you give it definitions of what certain things are. In addition, a function isn’t allowed to have side effects. A function can give us back only some result based on the parameters we supplied to it. If a function is called two times with the same parameters, it must return the same result. 4 | The fact that functions cannot change state—like updating global variables, for example—is good, because it helps us reason about our programs. However, there’s one problem with this: If a function can’t change anything in the world, how is it supposed to tell us what it calculated? 5 | No matter what your program does, no matter what language it’s written in, I/O is a hugely important part of software. It’s the point where your code meets the real world. The problem is that using I/O inherently requires you to change the world. Take, for example, getting user input from the command line. Each time you have a program that requests user input, you expect the result to be different. But we spent a great deal of time talking about how important it is that all functions take an argument, return a value, and always return the same value for the same argument. If you read a file and write to another, your programs would be useless if you didn’t change the world somewhere along the way. 6 | 7 | 8 | ## So how does Haskell solve this problem?... -------------------------------------------------------------------------------- /Chapter5. Functors Applicatives & Monads/Examples/02.Clean.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DuplicateRecordFields #-} 2 | 3 | --domain 4 | data LeasingDocument = LeasingDocument 5 | { documentId :: Int, 6 | siteId :: Int, 7 | scoring :: Maybe Double 8 | } 9 | deriving (Show) 10 | 11 | newLeasingDocument :: Int -> Int -> LeasingDocument 12 | newLeasingDocument documentId siteId = LeasingDocument documentId siteId Nothing 13 | 14 | score :: Double -> LeasingDocument -> LeasingDocument 15 | score scoring document = document {scoring = Just scoring} 16 | 17 | --repo 18 | load :: Int -> Int -> IO LeasingDocument 19 | load documentId siteId = do 20 | putStrLn $ "loading document with documentId: " ++ show documentId ++ " and siteId: " ++ show siteId 21 | return $ LeasingDocument documentId siteId (Just 5.0) 22 | 23 | save :: LeasingDocument -> IO () 24 | save document = do 25 | putStrLn $ "saving document " ++ show document 26 | return () 27 | 28 | --application 29 | data Cmd = ScoreCmd 30 | { documentId :: Int, 31 | siteId :: Int, 32 | score' :: Double 33 | } 34 | 35 | handleCmd :: Cmd -> IO () 36 | handleCmd (ScoreCmd documentId siteId scoring) = 37 | score' <$> load documentId siteId >>= save 38 | where 39 | score' = score scoring 40 | 41 | data GetDocumentScoreQuery = ScoreQuery 42 | { documentId :: Int, 43 | siteId :: Int 44 | } 45 | 46 | handleQ :: GetDocumentScoreQuery -> IO Double 47 | handleQ (ScoreQuery documentId siteId) = getScore <$> load documentId siteId 48 | where 49 | getScore (LeasingDocument _ _ Nothing) = 0.0 50 | getScore (LeasingDocument _ _ (Just score)) = score 51 | 52 | --api 53 | x :: IO () 54 | x = handleCmd $ ScoreCmd 1 1 4.0 55 | 56 | y :: IO Double 57 | y = handleQ (ScoreQuery 1 1) 58 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/07.MessagingPipeline.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import Control.Monad.Reader 3 | 4 | -- the generic pipeline library 5 | type Middleware r m a b = a -> ReaderT r m b 6 | 7 | -- some reusable middlewares 8 | type Json = String 9 | 10 | type UserId = Int 11 | 12 | data Envelope a = Envelope 13 | { userId :: UserId, 14 | payload :: a 15 | } 16 | deriving (Show, Read) 17 | 18 | data Context a = Context 19 | { deserializeFn :: String -> Maybe (Envelope a), 20 | logFn :: Envelope a -> String 21 | } 22 | 23 | deserialize :: Json -> ReaderT (Context a) Maybe (Envelope a) 24 | deserialize json = do 25 | ctx <- ask 26 | let envelope = deserializeFn ctx json 27 | lift envelope 28 | 29 | authorize :: Envelope a -> ReaderT (Context a) Maybe (Envelope a) 30 | authorize envelope = 31 | if authorized 32 | then return envelope 33 | else lift Nothing 34 | where 35 | authorized = userId envelope == 5 36 | 37 | handle :: Envelope a -> ReaderT (Context a) Maybe String 38 | handle envelope = do 39 | log <- asks logFn 40 | return $ log envelope 41 | 42 | -- implementation 43 | data ContractCreated = ContractCreated 44 | { documentId :: Int, 45 | siteId :: Int 46 | } 47 | deriving (Show, Read) 48 | 49 | pipelineFn :: Json -> ReaderT (Context a) Maybe String 50 | pipelineFn = deserialize >=> authorize >=> handle 51 | 52 | --test the pipeline 53 | json :: Json 54 | json = "Envelope {userId = 5, payload = ContractCreated {documentId = 1, siteId = 1}}" 55 | 56 | ctx :: Context ContractCreated 57 | ctx = Context deserializeFn' logFn' 58 | where 59 | deserializeFn' = Just . read 60 | logFn' = show . payload 61 | 62 | result :: Maybe String 63 | result = runReaderT (pipelineFn json) ctx 64 | -------------------------------------------------------------------------------- /Chapter5. Functors Applicatives & Monads/Examples/03.Monad.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import qualified Data.Map as Map 3 | 4 | parse :: String -> Int 5 | parse = read 6 | 7 | isEven :: Int -> Bool 8 | isEven = even 9 | 10 | -- in Haskell we create new functions by composing existing ones 11 | isEvenStr :: String -> Bool 12 | isEvenStr = isEven . parse 13 | 14 | compose :: (a -> b) -> (b -> c) -> a -> c 15 | compose = flip (.) 16 | 17 | --compose' :: (a -> m b) -> (b -> m c) -> a -> m c 18 | compose' :: (Functor m) => (a -> m b) -> (b -> m c) -> a -> m (m c) 19 | compose' f g = fmap g . f 20 | 21 | flatten :: (Monad m) => m (m a) -> m a 22 | flatten x = x >>= id 23 | --flatten = join 24 | 25 | compose'' :: (Monad m) => (a -> m b) -> (b -> m c) -> a -> m c 26 | compose'' f g = flatten . fmap g . f 27 | 28 | compose''' :: (Monad m) => (a -> m b) -> (b -> m c) -> a -> m c 29 | compose''' f g = (\a -> f a >>= g) 30 | --compose''' f g = (>>= g) . f 31 | --compose''' = (>=>) 32 | 33 | type UserName = String 34 | 35 | type GamerId = Int 36 | 37 | type PlayerCredits = Int 38 | 39 | userNameDB :: Map.Map GamerId UserName 40 | userNameDB = 41 | Map.fromList 42 | [ (1, "nYarlathoTep"), 43 | (2, "KINGinYELLOW"), 44 | (3, "dagon1997"), 45 | (4, "rcarter1919"), 46 | (5, "xCTHULHUx"), 47 | (6, "yogSOThoth") 48 | ] 49 | 50 | creditsDB :: Map.Map UserName PlayerCredits 51 | creditsDB = 52 | Map.fromList 53 | [ ("nYarlathoTep", 2000), 54 | ("KINGinYELLOW", 15000), 55 | ("dagon1997", 300), 56 | ("rcarter1919", 12), 57 | ("xCTHULHUx", 50000), 58 | ("yogSOThoth", 150000) 59 | ] 60 | 61 | lookupUserName :: GamerId -> Maybe UserName 62 | lookupUserName id = Map.lookup id userNameDB 63 | 64 | lookupCredits :: UserName -> Maybe PlayerCredits 65 | lookupCredits username = Map.lookup username creditsDB 66 | 67 | creditsFromId :: GamerId -> Maybe PlayerCredits 68 | creditsFromId = lookupUserName >=> lookupCredits -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/src/combinators.js: -------------------------------------------------------------------------------- 1 | import { pipeK, reduce, map, applyTo, liftN, always, identity, apply, curry, concat, toPairs, range, length, keys } from 'ramda' 2 | import { ValidationResult } from './algebra' 3 | import { $do } from '@totalsoft/zion' 4 | 5 | const { Success, Failure } = ValidationResult 6 | const composeK = pipeK 7 | 8 | export const stopOnFirstFailure = reduce(composeK, Success) 9 | 10 | const concatFailure2 = (v1, v2) => x => 11 | [v1, v2] 12 | |> map(applyTo(x)) 13 | |> apply(liftN(2, always(identity))) 14 | 15 | // const concatFailure2 = (v1, v2) => x =>{ 16 | // const vr1 = v1(x) 17 | // const vr2 = v2(x) 18 | // const takeLast = curry((_,y) => y) 19 | // const liftA2 = liftN(2) 20 | // const takeLastVr = liftA2(takeLast) 21 | // return takeLastVr(vr1, vr2) 22 | // } 23 | 24 | export const concatFailure = reduce(concatFailure2, Success) 25 | 26 | export const error = curry((errorsMapFn, v) => x => 27 | v(x).cata({ 28 | Success: Success, 29 | Failure: errors => Failure(errors |> errorsMapFn) 30 | }) 31 | ) 32 | 33 | export const field = curry((key, fieldValidator) => x => $do(function* () { 34 | const fieldValue = x[key] 35 | const v = fieldValidator |> error(map(concat(`${key}: `))) 36 | yield v(fieldValue) 37 | return x 38 | })) 39 | 40 | export const shape = shapeValidator => 41 | shapeValidator 42 | |> toPairs // [[key, validator]] 43 | |> map(apply(field)) // [ValidationResult a] 44 | |> concatFailure //ValidationResult a 45 | 46 | export const items = itemValidator => x => 47 | x 48 | |> length 49 | |> range(0) // [0..length x] 50 | |> map(i => field(i, itemValidator)) // [Validator a] 51 | |> concatFailure 52 | |> applyTo(x) 53 | 54 | export const allProps = propValidator => x => 55 | x 56 | |> keys 57 | |> map(k => field(k, propValidator)) // [Validator a] 58 | |> concatFailure 59 | |> applyTo(x) -------------------------------------------------------------------------------- /Chapter6. Computational effects/readme.md: -------------------------------------------------------------------------------- 1 | # Chapter6. Computational effects 2 | 3 | 4 | 5 | ## Goals 6 | - Understand the notion of computational effects 7 | - Understand the difference between side-effects and computational (monadic) effects 8 | - Expand our language with the terms: values with (computational) (monadic) effects, effectfull functions or functions with monadic effects 9 | - Understand the practical value of: 10 | - Maybe effect - partial computations 11 | - Reader effect - read only state 12 | - Writer effect - write-only state 13 | - State effect - read / write state 14 | - List effect - nondetetrministic computations 15 | - IO effect - I/O computations 16 | 17 | ## Curricula 18 | - [`Lambda World 2019 - A categorical view of computational effects - Emily Riehl`](https://www.youtube.com/watch?v=Ssx2_JKpB3U) 19 | - [`A categorical view of computational effects - Emily Riehl - The paper`](https://math.jhu.edu/~eriehl/lambda.pdf) 20 | - [`Eugenio Moggi, Notions of Computation and Monads. This is a hard core research paper that started the whole monad movement in functional languages.`](https://person.dibris.unige.it/moggi-eugenio/ftp/ic91.pdf) 21 | - [`Philip Wadler, Monads for Functional Programming. The classic paper introducing monads into Haskell.`](https://homepages.inf.ed.ac.uk/wadler/papers/marktoberdorf/baastad.pdf) 22 | - [`Monads and Effects by Bartosz Milewski`](https://bartoszmilewski.com/2016/11/30/monads-and-effects/) 23 | - [`DERIVING THE STATE MONAD FROM FIRST PRINCIPLES - William Yao`](https://williamyaoh.com/posts/2020-07-12-deriving-state-monad.html) 24 | - [`DERIVING THE READER MONAD FROM FIRST PRINCIPLES - William Yao`](https://williamyaoh.com/posts/2020-07-19-deriving-reader-monad.html) 25 | - [`DERIVING THE WRITER MONAD FROM FIRST PRINCIPLES - William Yao`](https://williamyaoh.com/posts/2020-07-26-deriving-writer-monad.html) 26 | 27 | ## Examples 28 | - See folder [`Examples`](./Examples) 29 | 30 | 31 | 32 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp/Invoice/Domain.fs: -------------------------------------------------------------------------------- 1 | namespace NBB.Invoices.FSharp.Invoice 2 | 3 | open System 4 | open NBB.Core.Evented.FSharp 5 | open NBB.Core.Effects 6 | open NBB.Core.Effects.FSharp 7 | open NBB.Application.Mediator.FSharp 8 | 9 | module InvoiceAggregate = 10 | type Invoice = 11 | { Id: Guid 12 | ClientId: Guid 13 | ContractId: Guid option 14 | Amount: decimal 15 | PaymentId: Guid option } 16 | 17 | type InvoiceEvent = 18 | | InvoiceCreated of Invoice: Invoice 19 | | InvoicePayed of Invoice: Invoice 20 | interface IEvent 21 | 22 | let create clientId contractId amount = 23 | evented { 24 | let invoice = 25 | { Id = Guid.NewGuid() 26 | ClientId = clientId 27 | ContractId = contractId 28 | Amount = amount 29 | PaymentId = None } 30 | 31 | do! addEvent (InvoiceCreated invoice) 32 | return invoice 33 | } 34 | 35 | let markAsPayed paymentId invoice = 36 | evented { 37 | let invoice' = 38 | { invoice with 39 | PaymentId = Some paymentId } 40 | 41 | do! addEvent (InvoicePayed invoice') 42 | return invoice' 43 | } 44 | 45 | let createPayed clientId contractId amount paymentId = 46 | evented { 47 | let! invoice = create clientId contractId amount 48 | return! markAsPayed paymentId invoice 49 | } 50 | 51 | module InvoiceRepository = 52 | open InvoiceAggregate 53 | 54 | type SideEffect<'a> = 55 | | GetById of InvoiceId: Guid * Continuation: (Invoice option -> 'a) 56 | | Save of Invoice: Invoice * Continuation: (unit -> 'a) 57 | interface ISideEffect<'a> 58 | 59 | let getById invoiceId = Effect.Of(GetById(invoiceId, id)) 60 | let save invoice = Effect.Of(Save(invoice, id)) 61 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/State/02.Stack.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad.State.Lazy 2 | 3 | type MyState = Int 4 | 5 | isEven :: Integer -> Bool 6 | isEven = even 7 | 8 | statefullIsEven :: Integer -> MyState -> (Bool, MyState) 9 | statefullIsEven x s = (even x, s + 1) 10 | 11 | statefullToString :: Bool -> MyState -> (String, MyState) 12 | statefullToString x s = (show x, s + 2) 13 | 14 | -- statefullComposition = statefullToString . statefullIsEven 15 | 16 | --type State s a = s -> (a,s) 17 | --newtype State s a = State {runState::s -> (a,s)} 18 | 19 | statefullIsEven' :: Integer -> State MyState Bool 20 | statefullIsEven' x = do 21 | -- s <- get 22 | -- put $ s + 1 23 | modify (+ 1) 24 | return $ even x 25 | 26 | statefullToString' :: Bool -> State MyState String 27 | statefullToString' x = do 28 | modify (+ 2) 29 | return $ show x 30 | 31 | statefullComposition' :: Integer -> State MyState String 32 | statefullComposition' = statefullIsEven' >=> statefullToString' 33 | 34 | ------------------------------------------------------------------------------- 35 | type Stack a = [a] -- o structura de date care fct dupa principiul LIFO 36 | 37 | --pop:: Stack a -> a 38 | pop :: State (Stack a) a 39 | pop = do 40 | -- s <- get 41 | -- let (x : xs) = s 42 | -- put xs 43 | -- return x 44 | h <- gets head 45 | modify tail 46 | return h 47 | 48 | popAll :: State (Stack a) [a] 49 | popAll = do 50 | l <- gets length 51 | replicateM l pop 52 | 53 | -- if l == 0 54 | -- then return [] 55 | -- else -- do 56 | -- -- x <- pop 57 | -- -- xs <- popAll 58 | -- -- return $ x : xs 59 | -- liftM2 (:) pop popAll 60 | 61 | push :: a -> State (Stack a) () 62 | push = modify . (:) 63 | 64 | pushAll :: [a] -> State (Stack a) () 65 | pushAll = mapM_ push 66 | 67 | myStupidStatefullAction :: State (Stack Int) Int 68 | myStupidStatefullAction = do 69 | push 1 70 | push 2 71 | pop 72 | 73 | reverse' :: [a] -> State (Stack a) [a] 74 | reverse' xs = do 75 | pushAll xs 76 | popAll 77 | 78 | reverse'' :: [a] -> [a] 79 | reverse'' xs = evalState (reverse' xs) [] 80 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp/Invoice/Application.fs: -------------------------------------------------------------------------------- 1 | namespace NBB.Invoices.FSharp.Invoice 2 | 3 | open System 4 | open NBB.Core.Effects.FSharp 5 | open NBB.Core.Evented.FSharp 6 | open NBB.Application.Mediator.FSharp 7 | 8 | module CreateInvoice = 9 | type Command = 10 | { clientId: Guid 11 | contractId: Guid 12 | amount: decimal } 13 | interface ICommand 14 | 15 | let validate (command: Command) = 16 | effect { 17 | if command.amount = 0m then 18 | failwith "Empty amount" |> ignore 19 | return None 20 | else 21 | return Some command 22 | } 23 | 24 | let handle (command: Command) : Effect = 25 | effect { 26 | let invoice = 27 | InvoiceAggregate.create command.clientId (Some command.contractId) command.amount 28 | 29 | do! 30 | invoice 31 | |> Evented.run 32 | |> fst 33 | |> InvoiceRepository.save 34 | 35 | do! invoice |> Evented.exec |> Mediator.dispatchEvents 36 | 37 | return Some() 38 | } 39 | 40 | 41 | module MarkInvoiceAsPayed = 42 | type Command = 43 | { invoiceId: Guid 44 | paymentId: Guid } 45 | interface ICommand 46 | 47 | let handle cmd = 48 | effect { 49 | let! invoice = InvoiceRepository.getById cmd.invoiceId 50 | 51 | if invoice.IsNone then 52 | failwith $"Invoice with InvoiceId {cmd.invoiceId} not found!" 53 | 54 | let invoice = 55 | InvoiceAggregate.markAsPayed cmd.paymentId invoice.Value 56 | 57 | do! 58 | invoice 59 | |> Evented.run 60 | |> fst 61 | |> InvoiceRepository.save 62 | 63 | do! 64 | invoice 65 | |> Evented.exec 66 | |> List.traverse_ Mediator.dispatchEvent 67 | 68 | return Some() 69 | } 70 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp/Application.fs: -------------------------------------------------------------------------------- 1 | namespace NBB.Invoices.FSharp 2 | 3 | open NBB.Core.Effects 4 | open NBB.Core.Effects.FSharp 5 | open NBB.Application.Mediator.FSharp 6 | open Microsoft.Extensions.DependencyInjection 7 | open NBB.Messaging.Effects 8 | open NBB.Invoices.FSharp.Invoice 9 | 10 | [] 11 | module Middlewares = 12 | let logRequest = 13 | fun next req -> 14 | effect { 15 | printfn $"Before: {req.GetType().FullName}" 16 | let! result = next req 17 | printfn $"After: {req.GetType().FullName}" 18 | return result 19 | } 20 | 21 | let publishMessage = 22 | fun _ req -> 23 | effect { 24 | do! MessageBus.Publish req |> Effect.ignore 25 | return Some() 26 | } 27 | 28 | module WriteApplication = 29 | open RequestMiddleware 30 | open CommandHandler 31 | open RequestHandler 32 | 33 | let private commandPipeline : CommandMiddleware = 34 | logRequest 35 | << handlers [ CreateInvoice.validate >=> CreateInvoice.handle |> upCast 36 | MarkInvoiceAsPayed.handle |> upCast ] 37 | 38 | let private queryPipeline : QueryMiddleware = logRequest << handlers [] 39 | 40 | open EventMiddleware 41 | 42 | let private eventPipeline : EventMiddleware = logRequest << handlers [] 43 | 44 | let addServices (services: IServiceCollection) = 45 | 46 | services.AddEffects() |> ignore 47 | services.AddMessagingEffects() |> ignore 48 | services.AddMediator(commandPipeline, queryPipeline, eventPipeline) 49 | 50 | module ReadApplication = 51 | open RequestMiddleware 52 | 53 | let private commandPipeline : CommandMiddleware = logRequest << publishMessage 54 | 55 | let private queryPipeline : QueryMiddleware = logRequest << handlers [] 56 | 57 | open EventMiddleware 58 | 59 | let private eventPipeline : EventMiddleware = logRequest << handlers [] 60 | 61 | let addServices (services: IServiceCollection) = 62 | services.AddEffects() |> ignore 63 | services.AddMessagingEffects() |> ignore 64 | services.AddMediator(commandPipeline, queryPipeline, eventPipeline) 65 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/Exercises/05. Algebraic structures/01.SemiGroup.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | 3 | --instance Semigroup Integer - Not very helpful! 4 | instance Semigroup Integer where 5 | (<>) x y = x + y 6 | 7 | oneComposedWithTwo :: Integer 8 | oneComposedWithTwo = 1 <> 2 9 | 10 | -- ValidationResult Semigroup 11 | data ValidationResult = ValidationResult {isValid :: Bool, errors :: [String]} deriving (Show) 12 | 13 | merge :: ValidationResult -> ValidationResult -> ValidationResult 14 | merge x y = ValidationResult {isValid = isValid x && isValid y, errors = errors x <> errors y} 15 | 16 | instance Semigroup ValidationResult where 17 | (<>) = merge 18 | 19 | -- Min a Semigroup 20 | newtype Min a = Min {value :: a} deriving (Show, Eq, Ord) 21 | 22 | instance Ord a => Semigroup (Min a) where 23 | (<>) = min 24 | 25 | -- constraint polymorphic fn 26 | composeWithSelf :: (Semigroup a) => a -> a 27 | composeWithSelf x = x <> x 28 | 29 | x = composeWithSelf 1 30 | 31 | y = composeWithSelf ValidationResult {isValid = False, errors = ["wrong"]} 32 | 33 | z = composeWithSelf (Min 3) 34 | 35 | -- a more generalized version of ValidationResult using a parameterized type 36 | data ValidationResult' a = ValidationResult' {isValid' :: Bool, errors' :: a} deriving (Show) 37 | 38 | merge' :: Semigroup a => ValidationResult' a -> ValidationResult' a -> ValidationResult' a 39 | merge' x y = ValidationResult' {isValid' = isValid' x && isValid' y, errors' = errors' x <> errors' y} 40 | 41 | instance Semigroup a => Semigroup (ValidationResult' a) where 42 | (<>) = merge' 43 | 44 | v = composeWithSelf ValidationResult' {isValid' = False, errors' = ["wrong"]} 45 | 46 | v' = composeWithSelf ValidationResult' {isValid' = False, errors' = "wrong."} 47 | 48 | v'' = composeWithSelf ValidationResult' {isValid' = False, errors' = Min 5.0} 49 | 50 | v''' = composeWithSelf ValidationResult' {isValid' = False, errors' = [1]} 51 | 52 | --parameterized type constraints using GADTS (on data constructors not on type constructors) 53 | data T a where 54 | T :: Semigroup a => a -> T a 55 | 56 | instance Semigroup (T a) where 57 | (T x) <> (T y) = T (x <> y) 58 | 59 | myFunc :: Semigroup a => T a -> T a 60 | myFunc (T a) = T (a <> a) 61 | 62 | myFunc2 :: Semigroup a => a -> T a 63 | myFunc2 = T 64 | 65 | myAbsurdFn :: T Double -> () 66 | myAbsurdFn (T x) = () 67 | 68 | myOkFn :: T a -> T a 69 | myOkFn t = t <> t 70 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/readme.md: -------------------------------------------------------------------------------- 1 | # Chapter7. FSharp microservices 2 | 3 | 4 | 5 | ## Goals 6 | - Understand pure functional domain modelling using DDD concepts 7 | - Build evented domains using the [`evented`](https://github.com/osstotalsoft/nbb/tree/master/src/Core/NBB.Core.Evented.FSharp#README.md) monad 8 | - Clean (functional) architecture using impure-pure-impure sandwich 9 | - Dependency inversion via the [`effect`](https://github.com/osstotalsoft/nbb/tree/master/src/Core/NBB.Core.Effects.FSharp#README.md) monad 10 | - Build application pipelines using the [`NBB.Mediator.FSharp`](https://github.com/osstotalsoft/nbb/tree/master/src/Application/NBB.Application.Mediator.FSharp#README.md) 11 | - Build web apis using [`Giraffe`](https://github.com/giraffe-fsharp/Giraffe) 12 | - Build event driven stream processors (workers) powered by [`NBB.Messaging.Host`](https://github.com/osstotalsoft/nbb/tree/master/src/Messaging/NBB.Messaging.Host#README.md) and [`NBB.Messaging.Effects`](https://github.com/osstotalsoft/nbb/tree/master/src/Messaging/NBB.Messaging.Effects#README.md) 13 | 14 | ## Curricula 15 | - [`F# Types - Microsoft docs`](https://docs.microsoft.com/en-us/dotnet/fsharp/language-reference/fsharp-types) 16 | - [`The "Understanding F# types" series by Scott Wlaschin`](https://fsharpforfunandprofit.com/series/understanding-fsharp-types/) 17 | - [`Domain Modeling Made Functional by Scott Wlaschin`](https://github.com/swlaschin/DomainModelingMadeFunctional) 18 | - [`Easy domain modelling with types by Mark Seemann`](https://blog.ploeh.dk/2016/11/28/easy-domain-modelling-with-types/) 19 | - [`Six approaches to dependency injection by Scott Wlaschin`](https://fsharpforfunandprofit.com/posts/dependencies/) 20 | - [`Dealing with complex dependency injection in F# by Bartosz Sypytkowski`](https://bartoszsypytkowski.com/dealing-with-complex-dependency-injection-in-f/) 21 | - [`Purity in an impure language with the free monad – by example of a Tic-Tac-Toe backend with CQRS and event sourcing`](http://blog.leifbattermann.de/2016/12/25/purity-in-an-impure-language-free-monad-tic-tac-toe-cqrs-event-souring/#more-1096) 22 | - [`F# free monad recipe by Mark Seemann`](https://blog.ploeh.dk/2017/08/07/f-free-monad-recipe/) 23 | - [`Giraffe`](https://github.com/giraffe-fsharp/Giraffe) 24 | 25 | ## Examples 26 | - See folder [`Sample`](./Sample) for a full working web api and messaging worker 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/babel.config.js: -------------------------------------------------------------------------------- 1 | module.exports = api => { 2 | 3 | api.cache.using(() => process.env.NODE_ENV) 4 | 5 | const defaultAlias = { 6 | // "@totalsoft/zion": "@totalsoft/zion/src", 7 | // "@totalsoft/pipeline-algebra": "@totalsoft/pipeline-algebra/src", 8 | // "@totalsoft/rules-algebra": "@totalsoft/rules-algebra/src", 9 | // "@totalsoft/react-state-lens": "@totalsoft/react-state-lens/src", 10 | // "@totalsoft/change-tracking": "@totalsoft/change-tracking/src", 11 | // "@totalsoft/change-tracking-react": "@totalsoft/change-tracking-react/src", 12 | // "@totalsoft/change-tracking-react/lensProxy": "@totalsoft/change-tracking-react/src/lensProxy", 13 | }; 14 | 15 | 16 | // const presets = api.env("test") 17 | // ? [ 18 | // [ 19 | // "@babel/preset-env", 20 | // { 21 | // targets: { node: "current" } 22 | // } 23 | // ] 24 | // ] 25 | // : []; 26 | 27 | const defaultPlugins = [["@babel/plugin-proposal-pipeline-operator", { proposal: "minimal" }], "@babel/plugin-proposal-optional-chaining"]; 28 | 29 | // const plugins = api.env("test") 30 | // ? [ 31 | // ...defaultPlugins, 32 | // [ 33 | // "babel-plugin-module-resolver", 34 | // { 35 | // root: ["./"], 36 | // alias: defaultAlias 37 | // } 38 | // ] 39 | // ] 40 | // : [...defaultPlugins, ["@babel/plugin-transform-modules-commonjs"]]; 41 | 42 | return { 43 | plugins: defaultPlugins, 44 | env: { 45 | cjs: { 46 | presets: [ 47 | [ 48 | "@babel/preset-env", 49 | { 50 | modules: "commonjs" 51 | } 52 | ] 53 | ], 54 | plugins: [["@babel/plugin-transform-runtime"]] 55 | }, 56 | esm: { 57 | plugins: [["@babel/plugin-transform-runtime", { useESModules: true }]] 58 | }, 59 | test: { 60 | presets: [ 61 | [ 62 | "@babel/preset-env", 63 | { 64 | targets: { node: "current" } 65 | } 66 | ] 67 | ], 68 | plugins: [ 69 | [ 70 | "babel-plugin-module-resolver", 71 | { 72 | root: ["./"], 73 | alias: defaultAlias 74 | } 75 | ] 76 | ] 77 | } 78 | } 79 | }; 80 | }; 81 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/babel.config.js: -------------------------------------------------------------------------------- 1 | module.exports = api => { 2 | 3 | api.cache.using(() => process.env.NODE_ENV) 4 | 5 | const defaultAlias = { 6 | // "@totalsoft/zion": "@totalsoft/zion/src", 7 | // "@totalsoft/pure-validations": "@totalsoft/pure-validations/src", 8 | // "@totalsoft/rules-algebra": "@totalsoft/rules-algebra/src", 9 | // "@totalsoft/react-state-lens": "@totalsoft/react-state-lens/src", 10 | // "@totalsoft/change-tracking": "@totalsoft/change-tracking/src", 11 | // "@totalsoft/change-tracking-react": "@totalsoft/change-tracking-react/src", 12 | // "@totalsoft/change-tracking-react/lensProxy": "@totalsoft/change-tracking-react/src/lensProxy", 13 | }; 14 | 15 | 16 | // const presets = api.env("test") 17 | // ? [ 18 | // [ 19 | // "@babel/preset-env", 20 | // { 21 | // targets: { node: "current" } 22 | // } 23 | // ] 24 | // ] 25 | // : []; 26 | 27 | const defaultPlugins = [["@babel/plugin-proposal-pipeline-operator", { proposal: "minimal" }], "@babel/plugin-proposal-optional-chaining"]; 28 | 29 | // const plugins = api.env("test") 30 | // ? [ 31 | // ...defaultPlugins, 32 | // [ 33 | // "babel-plugin-module-resolver", 34 | // { 35 | // root: ["./"], 36 | // alias: defaultAlias 37 | // } 38 | // ] 39 | // ] 40 | // : [...defaultPlugins, ["@babel/plugin-transform-modules-commonjs"]]; 41 | 42 | return { 43 | plugins: defaultPlugins, 44 | env: { 45 | cjs: { 46 | presets: [ 47 | [ 48 | "@babel/preset-env", 49 | { 50 | modules: "commonjs" 51 | } 52 | ] 53 | ], 54 | plugins: [["@babel/plugin-transform-runtime"]] 55 | }, 56 | esm: { 57 | plugins: [["@babel/plugin-transform-runtime", { useESModules: true }]] 58 | }, 59 | test: { 60 | presets: [ 61 | [ 62 | "@babel/preset-env", 63 | { 64 | targets: { node: "current" } 65 | } 66 | ] 67 | ], 68 | plugins: [ 69 | [ 70 | "babel-plugin-module-resolver", 71 | { 72 | root: ["./"], 73 | alias: defaultAlias 74 | } 75 | ] 76 | ] 77 | } 78 | } 79 | }; 80 | }; 81 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.sln: -------------------------------------------------------------------------------- 1 | 2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 16 4 | VisualStudioVersion = 16.0.30907.101 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "NBB.Invoices.FSharp", "NBB.Invoices.FSharp\NBB.Invoices.FSharp.fsproj", "{F564719F-CB2C-4EF7-AF97-8277CB73D24A}" 7 | EndProject 8 | Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "NBB.Invoices.FSharp.Worker", "NBB.Invoices.FSharp.Worker\NBB.Invoices.FSharp.Worker.fsproj", "{39D1B223-499D-444A-B8AB-11157E0E69CE}" 9 | EndProject 10 | Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "NBB.Invoices.FSharp.Api", "NBB.Invoices.FSharp.Api\NBB.Invoices.FSharp.Api.fsproj", "{CF6A1AAC-B277-40FF-80FB-8106E6CAFD38}" 11 | EndProject 12 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{4BB0700C-5D2A-47E4-9E34-26C03213009E}" 13 | ProjectSection(SolutionItems) = preProject 14 | dependencies.props = dependencies.props 15 | Directory.Build.props = Directory.Build.props 16 | EndProjectSection 17 | EndProject 18 | Global 19 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 20 | Debug|Any CPU = Debug|Any CPU 21 | Release|Any CPU = Release|Any CPU 22 | EndGlobalSection 23 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 24 | {F564719F-CB2C-4EF7-AF97-8277CB73D24A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 25 | {F564719F-CB2C-4EF7-AF97-8277CB73D24A}.Debug|Any CPU.Build.0 = Debug|Any CPU 26 | {F564719F-CB2C-4EF7-AF97-8277CB73D24A}.Release|Any CPU.ActiveCfg = Release|Any CPU 27 | {F564719F-CB2C-4EF7-AF97-8277CB73D24A}.Release|Any CPU.Build.0 = Release|Any CPU 28 | {39D1B223-499D-444A-B8AB-11157E0E69CE}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 29 | {39D1B223-499D-444A-B8AB-11157E0E69CE}.Debug|Any CPU.Build.0 = Debug|Any CPU 30 | {39D1B223-499D-444A-B8AB-11157E0E69CE}.Release|Any CPU.ActiveCfg = Release|Any CPU 31 | {39D1B223-499D-444A-B8AB-11157E0E69CE}.Release|Any CPU.Build.0 = Release|Any CPU 32 | {CF6A1AAC-B277-40FF-80FB-8106E6CAFD38}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 33 | {CF6A1AAC-B277-40FF-80FB-8106E6CAFD38}.Debug|Any CPU.Build.0 = Debug|Any CPU 34 | {CF6A1AAC-B277-40FF-80FB-8106E6CAFD38}.Release|Any CPU.ActiveCfg = Release|Any CPU 35 | {CF6A1AAC-B277-40FF-80FB-8106E6CAFD38}.Release|Any CPU.Build.0 = Release|Any CPU 36 | EndGlobalSection 37 | GlobalSection(SolutionProperties) = preSolution 38 | HideSolutionNode = FALSE 39 | EndGlobalSection 40 | GlobalSection(ExtensibilityGlobals) = postSolution 41 | SolutionGuid = {60F94495-B0E5-40C6-85FF-81034F325865} 42 | EndGlobalSection 43 | EndGlobal 44 | -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pipeline-algebra/src/__tests__/algebra.tests.js: -------------------------------------------------------------------------------- 1 | import { run, empty, append, use, concat, parallel } from '../algebra' 2 | import 'jest-extended' 3 | 4 | function timeout(ms) { 5 | return new Promise(resolve => setTimeout(resolve, ms)); 6 | } 7 | 8 | describe("algebra tests:", () => { 9 | it("run: ", async () => { 10 | const ctx = {} 11 | const middleware = jest.fn() 12 | await (middleware |> run(ctx)) 13 | expect(middleware).toHaveBeenCalled() 14 | expect(middleware).toHaveBeenLastCalledWith(ctx, expect.any(Function)) 15 | }) 16 | 17 | it("empty: ", async () => { 18 | const ctx = {} 19 | await (empty |> run(ctx)) 20 | expect(ctx).toStrictEqual({}) 21 | }) 22 | 23 | it("append: ", async () => { 24 | const ctx = { value: 5 } 25 | const left = async (ctx, next) => { 26 | ctx.value += 1 27 | await next() 28 | } 29 | 30 | const right = async (ctx, next) => { 31 | ctx.value *= 2 32 | await next() 33 | } 34 | 35 | await (append(left, right) |> run(ctx)) 36 | expect(ctx.value).toBe(12) 37 | }) 38 | 39 | it("use: ", async () => { 40 | const ctx = { value: 5 } 41 | const left = async (ctx, next) => { 42 | ctx.value += 1 43 | await next() 44 | } 45 | 46 | const right = async (ctx, next) => { 47 | ctx.value *= 2 48 | await next() 49 | } 50 | 51 | await (empty |> use(left) |> use(right) |> run(ctx)) 52 | expect(ctx.value).toBe(12) 53 | }) 54 | 55 | it("concat: ", async () => { 56 | const ctx = { value: 5 } 57 | const left = async (ctx, next) => { 58 | ctx.value += 1 59 | await next() 60 | } 61 | 62 | const right = async (ctx, next) => { 63 | ctx.value *= 2 64 | await next() 65 | } 66 | 67 | const pipeline = [empty, left, right, empty, empty] |> concat 68 | await (pipeline |> run(ctx)) 69 | expect(ctx.value).toBe(12) 70 | }) 71 | 72 | it("parallel: ", async () => { 73 | const ctx = { value: 5 } 74 | const first = async (ctx, next) => { 75 | await timeout(300) 76 | ctx.value += 1 77 | await next() 78 | } 79 | 80 | const second = async (ctx, next) => { 81 | await timeout(200) 82 | ctx.value *= 2 83 | await next() 84 | } 85 | const pipeline = parallel(first, second) 86 | await (pipeline |> run(ctx)) 87 | expect(ctx.value).toBe(11) 88 | }) 89 | }) -------------------------------------------------------------------------------- /Chapter2. The foundation/readme.md: -------------------------------------------------------------------------------- 1 | # Chapter2. The foundation 2 | 3 | ## Goals 4 | The goals of this chapter is to understand why functional programming matters and get acquainted with Haskell. 5 | 6 | After completing this chapter one should be able to: 7 | - Explain the advantages of functional programming 8 | - Install Haskell via Platform or Stack 9 | - Compile a Haskell source file with GHC 10 | - Play with GHCI (quit, load a source file, import a module, evaluate expressions, check the type of an expression, time function application) 11 | - Define named and annonymous functions 12 | - Understand higher order functions 13 | - Understand closures and lexical scope 14 | - Understand currying and partial application 15 | - List data structure and functions 16 | - Recursion and pattern matching 17 | - Abstracting recursion with List hof's 18 | 19 | ## Curricula 20 | - [THINGS I WISH SOMEONE HAD EXPLAINED ABOUT FUNCTIONAL PROGRAMMING](https://jrsinclair.com/articles/2019/what-i-wish-someone-had-explained-about-functional-programming/) 21 | - Get Programming with Haskell - Lesson 1 - Lesson 10 22 | - [Lexi Lambda - An opinionated guide to Haskell in 2018](https://lexi-lambda.github.io/blog/2018/02/10/an-opinionated-guide-to-haskell-in-2018/) 23 | - [Stack vs. Platform vs. Cabal](https://stackoverflow.com/questions/48733970/how-to-install-haskell-platform-or-stack-in-2018-on-linux) 24 | - [Haskell for Visual Studio Code](https://marketplace.visualstudio.com/items?itemName=haskell.haskell) 25 | - [Why Functional Programming Matters by John Hughes at Functional Conf 2016](https://www.youtube.com/watch?v=XrNdvWqxBvA) 26 | - [Why functional programming matters - the paper](https://www.cs.kent.ac.uk/people/staff/dat/miranda/whyfp90.pdf) 27 | - [What is the flow of control](https://en.wikipedia.org/wiki/Control_flow) 28 | - [John Backus](https://en.wikipedia.org/wiki/John_Backus) 29 | - [John Backus Turing Award Lecture 1977](https://www.thocp.net/biographies/papers/backus_turingaward_lecture.pdf) 30 | - [Haskell vs. Ada vs. C++ vs. Awk vs. ...An Experiment in Software Prototyping Productivity](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.368.1058&rep=rep1&type=pdf) 31 | - [Simon Peyton-Jones: Escape from the ivory tower: the Haskell journey](https://www.youtube.com/watch?v=re96UgMk6GQ) 32 | 33 | ## Alternative Curricula 34 | - [LYaH Chapter2. Starting Out](http://learnyouahaskell.com/starting-out) 35 | - [LYaH Chapter4. Syntax in Functions](http://learnyouahaskell.com/syntax-in-functions) 36 | - [LYaH Chapter5. Recursion](http://learnyouahaskell.com/recursion) 37 | - [LYaH Chapter6. Higher Order Functions](http://learnyouahaskell.com/higher-order-functions) 38 | 39 | 40 | ## Exercises 41 | - Chapter Exercises 42 | - See folder [`Exercises`](./Exercises) 43 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Api/Program.fs: -------------------------------------------------------------------------------- 1 | module NBB.Invoices.FSharp.Api.App 2 | 3 | open System 4 | open Microsoft.AspNetCore.Builder 5 | open Microsoft.AspNetCore.Cors.Infrastructure 6 | open Microsoft.AspNetCore.Hosting 7 | open Microsoft.Extensions.Hosting 8 | open Microsoft.Extensions.Logging 9 | open Microsoft.Extensions.DependencyInjection 10 | open Giraffe 11 | open NBB.Invoices.FSharp 12 | open NBB.Invoices.FSharp.Api.HttpHandlers 13 | open NBB.Messaging.Abstractions 14 | open NBB.Messaging.Nats 15 | 16 | // --------------------------------- 17 | // Web app 18 | // --------------------------------- 19 | 20 | let webApp = 21 | choose [ subRoute "/api" (choose [ subRoute "/invoices" invoiceHandler ]) 22 | setStatusCode 404 >=> text "Not Found" ] 23 | 24 | // --------------------------------- 25 | // Error handler 26 | // --------------------------------- 27 | 28 | let errorHandler (ex: Exception) (logger: ILogger) = 29 | logger.LogError(ex, "An unhandled exception has occurred while executing the request.") 30 | 31 | clearResponse 32 | >=> setStatusCode 500 33 | >=> text ex.Message 34 | 35 | // --------------------------------- 36 | // Config and Main 37 | // --------------------------------- 38 | 39 | let configureCors (builder: CorsPolicyBuilder) = 40 | builder 41 | .WithOrigins("http://localhost:5000", "https://localhost:5001") 42 | .AllowAnyMethod() 43 | .AllowAnyHeader() 44 | |> ignore 45 | 46 | let configureApp (app: IApplicationBuilder) = 47 | let env = 48 | app.ApplicationServices.GetService() 49 | 50 | (match env.IsDevelopment() with 51 | | true -> app.UseDeveloperExceptionPage() 52 | | false -> 53 | app 54 | .UseGiraffeErrorHandler(errorHandler) 55 | .UseHttpsRedirection()) 56 | .UseCors(configureCors) 57 | .UseGiraffe(webApp) 58 | 59 | let configureServices (context: WebHostBuilderContext) (services: IServiceCollection) = 60 | services.AddCors() |> ignore 61 | services.AddGiraffe() |> ignore 62 | ReadApplication.addServices services |> ignore 63 | 64 | services 65 | .AddMessageBus() 66 | .AddNatsTransport(context.Configuration) 67 | |> ignore 68 | 69 | let configureLogging (builder: ILoggingBuilder) = 70 | builder.AddConsole().AddDebug() |> ignore 71 | 72 | [] 73 | let main args = 74 | Host 75 | .CreateDefaultBuilder(args) 76 | .ConfigureWebHostDefaults(fun webHostBuilder -> 77 | webHostBuilder 78 | .Configure(Action configureApp) 79 | .ConfigureServices(configureServices) 80 | .ConfigureLogging(configureLogging) 81 | |> ignore) 82 | .Build() 83 | .Run() 84 | 85 | 0 86 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp.Worker/Program.fs: -------------------------------------------------------------------------------- 1 | namespace NBB.Invoices.FSharp.Worker 2 | 3 | open System 4 | open Microsoft.Extensions.Configuration 5 | open Microsoft.Extensions.Hosting 6 | open Microsoft.Extensions.Logging 7 | open NBB.Messaging.Abstractions 8 | open NBB.Messaging.Nats 9 | open NBB.Messaging.Host 10 | open NBB.Messaging.Host.MessagingPipeline 11 | open NBB.Core.Effects 12 | open NBB.Application.Mediator.FSharp 13 | open NBB.Invoices.FSharp 14 | open NBB.Invoices.FSharp.Invoice 15 | 16 | module Program = 17 | 18 | // App configuration 19 | 20 | let configureServices (context: HostBuilderContext) services = 21 | let connectionString = context.Configuration.GetConnectionString("DefaultConnection") 22 | WriteApplication.addServices services |> ignore 23 | DataAccess.addServices connectionString services |> ignore 24 | 25 | services 26 | .AddMessageBus() 27 | .AddNatsTransport(context.Configuration) 28 | |> ignore 29 | 30 | services.AddMessagingHost 31 | (fun hostBuilder -> 32 | hostBuilder.Configure 33 | (fun configBuilder -> 34 | configBuilder 35 | .AddSubscriberServices(fun config -> 36 | config.AddTypes( 37 | typeof, 38 | typeof 39 | ) 40 | |> ignore) 41 | .WithDefaultOptions() 42 | .UsePipeline(fun pipelineBuilder -> 43 | pipelineBuilder 44 | .UseCorrelationMiddleware() 45 | .UseExceptionHandlingMiddleware() 46 | .UseDefaultResiliencyMiddleware() 47 | .UseEffectMiddleware(fun m -> 48 | m 49 | |> Mediator.sendMessage 50 | |> EffectExtensions.ToUnit) 51 | |> ignore) 52 | |> ignore) 53 | |> ignore) 54 | |> ignore 55 | 56 | let loggingConfig (context: HostBuilderContext) (loggingBuilder: ILoggingBuilder) = 57 | loggingBuilder.AddConsole().AddDebug() |> ignore 58 | 59 | let createHostBuilder args = 60 | Host 61 | .CreateDefaultBuilder(args) 62 | .ConfigureServices(configureServices) 63 | .ConfigureLogging(Action loggingConfig) 64 | 65 | 66 | [] 67 | let main args = 68 | createHostBuilder(args).Build().Run() 69 | 70 | 0 // exit code 71 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/01.Reader.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | 3 | newtype Reader e a = Reader {runReader :: e -> a} 4 | 5 | instance Functor (Reader e) where 6 | fmap f ra = Reader (f . runReader ra) 7 | 8 | instance Applicative (Reader e) where 9 | pure = Reader . const 10 | rf <*> ra = 11 | Reader 12 | ( \e -> 13 | let f = runReader rf e 14 | a = runReader ra e 15 | in f a 16 | ) 17 | 18 | instance Monad (Reader e) where 19 | ra >>= k = 20 | Reader 21 | ( \e -> 22 | let a = runReader ra e 23 | rb = k a 24 | in runReader rb e 25 | ) 26 | 27 | ask :: Reader a a 28 | ask = Reader id 29 | 30 | --example 1 31 | data Config = Config {topicPrefix :: String, natsUrl :: String} 32 | 33 | data CorrelationId = NoCorrelationId 34 | 35 | data Event = NoEvent 36 | 37 | data Command = NoCommand 38 | 39 | sendCommand :: Command -> Reader Config CorrelationId 40 | sendCommand cmd = do 41 | config <- ask 42 | let prefix = topicPrefix config 43 | let url = natsUrl config 44 | let correlationId = NoCorrelationId 45 | return correlationId 46 | 47 | waitForEvent :: CorrelationId -> Reader Config Event 48 | waitForEvent corelationId = do 49 | config <- ask 50 | let prefix = topicPrefix config 51 | let url = natsUrl config 52 | let event = NoEvent 53 | return event 54 | 55 | sendCommandAndWaitForEvent :: Command -> Reader Config Event 56 | sendCommandAndWaitForEvent = sendCommand >=> waitForEvent 57 | 58 | 59 | 60 | --example2 61 | data Env = Env {isProd :: Bool, secret :: Integer} 62 | 63 | isProdEnv :: Reader Env Bool 64 | isProdEnv = isProd <$> ask 65 | 66 | showEnv :: Reader Env String 67 | showEnv = do 68 | prod <- isProdEnv 69 | return $ if prod then "PRODUCTION" else "DEVELOPMENT" 70 | 71 | increment :: Integer -> Reader Env Integer 72 | increment x = do 73 | prod <- isProdEnv 74 | return $ if prod then x + 1 else x -1 75 | 76 | double :: Integer -> Reader Env Integer 77 | double x = do 78 | prod <- isProdEnv 79 | return $ if prod then x * 2 else x 80 | 81 | incrementThenDouble :: Integer -> Reader Env Integer 82 | incrementThenDouble = increment >=> double 83 | 84 | incrementThenDoubleTheSecret :: Reader Env Integer 85 | incrementThenDoubleTheSecret = do 86 | env <- ask 87 | let x = secret env 88 | x' <- increment x 89 | double x' 90 | 91 | 92 | 93 | data Context = NA 94 | 95 | myFn:: Int -> String 96 | myFn _ = "" 97 | 98 | myOtherFn:: String -> Double 99 | myOtherFn _ = 11.3 100 | 101 | myComposedFn = myOtherFn . myFn 102 | 103 | 104 | myFn':: Int -> (Context -> String) 105 | myFn' _ _ = "" 106 | 107 | myOtherFn':: String -> (Context -> Double) 108 | myOtherFn' _ _= 11.3 109 | 110 | --myComposedFn' = myOtherFn' . myFn' 111 | 112 | myComposedFn' :: Int -> Context -> Double 113 | myComposedFn' = myFn' >=> myOtherFn' 114 | -------------------------------------------------------------------------------- /Chapter1. Inception/readme.md: -------------------------------------------------------------------------------- 1 | # Chapter1. Inception 2 | 3 | ## Goals 4 | The goal of this chapter is to learn some of the history of Effective Computability and understand the two most important models of computation: the Turing Machine and the Lambda Calculus 5 | 6 | After completing this chapter one should understand: 7 | - Lambda Calculus as a formal system for expressing programs 8 | - the substitution model for function application 9 | - applicative vs normal evaluation order 10 | - Church encoding for booleans and numerals 11 | 12 | ## Curricula 13 | - [The Rise and Fall and Rise of Functional Programming](https://medium.com/javascript-scene/the-rise-and-fall-and-rise-of-functional-programming-composable-software-c2d91b424c8c) 14 | - ["Propositions as Types" by Philip Wadler](https://www.youtube.com/watch?v=IOiZatlZtGU) 15 | - [David Hilbert](https://en.wikipedia.org/wiki/David_Hilbert) 16 | - [Entscheidungsproblem](https://en.wikipedia.org/wiki/Entscheidungsproblem) 17 | - [Kurt Gödel](https://en.wikipedia.org/wiki/Kurt_G%C3%B6del) 18 | - [Gödel's incompleteness theorems](https://en.wikipedia.org/wiki/G%C3%B6del%27s_incompleteness_theorems#:~:text=G%C3%B6del's%20incompleteness%20theorems%20are%20two,in%20the%20philosophy%20of%20mathematics.) 19 | - [Gödel's General recursive function](https://en.wikipedia.org/wiki/General_recursive_function) 20 | - [Alonzo Church](https://en.wikipedia.org/wiki/Alonzo_Church) 21 | - [Lambda calculus](https://en.wikipedia.org/wiki/Lambda_calculus) 22 | - [Alan Turing](https://en.wikipedia.org/wiki/Alan_Turing) 23 | - [The Turing Machine](https://en.wikipedia.org/wiki/Turing_machine) 24 | - [Church–Turing thesis](https://en.wikipedia.org/wiki/Church%E2%80%93Turing_thesis#:~:text=It%20states%20that%20a%20function,the%20British%20mathematician%20Alan%20Turing.) 25 | - Chapter1. All You Need is Lambda - Christopher Allen, Julie Moronuki - Haskell programming from first principles 26 | - [Applicative vs Normal evaluation form](https://courses.cs.washington.edu/courses/cse505/99au/functional/applicative-normal.pdf) 27 | - [Normal, Applicative and Lazy Evaluation](https://sookocheff.com/post/fp/evaluating-lambda-expressions/) 28 | - [1.1.5 The substitution model for procedure application](https://sarabander.github.io/sicp/html/1_002e1.xhtml#g_t1_002e1_002e5) 29 | - [Church encoding](https://en.wikipedia.org/wiki/Church_encoding#:~:text=The%20Church%20numerals%20are%20a,the%20lambda%20calculus%20this%20way.&text=The%20translation%20may%20apply%20the,as%20a%20literal%20lambda%20term.) 30 | 31 | Optional: 32 | - [Fixed-point combinators in JavaScript: Memoizing recursive functions](http://matt.might.net/articles/implementation-of-recursive-fixed-point-y-combinator-in-javascript-for-memoization/) 33 | - [SKI combinator calculus with details](https://terbium.io/2019/09/ski/) 34 | - [SKI combinator calculus](https://github.com/ngzhian/ski) 35 | - [SKI combinator calculus](https://en.wikipedia.org/wiki/SKI_combinator_calculus#Self-application_and_recursion) 36 | 37 | 38 | ## Exercises 39 | - Book Exercises (Chapter1. All You Need is Lambda) 40 | - See folder [`Exercises`](./Exercises) 41 | - [Lambda calculi in JS](https://codesandbox.io/s/funny-archimedes-lmul0) 42 | -------------------------------------------------------------------------------- /Chapter3. Haskell's Type System/readme.md: -------------------------------------------------------------------------------- 1 | # Chapter3. Haskell's Type System 2 | 3 | ## Goals 4 | After completing this chapter one should be able to: 5 | - recognize the built-in data types 6 | - define new types using: type synonims, function types, sum types, product types and record syntax 7 | - explain the algebraic nature of types 8 | - recognize some common type classes 9 | - define new type classes, instances and deriving them 10 | - understand and use function composition 11 | - understand and use guards 12 | - understand the Semigroup and Monoid algebraic structures and type-classes 13 | - understand parameterized types 14 | - have some ideea about data kinds 15 | - model partial functions with the Maybe type 16 | 17 | ## Curricula 18 | - [THINGS I WISH SOMEONE HAD EXPLAINED ABOUT FUNCTIONAL PROGRAMMING - Algebraic Structures](https://jrsinclair.com/articles/2019/algebraic-structures-what-i-wish-someone-had-explained-about-functional-programming/) 19 | - [THINGS I WISH SOMEONE HAD EXPLAINED ABOUT FUNCTIONAL PROGRAMMING - Type Classes](https://jrsinclair.com/articles/2019/type-classes-what-i-wish-someone-had-explained-about-functional-programming/) 20 | - [THINGS I WISH SOMEONE HAD EXPLAINED ABOUT FUNCTIONAL PROGRAMMING - Algebraic Data Types](https://jrsinclair.com/articles/2019/algebraic-data-types-what-i-wish-someone-had-explained-about-functional-programming/) 21 | - Get Programming with Haskell - Lesson 11 -> Lesson 20 22 | - [Bartosz Milewski - Category Theory 5.2: Algebraic Data Types](https://www.youtube.com/watch?v=w1WMykh7AxA&t=1214s) 23 | - [Bartosz Milewski - Simple Algebraic Data Types](https://bartoszmilewski.com/2015/01/13/simple-algebraic-data-types/) 24 | 25 | ## Alternative Curricula 26 | - [LYaH Chapter3. Types and Typeclasses](http://learnyouahaskell.com/types-and-typeclasses) 27 | - [LYaH Chapter8. Making Our Own Types and Typeclasses](http://learnyouahaskell.com/making-our-own-types-and-typeclasses) 28 | 29 | ## A more thorough Curricula 30 | - [Haskell programming from first principles - Chapter4. Basic datatypes] 31 | - [Haskell programming from first principles - Chapter5. Types] 32 | - [Haskell programming from first principles - Chapter6. Typeclasses] 33 | - [Haskell programming from first principles - Chapter11. Algebraic datatypes] 34 | - [Haskell programming from first principles - Chapter12. Signaling adversity] 35 | 36 | ## More fun with semigroups and monoids in your favourite language 37 | - [Hackage Semigroup](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-Semigroup.html) 38 | - [Hackage Monoid](https://hackage.haskell.org/package/base-4.14.1.0/docs/Data-Monoid.html) 39 | - [Ploeh C# - Monoids, semigroups, and friends](https://blog.ploeh.dk/2017/10/05/monoids-semigroups-and-friends/) 40 | - [Tom Harding JS - Fantas, Eel, and Specification](http://www.tomharding.me/fantasy-land/) 41 | - [Wlaschin F# - Monoids without tears](https://fsharpforfunandprofit.com/posts/monoids-without-tears/) 42 | - [Algebraic data types, algebraic structures and polymorphic fns in JSBB](https://codesandbox.io/s/youthful-nightingale-cclrs) 43 | - [Algebraic structures in F# NBB](https://github.com/osstotalsoft/nbb/blob/f21d42d8610442f0bc6fa265870401209c0e04c0/test/UnitTests/Application/NBB.Application.Mediator.FSharp.Tests/Sample.fs#L193) 44 | 45 | ## Exercises 46 | - See folder [`Exercises`](./Exercises) -------------------------------------------------------------------------------- /Chapter8. JavaScript libraries/Sample/pure-validations/src/__tests__/combinators.test.js: -------------------------------------------------------------------------------- 1 | import { required, email } from '../primitiveValidators' 2 | import { stopOnFirstFailure, concatFailure, error, field, shape, items, allProps } from '../combinators' 3 | import { ValidationResult } from '../algebra' 4 | import { $do } from '@totalsoft/zion' 5 | import { map, concat } from 'ramda' 6 | 7 | const { Success, Failure } = ValidationResult 8 | 9 | describe("combinators tests:", () => { 10 | it("stopOnFirstFailure: ", () => { 11 | const validator = stopOnFirstFailure([required, email]) 12 | expect(validator(null)).toStrictEqual(Failure(["required"])) 13 | expect(validator("notAnEmail")).toStrictEqual(Failure(["not an email"])) 14 | }) 15 | 16 | it("concatFailure: ", () => { 17 | const validator = concatFailure([required, email]) 18 | expect(validator(null)).toStrictEqual(Failure(["required", "not an email"])) 19 | expect(validator("notAnEmail")).toStrictEqual(Failure(["not an email"])) 20 | }) 21 | 22 | it("do notation: ", () => { 23 | const validator = x => $do(function* () { 24 | const x1 = yield required(x) 25 | return yield email(x1 + "@totalsoft.ro") 26 | }) 27 | expect(validator(null)).toStrictEqual(Failure(["required"])) 28 | expect(validator("notAnEmail")).toStrictEqual(Success("notAnEmail@totalsoft.ro")) 29 | }) 30 | 31 | it("error: ", () => { 32 | const validator = required |> error(map(concat("*"))); 33 | expect(validator(null)).toStrictEqual(Failure(["*required"])) 34 | expect(validator("something")).toStrictEqual(Success("something")) 35 | }) 36 | 37 | it("field: ", () => { 38 | const validator = required |> field("name") 39 | expect(validator({ name: null })).toStrictEqual(Failure(["name: required"])) 40 | expect(validator({ name: "radu" })).toStrictEqual(Success({ name: "radu" })) 41 | }) 42 | 43 | it("shape: ", () => { 44 | const validator = shape({ name: required, email: email }) 45 | expect(validator({ name: null, email: "notAnEmail" })).toStrictEqual(Failure(["name: required", "email: not an email"])) 46 | //expect(validator({name:"radu"})).toStrictEqual(Success({name:"radu"})) 47 | }) 48 | 49 | it("items: ", () => { 50 | const validator = required |> items 51 | expect(validator([null, null])).toStrictEqual(Failure(["0: required", "1: required"])) 52 | expect(validator(["null", null])).toStrictEqual(Failure(["1: required"])) 53 | }) 54 | 55 | it("allProps: ", () => { 56 | const validator = required |> allProps 57 | expect(validator({name: null, surname: null, age: null})).toStrictEqual(Failure(["name: required", "surname: required", "age: required"])) 58 | }) 59 | 60 | it("composed validator: ", () => { 61 | const validator = shape({ 62 | name: required |> error(map(concat("*"))), 63 | email: [required, email] |> stopOnFirstFailure, 64 | addresses: required |> items 65 | }) 66 | expect(validator({ 67 | name: "", 68 | email: "wrongEmail", 69 | addresses: ["some addr", ""] 70 | })).toStrictEqual(Failure(["name: *required", "email: not an email", "addresses: 1: required"])) 71 | //expect(validator({name:"radu"})).toStrictEqual(Success({name:"radu"})) 72 | }) 73 | }) -------------------------------------------------------------------------------- /Chapter5. Functors Applicatives & Monads/Examples/04.DataSource.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | 3 | --Define the DataSource Algebra 4 | type DataSource i o = i -> DataSourceResult o 5 | 6 | newtype DataSourceResult a = DataSourceResult 7 | { run :: IO (Maybe a) 8 | } 9 | 10 | instance Functor DataSourceResult where 11 | fmap fn (DataSourceResult r) = DataSourceResult (fmap (fmap fn) r) 12 | 13 | instance Applicative DataSourceResult where 14 | pure = DataSourceResult . pure . pure 15 | (DataSourceResult fn) <*> (DataSourceResult x) = DataSourceResult r 16 | where 17 | r = 18 | do 19 | fn' <- fn 20 | x' <- x 21 | return $ fn' <*> x' 22 | 23 | instance Monad DataSourceResult where 24 | (DataSourceResult x) >>= fn = DataSourceResult r 25 | where 26 | r = 27 | do 28 | x' <- x 29 | run $ fn' x' 30 | 31 | fn' Nothing = DataSourceResult (return Nothing) 32 | fn' (Just x) = fn x 33 | 34 | --Use the DataSource algebra in some domain 35 | 36 | type UserId = Integer 37 | 38 | type ContractId = Integer 39 | 40 | type ClientId = Integer 41 | 42 | type AssetId = Integer 43 | 44 | type Amount = Double 45 | 46 | data Contract = Contract 47 | { contractId :: ContractId, 48 | clientId :: ClientId, 49 | amount :: Amount 50 | } 51 | deriving (Show) 52 | 53 | data Asset = Asset 54 | { assetId :: AssetId, 55 | ctrId :: ContractId, 56 | description :: String 57 | } 58 | deriving (Show) 59 | 60 | --primitive DataSources 61 | contractsByClientId :: DataSource ClientId [Contract] 62 | contractsByClientId clientId = 63 | DataSourceResult 64 | ( do 65 | putStrLn $ "Executing contractsByClientId sql query for clientId " ++ show clientId 66 | --return Nothing 67 | --ioError $ userError "Some Sql exc" 68 | let contracts = [Contract 1 clientId 2000.0, Contract 2 clientId 2000.0] 69 | print contracts 70 | return $ Just contracts 71 | ) 72 | 73 | assetsByContractId :: DataSource ContractId [Asset] 74 | assetsByContractId contractId = 75 | DataSourceResult 76 | ( do 77 | putStrLn $ "Executing assetsByContractId sql query for contractId " ++ show contractId 78 | let assets = [Asset 1 contractId "BMW E92", Asset 1 contractId "BMW E60"] 79 | print assets 80 | return $ Just assets 81 | ) 82 | 83 | clientIdByUserId :: DataSource UserId ClientId 84 | clientIdByUserId userId = 85 | DataSourceResult 86 | ( do 87 | putStrLn $ "Executing clientIdByUserId sql query for userId " ++ show userId 88 | let clientId = 10 + userId 89 | print clientId 90 | return $ Just clientId 91 | ) 92 | 93 | --create new data sources by combining existing ones 94 | totalContractsAmountByClientId :: DataSource ClientId Amount 95 | totalContractsAmountByClientId clientId = totalAmount <$> contractsByClientId clientId 96 | where 97 | totalAmount = foldr ((+) . amount) 0 98 | 99 | totalContractsAmountByUserid :: DataSource UserId Amount 100 | totalContractsAmountByUserid = clientIdByUserId >=> totalContractsAmountByClientId 101 | 102 | assetsByClientId :: DataSource ClientId [Asset] 103 | assetsByClientId clientId = do 104 | contracts <- contractsByClientId clientId 105 | assets <- mapM (assetsByContractId . contractId) contracts 106 | return $ join assets 107 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/03.RulesAlgebraWithLenses.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | 3 | import Control.Monad 4 | import Control.Monad.Reader 5 | 6 | data Lens a b = Lens 7 | { get :: a -> b, 8 | set :: a -> b -> a 9 | } 10 | 11 | newtype Rule a b = Rule {runRule :: a -> a -> b} -- model -> Reader model model 12 | 13 | type Predicate a = a -> a -> Bool 14 | 15 | instance Semigroup (Rule a a) where 16 | r1 <> r2 = Rule (runRule r1 >=> runRule r2) 17 | 18 | instance Monoid (Rule a a) where 19 | mempty = Rule return 20 | 21 | ruleFor :: Lens a b -> Rule a b -> Rule a a 22 | ruleFor l r = 23 | Rule 24 | ( \model prevModel -> 25 | let newB = runRule r model prevModel 26 | in set l model newB 27 | ) 28 | 29 | (==>) :: Lens a b -> Rule a b -> Rule a a 30 | (==>) = ruleFor 31 | 32 | updateWith :: Rule a a -> Lens a b -> b -> a -> a 33 | updateWith r l v m = runRule r m' m 34 | where 35 | m' = set l m v 36 | 37 | when' :: Predicate a -> Rule a a -> Rule a a 38 | when' predicate rule = 39 | Rule 40 | ( \a -> do 41 | cond <- predicate a 42 | if cond then runRule rule a else return a 43 | ) 44 | 45 | (|>) :: Rule a a -> Predicate a -> Rule a a 46 | rule |> predicate = when' predicate rule 47 | 48 | prop :: (a -> b) -> Predicate b -> Predicate a 49 | prop selector pred a = do 50 | a' <- ask 51 | let b = selector a 52 | let b' = selector a' 53 | let cond = pred b b' 54 | return cond 55 | 56 | -- implementation 57 | data Address = Address {city :: String, number :: Int} deriving (Show) 58 | 59 | data Person = Person {personId :: Int, fName :: String, lName :: String, fullName :: String, address :: Maybe Address, version :: Int} deriving (Show) 60 | 61 | -- autogenerated stuff 62 | personId' :: Lens Person Int 63 | personId' = Lens personId (\person personId -> person {personId = personId}) 64 | 65 | fName' :: Lens Person String 66 | fName' = Lens fName (\person fName -> person {fName = fName}) 67 | 68 | lName' :: Lens Person String 69 | lName' = Lens lName (\person lName -> person {lName = lName}) 70 | 71 | fullName' :: Lens Person String 72 | fullName' = Lens fullName (\person fullName -> person {fullName = fullName}) 73 | 74 | version' :: Lens Person Int 75 | version' = Lens version (\person version -> person {version = version}) 76 | 77 | address' :: Lens Person (Maybe Address) 78 | address' = Lens address (\person address -> person {address = address}) 79 | 80 | city' :: Lens Address String 81 | city' = Lens city (\address city -> address {city = city}) 82 | 83 | number' :: Lens Address Int 84 | number' = Lens number (\address number -> address {number = number}) 85 | 86 | rules :: Rule Person Person 87 | rules = 88 | mconcat 89 | [ fullName' ==> Rule (\person -> return $ fName person ++ " " ++ lName person), 90 | personId' ==> Rule (\person -> return 7) |> prop lName (return . (== "Popovici")), 91 | version' ==> Rule (return . (+ 1) . version) |> prop fullName (/=), 92 | address' ==> Rule (return . const Nothing ) |> prop personId (/=) 93 | -- address' |=> mconcat 94 | -- [ city' ==> Rule (return . city), 95 | -- number' ==> Rule (return . number) 96 | -- ] 97 | ] 98 | 99 | verbosePersonIdRule :: Rule Person Person 100 | verbosePersonIdRule = 101 | personId' ==> Rule (\person -> return $ if lName person == "Popovici" then 7 else personId person) 102 | 103 | verboseVersionRule :: Rule Person Person 104 | verboseVersionRule = 105 | version' 106 | ==> Rule 107 | ( \person -> do 108 | prevPerson <- ask 109 | return $ if fullName person /= fullName prevPerson then version person + 1 else version person 110 | ) 111 | 112 | addressRules :: Rule Address Address 113 | addressRules = 114 | mconcat 115 | [ city' ==> Rule (return . city), 116 | number' ==> Rule (return . number) 117 | ] 118 | 119 | person :: Person 120 | person = Person 1 "Radu" "Popovici" " " Nothing 0 121 | 122 | updated :: Person 123 | updated = updateWith rules fName' "Matei" person 124 | -------------------------------------------------------------------------------- /Chapter7. FSharp microservices/Sample/NBB.Invoices.FSharp/NBB.Invoices.FSharp/Invoice/Data.fs: -------------------------------------------------------------------------------- 1 | namespace NBB.Invoices.FSharp.Invoice 2 | 3 | open InvoiceAggregate 4 | open System 5 | open Microsoft.Data.SqlClient 6 | open FSharp.Control.Tasks 7 | open System.Threading.Tasks 8 | 9 | module InvoiceRepositoryImpl = 10 | 11 | let unboxOption<'a> (o: obj) : 'a option = 12 | if (isNull o) || DBNull.Value.Equals o then 13 | None 14 | else 15 | Some(unbox o) 16 | 17 | let boxOption<'a> (x: 'a option) = 18 | match x with 19 | | Some y -> box y 20 | | None -> box DBNull.Value 21 | 22 | let getById connectionString (invoiceId: Guid) cancellationToken : Task = 23 | task { 24 | use conn = new SqlConnection(connectionString) 25 | do! conn.OpenAsync(cancellationToken) 26 | 27 | let query = 28 | "SELECT InvoiceId, ClientId, ContractId, Amount, PaymentId 29 | FROM FS_Invoices WHERE InvoiceId = @InvoiceId" 30 | 31 | use cmd = new SqlCommand(query, conn) 32 | 33 | cmd.Parameters.AddWithValue("@InvoiceId", invoiceId) 34 | |> ignore 35 | 36 | let! r = cmd.ExecuteReaderAsync(cancellationToken) 37 | 38 | let results = 39 | [ while r.Read() do 40 | yield 41 | { Id = unbox r.[0] 42 | ClientId = unbox r.[1] 43 | ContractId = unboxOption r.[2] 44 | Amount = unbox r.[3] 45 | PaymentId = unboxOption r.[4] } ] 46 | 47 | return 48 | if results.IsEmpty then 49 | None 50 | else 51 | results.Head |> Some 52 | } 53 | 54 | 55 | let save connectionString invoice cancellationToken = 56 | task { 57 | use conn = new SqlConnection(connectionString) 58 | do! conn.OpenAsync(cancellationToken) 59 | 60 | let query = 61 | "IF NOT EXISTS(SELECT 1 FROM FS_Invoices WHERE InvoiceId = @InvoiceId) 62 | BEGIN 63 | INSERT INTO FS_Invoices(InvoiceId, ClientId, ContractId, Amount, PaymentId) 64 | SELECT @InvoiceId, @ClientId, @ContractId, @Amount, @PaymentId 65 | END 66 | ELSE 67 | BEGIN 68 | UPDATE FS_Invoices 69 | SET ClientId = @ClientId, ContractId = @ContractId, Amount = @Amount, PaymentId = @PaymentId 70 | WHERE InvoiceId = @InvoiceId 71 | END" 72 | 73 | use cmd = new SqlCommand(query, conn) 74 | 75 | cmd.Parameters.AddWithValue("@InvoiceId", invoice.Id) 76 | |> ignore 77 | 78 | cmd.Parameters.AddWithValue("@ClientId", invoice.ClientId) 79 | |> ignore 80 | 81 | cmd.Parameters.AddWithValue("@ContractId", invoice.ContractId |> boxOption) 82 | |> ignore 83 | 84 | cmd.Parameters.AddWithValue("@Amount", invoice.Amount) 85 | |> ignore 86 | 87 | cmd.Parameters.AddWithValue("@PaymentId", invoice.PaymentId |> boxOption) 88 | |> ignore 89 | 90 | let! _ = cmd.ExecuteNonQueryAsync(cancellationToken) 91 | return () 92 | } 93 | 94 | 95 | 96 | 97 | let handle<'a> connectionString (sideEffect: InvoiceRepository.SideEffect<'a>) cancellationToken : Task<'a> = 98 | match sideEffect with 99 | | InvoiceRepository.GetById (invoiceId, cont) -> 100 | task { 101 | let! invoice = getById connectionString invoiceId cancellationToken 102 | 103 | printfn $"InvoiceRepositoryImpl.GetById {invoiceId} => {invoice}" 104 | 105 | return invoice |> cont 106 | } 107 | | InvoiceRepository.Save (invoice, cont) -> 108 | task { 109 | printfn $"InvoiceRepositoryImpl.Save {invoice}" 110 | do! save connectionString invoice cancellationToken 111 | return cont () 112 | } 113 | 114 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/10.GqlQueries2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | 3 | import Control.Monad 4 | import Control.Monad.Reader 5 | import qualified Data.Map as Map 6 | import Data.Maybe 7 | 8 | --schema 9 | type TenantId = Int 10 | type UserId = Int 11 | type ClaimId = Int 12 | type ClaimName = String 13 | 14 | data Tenant = Tenant {tenantId :: TenantId, tenantName :: String} deriving (Show) 15 | 16 | data User = User {userId :: UserId, userName :: String, _tenantId :: TenantId} deriving (Show) 17 | 18 | data Claim = Claim {claimId :: ClaimId, claimName :: String} 19 | 20 | data UserClaim = UserClaim {_userId :: UserId, _claimId :: ClaimId} 21 | 22 | data Query a where 23 | GetTenantById :: TenantId -> Query Tenant 24 | GetUserById :: UserId -> Query User 25 | GetAllUsers :: Query [User] 26 | GetClaimById :: ClaimId -> Query Claim 27 | GetAllUsersByTenantId :: TenantId -> Query [User] 28 | GetTenantByUserId :: UserId -> Query Tenant 29 | GetUserHasClaim :: (UserId, ClaimName) -> Query Bool 30 | GetAllUsersWithClaim :: ClaimName -> Query [User] 31 | 32 | newtype Context = Context 33 | { dataSources :: DataSources 34 | } 35 | 36 | data DataSources = DataSources 37 | { tenants :: Map.Map TenantId Tenant, 38 | users :: Map.Map UserId User, 39 | claims :: Map.Map ClaimId Claim, 40 | userClaims :: Map.Map UserId [UserClaim] 41 | } 42 | 43 | --resolvers 44 | type Resolver q c a = q -> ReaderT c Maybe a 45 | 46 | getTenantById :: Resolver TenantId Context Tenant 47 | getTenantById tenantId = do 48 | ds <- asks dataSources 49 | let tenant = Map.lookup tenantId (tenants ds) 50 | lift tenant 51 | 52 | getUserById :: Resolver UserId Context User 53 | getUserById userId = do 54 | ds <- asks dataSources 55 | let user = Map.lookup userId (users ds) 56 | lift user 57 | 58 | getAllUsers :: Resolver () Context [User] 59 | getAllUsers () = do 60 | ds <- asks dataSources 61 | let userList = snd <$> Map.toList (users ds) 62 | return userList 63 | 64 | getClaimById :: Resolver ClaimId Context Claim 65 | getClaimById claimId = do 66 | ds <- asks dataSources 67 | let claim = Map.lookup claimId (claims ds) 68 | lift claim 69 | 70 | getUserClaims :: Resolver UserId Context [UserClaim] 71 | getUserClaims userId = do 72 | ds <- asks dataSources 73 | let claims = Map.lookup userId (userClaims ds) 74 | lift claims 75 | 76 | --todo:: Implement the following resolvers by composing existing ones 77 | --hint: In order to keep things DRY, do not use the context at all, 78 | -- you should only use the resolvers from above: 79 | -- getTenantById, getUserById, getAllUsers, getClaimById, getUserClaims 80 | 81 | getAllUsersByTenantId :: Resolver TenantId Context [User] 82 | getAllUsersByTenantId tId = filter (\x -> _tenantId x == tId) <$> getAllUsers () 83 | 84 | getTenantByUserId :: Resolver UserId Context Tenant 85 | getTenantByUserId = getUserById >=> getTenantById . _tenantId 86 | 87 | -- getTenantByUserId userId = do 88 | -- user <- getUserById userId 89 | -- let tid = _tenantId user 90 | -- getTenantById tid 91 | 92 | getUserHasClaim :: Resolver (UserId, ClaimName) Context Bool 93 | getUserHasClaim (userId, claim) = do 94 | userClaims <- getUserClaims userId 95 | claims <- mapM getClaimById (_claimId <$> userClaims) 96 | if any (\x -> claimName x == claim) claims 97 | then return True 98 | else return False 99 | 100 | getAllUsersWithClaim :: Resolver ClaimName Context [User] 101 | getAllUsersWithClaim claim = do 102 | users <- getAllUsers () 103 | filterM (\x -> getUserHasClaim (userId x, claim)) users 104 | 105 | 106 | resolver :: Resolver (Query a) Context a 107 | resolver (GetTenantById query) = getTenantById query 108 | resolver (GetUserById query) = getUserById query 109 | resolver GetAllUsers = getAllUsers () 110 | resolver (GetClaimById query) = getClaimById query 111 | resolver (GetAllUsersByTenantId query) = getAllUsersByTenantId query 112 | resolver (GetTenantByUserId query) = getTenantByUserId query 113 | resolver (GetUserHasClaim query) = getUserHasClaim query 114 | resolver (GetAllUsersWithClaim query) = getAllUsersWithClaim query 115 | 116 | executeQuery :: Query a -> Context -> Maybe a 117 | executeQuery = runReaderT . resolver 118 | 119 | --test 120 | tenantMap :: Map.Map TenantId Tenant 121 | tenantMap = Map.fromList [(1, Tenant 1 "TS")] 122 | 123 | userMap :: Map.Map UserId User 124 | userMap = Map.fromList [(1, User 1 "radu" 1), (2, User 2 "matei" 1)] 125 | 126 | claimMap :: Map.Map Int Claim 127 | claimMap = Map.fromList [(1, Claim 1 "read"), (2, Claim 2 "write")] 128 | 129 | userClaimMap :: Map.Map UserId [UserClaim] 130 | userClaimMap = Map.fromList [(1, [UserClaim 1 1]), (2, [UserClaim 2 1])] 131 | 132 | ctx :: Context 133 | ctx = Context $ DataSources tenantMap userMap claimMap userClaimMap 134 | 135 | tenant1 :: Maybe Tenant 136 | tenant1 = executeQuery (GetTenantByUserId 1) ctx 137 | 138 | user1HasReadAccess :: Maybe Bool 139 | user1HasReadAccess = executeQuery (GetUserHasClaim (1, "read")) ctx 140 | 141 | 142 | allUsersWithReadAccess :: Maybe [User] 143 | allUsersWithReadAccess = executeQuery (GetAllUsersWithClaim "read") ctx 144 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/09.GqlQueries.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | 3 | import Control.Monad 4 | import Control.Monad.Reader 5 | import qualified Data.Map as Map 6 | import Data.Maybe 7 | 8 | --schema 9 | type TenantId = Int 10 | type UserId = Int 11 | type ClaimId = Int 12 | type ClaimName = String 13 | 14 | data Tenant = Tenant {tenantId :: TenantId, tenantName :: String} deriving (Show) 15 | 16 | data User = User {userId :: UserId, userName :: String, _tenantId :: TenantId} deriving (Show) 17 | 18 | data Claim = Claim {claimId :: ClaimId, claimName :: String} 19 | 20 | data UserClaim = UserClaim {_userId :: UserId, _claimId :: ClaimId} 21 | 22 | data Query a where 23 | GetTenantById :: TenantId -> Query Tenant 24 | GetUserById :: UserId -> Query User 25 | GetAllUsers :: Query [User] 26 | GetClaimById :: ClaimId -> Query Claim 27 | GetAllUsersByTenantId :: TenantId -> Query [User] 28 | GetTenantByUserId :: UserId -> Query Tenant 29 | GetUserHasClaim :: (UserId, ClaimName) -> Query Bool 30 | GetAllUsersWithClaim :: ClaimName -> Query [User] 31 | 32 | newtype Context = Context 33 | { dataSources :: DataSources 34 | } 35 | 36 | data DataSources = DataSources 37 | { tenants :: Map.Map TenantId Tenant, 38 | users :: Map.Map UserId User, 39 | claims :: Map.Map ClaimId Claim, 40 | userClaims :: Map.Map UserId [UserClaim] 41 | } 42 | 43 | --resolvers 44 | type Resolver q c a = q -> Reader c a 45 | 46 | getTenantById :: Resolver TenantId Context Tenant 47 | getTenantById tenantId = asks $ fromJust . Map.lookup tenantId . tenants . dataSources 48 | 49 | -- getTenantById tenantId = do 50 | -- ds <- asks dataSources 51 | -- let tenant = Map.lookup tenantId (tenants ds) 52 | -- return $ fromJust tenant 53 | 54 | getUserById :: Resolver UserId Context User 55 | getUserById userId = asks $ fromJust . Map.lookup userId . users . dataSources 56 | 57 | -- getUserById userId = do 58 | -- ds <- asks dataSources 59 | -- let user = Map.lookup userId (users ds) 60 | -- return $ fromJust user 61 | 62 | getAllUsers :: Resolver () Context [User] 63 | getAllUsers () = asks $ fmap snd . Map.toList . users . dataSources 64 | 65 | -- getAllUsers () = do 66 | -- ds <- asks dataSources 67 | -- let userList = snd <$> Map.toList (users ds) 68 | -- return userList 69 | 70 | getClaimById :: Resolver ClaimId Context Claim 71 | getClaimById claimId = asks $ fromJust . Map.lookup claimId . claims . dataSources 72 | 73 | -- getClaimById claimId = do 74 | -- ds <- asks dataSources 75 | -- let claim = Map.lookup claimId (claims ds) 76 | -- return $ fromJust claim 77 | 78 | getUserClaims :: Resolver UserId Context [UserClaim] 79 | getUserClaims userId = asks $ fromJust . Map.lookup userId . userClaims . dataSources 80 | 81 | -- getUserClaims userId = do 82 | -- ds <- asks dataSources 83 | -- let claims = Map.lookup userId (userClaims ds) 84 | -- return $ fromJust claims 85 | 86 | --todo:: Implement the following resolvers by composing existing ones 87 | --hint: In order to keep things DRY, do not use the context at all, 88 | -- you should only use the resolvers from above: 89 | -- getTenantById, getUserById, getAllUsers, getClaimById, getUserClaims 90 | 91 | getAllUsersByTenantId :: Resolver TenantId Context [User] 92 | getAllUsersByTenantId tId = filter ((tId ==) . _tenantId) <$> getAllUsers () 93 | 94 | getTenantByUserId :: Resolver UserId Context Tenant 95 | getTenantByUserId = getUserById >=> getTenantById . _tenantId 96 | 97 | -- getTenantByUserId userId = do 98 | -- user <- getUserById userId 99 | -- let tid = _tenantId user 100 | -- getTenantById tid 101 | 102 | getUserHasClaim :: Resolver (UserId, ClaimName) Context Bool 103 | getUserHasClaim (userId, claim) = do 104 | userClaims <- getUserClaims userId 105 | claims <- mapM getClaimById (_claimId <$> userClaims) 106 | return $ any (\x -> claimName x == claim) claims 107 | 108 | getAllUsersWithClaim :: Resolver ClaimName Context [User] 109 | getAllUsersWithClaim claim = do 110 | users <- getAllUsers () 111 | filterM (\x -> getUserHasClaim (userId x, claim)) users 112 | 113 | 114 | resolver :: Resolver (Query a) Context a 115 | resolver (GetTenantById query) = getTenantById query 116 | resolver (GetUserById query) = getUserById query 117 | resolver GetAllUsers = getAllUsers () 118 | resolver (GetClaimById query) = getClaimById query 119 | resolver (GetAllUsersByTenantId query) = getAllUsersByTenantId query 120 | resolver (GetTenantByUserId query) = getTenantByUserId query 121 | resolver (GetUserHasClaim query) = getUserHasClaim query 122 | resolver (GetAllUsersWithClaim query) = getAllUsersWithClaim query 123 | 124 | executeQuery :: Query a -> Context -> a 125 | executeQuery = runReader . resolver 126 | 127 | --test 128 | tenantMap :: Map.Map TenantId Tenant 129 | tenantMap = Map.fromList [(1, Tenant 1 "TS")] 130 | 131 | userMap :: Map.Map UserId User 132 | userMap = Map.fromList [(1, User 1 "radu" 1), (2, User 2 "matei" 1)] 133 | 134 | claimMap :: Map.Map Int Claim 135 | claimMap = Map.fromList [(1, Claim 1 "read"), (2, Claim 2 "write")] 136 | 137 | userClaimMap :: Map.Map UserId [UserClaim] 138 | userClaimMap = Map.fromList [(1, [UserClaim 1 1]), (2, [UserClaim 2 1])] 139 | 140 | ctx :: Context 141 | ctx = Context $ DataSources tenantMap userMap claimMap userClaimMap 142 | 143 | tenant1 :: Tenant 144 | tenant1 = executeQuery (GetTenantByUserId 1) ctx 145 | 146 | user1HasReadAccess :: Bool 147 | user1HasReadAccess = executeQuery (GetUserHasClaim (1, "read")) ctx 148 | 149 | 150 | allUsersWithReadAccess :: [User] 151 | allUsersWithReadAccess = executeQuery (GetAllUsersWithClaim "read") ctx 152 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/11.GqlQueries3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | 3 | import Control.Monad 4 | import Control.Monad.Reader 5 | import Control.Monad.Trans 6 | import Control.Monad.Trans.Maybe 7 | import qualified Data.Map as Map 8 | import Data.Maybe 9 | import Data.Typeable 10 | 11 | --schema 12 | type TenantId = Int 13 | 14 | type UserId = Int 15 | 16 | type ClaimId = Int 17 | 18 | type ClaimName = String 19 | 20 | data Tenant = Tenant {tenantId :: TenantId, tenantName :: String} deriving (Show) 21 | 22 | data User = User {userId :: UserId, userName :: String, _tenantId :: TenantId} deriving (Show) 23 | 24 | data Claim = Claim {claimId :: ClaimId, claimName :: String} 25 | 26 | data UserClaim = UserClaim {_userId :: UserId, _claimId :: ClaimId} 27 | 28 | data Query a where 29 | GetTenantById :: TenantId -> Query Tenant 30 | GetUserById :: UserId -> Query User 31 | GetAllUsers :: Query [User] 32 | GetClaimById :: ClaimId -> Query Claim 33 | GetAllUsersByTenantId :: TenantId -> Query [User] 34 | GetTenantByUserId :: UserId -> Query Tenant 35 | GetUserHasClaim :: (UserId, ClaimName) -> Query Bool 36 | GetAllUsersWithClaim :: ClaimName -> Query [User] 37 | 38 | newtype Context = Context 39 | { dataSources :: DataSources 40 | } 41 | 42 | data DataSources = DataSources 43 | { tenants :: DB TenantId Tenant, 44 | users :: DB UserId User, 45 | claims :: DB ClaimId Claim, 46 | userClaims :: DB UserId [UserClaim] 47 | } 48 | 49 | data DB i a = DB 50 | { getById :: i -> MaybeT IO a, 51 | getAll :: MaybeT IO [a] 52 | } 53 | 54 | --resolvers 55 | type Resolver q c a = q -> ReaderT c (MaybeT IO) a 56 | 57 | getTenantById :: Resolver TenantId Context Tenant 58 | getTenantById tenantId = do 59 | liftIO $ putStrLn $ "****DEBUG: getTenantById " ++ " " ++ show tenantId 60 | tenantDb <- asks (tenants . dataSources) 61 | let tenant = tenantDb `getById` tenantId 62 | lift tenant 63 | 64 | getUserById :: Resolver UserId Context User 65 | getUserById userId = do 66 | userDB <- asks (users . dataSources) 67 | let user = userDB `getById` userId 68 | lift user 69 | 70 | getAllUsers :: Resolver () Context [User] 71 | getAllUsers () = do 72 | userDB <- asks (users . dataSources) 73 | let userList = getAll userDB 74 | lift userList 75 | 76 | getClaimById :: Resolver ClaimId Context Claim 77 | getClaimById claimId = do 78 | claimDb <- asks (claims . dataSources) 79 | let claim = claimDb `getById` claimId 80 | lift claim 81 | 82 | getUserClaims :: Resolver UserId Context [UserClaim] 83 | getUserClaims userId = do 84 | userClaimDb <- asks (userClaims . dataSources) 85 | let claims = userClaimDb `getById` userId 86 | lift claims 87 | 88 | --todo:: Implement the following resolvers by composing existing ones 89 | --hint: In order to keep things DRY, do not use the context at all, 90 | -- you should only use the resolvers from above: 91 | -- getTenantById, getUserById, getAllUsers, getClaimById, getUserClaims 92 | 93 | getAllUsersByTenantId :: Resolver TenantId Context [User] 94 | getAllUsersByTenantId tId = filter (\x -> _tenantId x == tId) <$> getAllUsers () 95 | 96 | getTenantByUserId :: Resolver UserId Context Tenant 97 | getTenantByUserId = getUserById >=> getTenantById . _tenantId 98 | 99 | -- getTenantByUserId userId = do 100 | -- user <- getUserById userId 101 | -- let tid = _tenantId user 102 | -- getTenantById tid 103 | 104 | getUserHasClaim :: Resolver (UserId, ClaimName) Context Bool 105 | getUserHasClaim (userId, claim) = do 106 | userClaims <- getUserClaims userId 107 | claims <- mapM getClaimById (_claimId <$> userClaims) 108 | if any (\x -> claimName x == claim) claims 109 | then return True 110 | else return False 111 | 112 | getAllUsersWithClaim :: Resolver ClaimName Context [User] 113 | getAllUsersWithClaim claim = do 114 | users <- getAllUsers () 115 | filterM (\x -> getUserHasClaim (userId x, claim)) users 116 | 117 | 118 | resolver :: Resolver (Query a) Context a 119 | resolver (GetTenantById query) = getTenantById query 120 | resolver (GetUserById query) = getUserById query 121 | resolver GetAllUsers = getAllUsers () 122 | resolver (GetClaimById query) = getClaimById query 123 | resolver (GetAllUsersByTenantId query) = getAllUsersByTenantId query 124 | resolver (GetTenantByUserId query) = getTenantByUserId query 125 | resolver (GetUserHasClaim query) = getUserHasClaim query 126 | resolver (GetAllUsersWithClaim query) = getAllUsersWithClaim query 127 | 128 | executeQuery :: Query a -> Context -> IO (Maybe a) 129 | executeQuery q c = runMaybeT (runReaderT (resolver q) c) 130 | 131 | --test 132 | tenantMap :: Map.Map TenantId Tenant 133 | tenantMap = Map.fromList [(1, Tenant 1 "TS")] 134 | 135 | userMap :: Map.Map UserId User 136 | userMap = Map.fromList [(1, User 1 "radu" 1), (2, User 2 "matei" 1)] 137 | 138 | claimMap :: Map.Map Int Claim 139 | claimMap = Map.fromList [(1, Claim 1 "read"), (2, Claim 2 "write")] 140 | 141 | userClaimMap :: Map.Map UserId [UserClaim] 142 | userClaimMap = Map.fromList [(1, [UserClaim 1 1]), (2, [UserClaim 2 1])] 143 | 144 | fromMap :: (Ord i, Typeable a) => Map.Map i a -> DB i a 145 | fromMap map = 146 | DB 147 | { getById = 148 | \id -> do 149 | let v = Map.lookup id map 150 | liftIO $ putStrLn $ "****DEBUG: getById " ++ " " ++ show (typeOf v) 151 | MaybeT $ return v, 152 | getAll = do 153 | let xs = snd <$> Map.toList map 154 | liftIO $ putStrLn $ "****DEBUG: getAll " ++ " " ++ show (typeOf xs) 155 | return xs 156 | } 157 | 158 | ctx :: Context 159 | ctx = Context $ DataSources (fromMap tenantMap) (fromMap userMap) (fromMap claimMap) (fromMap userClaimMap) 160 | 161 | tenant1 :: IO (Maybe Tenant) 162 | tenant1 = executeQuery (GetTenantByUserId 1) ctx 163 | 164 | user1HasReadAccess :: IO (Maybe Bool) 165 | user1HasReadAccess = executeQuery (GetUserHasClaim (1, "read")) ctx 166 | 167 | allUsersWithReadAccess :: IO (Maybe [User]) 168 | allUsersWithReadAccess = executeQuery (GetAllUsersWithClaim "read") ctx 169 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # functional-guy 2 | ##### Functional Programming Guild for Great Good! 3 | 4 | 5 | *Can programming be liberated from the von Neumann style?* 6 | 7 | ## General 8 | The goal of this guild members is to learn the fp paradigm and not a speciffic programming language. 9 | Members of this guild will use the principles of fp paradigm in various programming languages like: 10 | - Haskell 11 | - Lisp 12 | - F# 13 | - C# 14 | - Scala 15 | - Clojure 16 | - JavaScript 17 | - Elm 18 | - Go 19 | - Rust 20 | 21 | Because we all need a common language to communicate and share ideas we will learn and embrace the following languages: 22 | - Lambda Calculus 23 | - Haskell 24 | - Category Theory 25 | 26 | During our meetings and presentations we will try to connect our ideas with implementations (where possible) with other programming languages. 27 | 28 | ## Chapters 29 | - [`Chapter1. Inception`](./Chapter1.%20Inception#readme) 30 | - [`Chapter2. The foundation`](./Chapter2.%20The%20foundation#readme) 31 | - [`Chapter3. Haskell's Type System`](./Chapter3.%20Haskell's%20Type%20System#readme) 32 | - [`Chapter4. IO in Haskell`](./Chapter4.%20IO%20in%20Haskell#readme) 33 | - [`Chapter5. Functors Applicatives & Monads`](./Chapter5.%20Functors%20Applicatives%20%26%20Monads#readme) 34 | - [`Chapter6. Computational effects`](./Chapter6.%20Computational%20effects#readme) 35 | - [`Chapter7. FSharp microservices`](./Chapter7.%20FSharp%20microservices#readme) 36 | - [`Chapter8. JavaScript libraries`](./Chapter8.%20JavaScript%20libraries#readme) 37 | 38 | ## Computability theory 39 | - [David Hilbert](https://en.wikipedia.org/wiki/David_Hilbert) 40 | - [Entscheidungsproblem](https://en.wikipedia.org/wiki/Entscheidungsproblem) 41 | - [Kurt Gödel](https://en.wikipedia.org/wiki/Kurt_G%C3%B6del) 42 | - [Gödel's incompleteness theorems](https://en.wikipedia.org/wiki/G%C3%B6del%27s_incompleteness_theorems#:~:text=G%C3%B6del's%20incompleteness%20theorems%20are%20two,in%20the%20philosophy%20of%20mathematics.) 43 | - [Gödel's General recursive function](https://en.wikipedia.org/wiki/General_recursive_function) 44 | - [Alonzo Church](https://en.wikipedia.org/wiki/Alonzo_Church) 45 | - [Lambda calculus](https://en.wikipedia.org/wiki/Lambda_calculus) 46 | - [Alan Turing](https://en.wikipedia.org/wiki/Alan_Turing) 47 | - [The Turing Machine](https://en.wikipedia.org/wiki/Turing_machine) 48 | - [Church–Turing thesis](https://en.wikipedia.org/wiki/Church%E2%80%93Turing_thesis#:~:text=It%20states%20that%20a%20function,the%20British%20mathematician%20Alan%20Turing.) 49 | 50 | ## Lambda Calcullus 51 | - [Lambda calculus](https://en.wikipedia.org/wiki/Lambda_calculus) 52 | - [Fixed-point combinators in JavaScript: Memoizing recursive functions](http://matt.might.net/articles/implementation-of-recursive-fixed-point-y-combinator-in-javascript-for-memoization/) 53 | - [SKI combinator calculus](https://en.wikipedia.org/wiki/SKI_combinator_calculus#Self-application_and_recursion) 54 | 55 | ## FP articles 56 | - [The Rise and Fall and Rise of Functional Programming](https://medium.com/javascript-scene/the-rise-and-fall-and-rise-of-functional-programming-composable-software-c2d91b424c8c) 57 | - [THINGS I WISH SOMEONE HAD EXPLAINED ABOUT FUNCTIONAL PROGRAMMING](https://jrsinclair.com/articles/2019/what-i-wish-someone-had-explained-about-functional-programming/) 58 | - [Applicative vs Normal evaluation form](https://courses.cs.washington.edu/courses/cse505/99au/functional/applicative-normal.pdf) 59 | - [Normal, Applicative and Lazy Evaluation](https://sookocheff.com/post/fp/evaluating-lambda-expressions/) 60 | - [Bartosz Milewski - Category Theory 5.2: Algebraic Data Types](https://www.youtube.com/watch?v=w1WMykh7AxA&t=1214s) 61 | - [Bartosz Milewski - Simple Algebraic Data Types](https://bartoszmilewski.com/2015/01/13/simple-algebraic-data-types/) 62 | - [Monads and Effects by Bartosz Milewski](https://bartoszmilewski.com/2016/11/30/monads-and-effects/) 63 | - [Eugenio Moggi, Notions of Computation and Monads. This is a hard core research paper that started the whole monad movement in functional languages.](https://person.dibris.unige.it/moggi-eugenio/ftp/ic91.pdf) 64 | 65 | 66 | ## FP Video 67 | - ["Propositions as Types" by Philip Wadler](https://www.youtube.com/watch?v=IOiZatlZtGU) 68 | - [Why Functional Programming Matters by John Hughes at Functional Conf 2016](https://www.youtube.com/watch?v=XrNdvWqxBvA) 69 | - [Simon Peyton-Jones: Escape from the ivory tower: the Haskell journey](https://www.youtube.com/watch?v=re96UgMk6GQ) 70 | - [Lambda World 2019 - A Series of Unfortunate Effects - Robert M. Avram](https://www.youtube.com/watch?v=y5jZnMImbMY) 71 | - [Lambda World 2019 - A categorical view of computational effects - Emily Riehl](https://www.youtube.com/watch?v=Ssx2_JKpB3U) 72 | - ["Everything Old is New Again: Quoted Domain Specific Languages" by Philip Wadler](https://www.youtube.com/watch?v=DlBwJ4rvz5c) 73 | - [Hitler reacts to Functional Programming](https://www.youtube.com/watch?v=ADqLBc1vFwI) 74 | 75 | 76 | ## Haskell books 77 | - Christopher Allen, Julie Moronuki - Haskell programming from first principles - 2016 78 | - Get Programming with Haskell by Will Kurt 79 | - [Learn You a Haskell for Great Good!](http://learnyouahaskell.com/chapters) 80 | - [Real World Haskell by Bryan O'Sullivan, Don Stewart, and John Goerzen](http://book.realworldhaskell.org/read/) 81 | 82 | 83 | ## Haskell articles 84 | - [Vasile Cuzmin - Getting started with Haskell](https://github.com/VCuzmin/Haskell) 85 | - [Lexi Lambda - An opinionated guide to Haskell in 2018](https://lexi-lambda.github.io/blog/2018/02/10/an-opinionated-guide-to-haskell-in-2018/) 86 | - [Stack vs. Platform vs. Cabal](https://stackoverflow.com/questions/48733970/how-to-install-haskell-platform-or-stack-in-2018-on-linux) 87 | - [Haskell vs. Ada vs. C++ vs. Awk vs. ...An Experiment in Software Prototyping Productivity](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.368.1058&rep=rep1&type=pdf) 88 | 89 | ## Haskell tools 90 | - [The Haskell Tool Stack](https://docs.haskellstack.org/en/stable/README/) 91 | - [The Haskell Cabal](https://www.haskell.org/cabal/) 92 | - [Haskell Platform](https://www.haskell.org/platform/) 93 | - [Hoogle](https://hoogle.haskell.org/) - Haskell search engine; you can search a function by its type/definition. Just fill the definition in the search box! 94 | - [haskell repl](https://repl.it/languages/haskell) 95 | 96 | 97 | ## Functional JavaScript 98 | - [Professor frisby's mostly adequate guide](https://mostly-adequate.gitbooks.io/mostly-adequate-guide) 99 | - [Fantasy Land](https://github.com/fantasyland/fantasy-land/blob/master/README.md) 100 | - [Fantas, Eel, and Specification](http://www.tomharding.me/fantasy-land/) 101 | - [Eric Elliott - Composing Software: The Book](https://medium.com/javascript-scene/composing-software-the-book-f31c77fc3ddc) 102 | - [James Sinclair Blog](https://jrsinclair.com) 103 | 104 | ## F# 105 | - [Ploeh - the IO container](https://blog.ploeh.dk/2020/06/08/the-io-container/) 106 | - [Writing custom F# LINQ query builder](http://tomasp.net/blog/2015/query-translation/) 107 | 108 | 109 | ## Other 110 | - [Structure and interpretation of computer programs MIT](https://sarabander.github.io/sicp/html/index.xhtml#SEC_Contents) 111 | - [Implementing GADT's in OOP](https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/gadtoop.pdf) 112 | 113 | 114 | 115 | 116 | 117 | -------------------------------------------------------------------------------- /Chapter6. Computational effects/Examples/Reader/12.GqlQueries4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | 4 | import Control.Monad 5 | import Control.Monad.Reader 6 | import Control.Monad.Trans 7 | import Control.Monad.Trans.Maybe 8 | import Control.Monad.Identity 9 | import qualified Data.Map as Map 10 | import Data.Maybe 11 | import Data.Typeable 12 | 13 | 14 | --schema 15 | type TenantId = Int 16 | 17 | type UserId = Int 18 | 19 | type ClaimId = Int 20 | 21 | type ClaimName = String 22 | 23 | data Tenant = Tenant {tenantId :: TenantId, tenantName :: String} deriving (Show) 24 | 25 | data User = User {userId :: UserId, userName :: String, _tenantId :: TenantId} deriving (Show) 26 | 27 | data Claim = Claim {claimId :: ClaimId, claimName :: String} 28 | 29 | data UserClaim = UserClaim {_userId :: UserId, _claimId :: ClaimId} 30 | 31 | data Query a where 32 | GetTenantById :: TenantId -> Query Tenant 33 | GetUserById :: UserId -> Query User 34 | GetAllUsers :: Query [User] 35 | GetClaimById :: ClaimId -> Query Claim 36 | GetAllUsersByTenantId :: TenantId -> Query [User] 37 | GetTenantByUserId :: UserId -> Query Tenant 38 | GetUserHasClaim :: (UserId, ClaimName) -> Query Bool 39 | GetAllUsersWithClaim :: ClaimName -> Query [User] 40 | 41 | newtype Context m = Context 42 | { dataSources :: DataSources m 43 | } 44 | 45 | data DataSources m = DataSources 46 | { tenants :: DB TenantId m Tenant, 47 | users :: DB UserId m User, 48 | claims :: DB ClaimId m Claim, 49 | userClaims :: DB UserId m [UserClaim] 50 | } 51 | 52 | data DB i m a = DB 53 | { getById :: i -> m a, 54 | getAll :: m [a] 55 | } 56 | 57 | --resolvers 58 | 59 | type Resolver q c m a = (Monad m) => q -> ReaderT (c m) m a 60 | 61 | getTenantById :: Resolver TenantId Context m Tenant 62 | getTenantById tenantId = do 63 | tenantDb <- asks (tenants . dataSources) 64 | let tenant = tenantDb `getById` tenantId 65 | lift tenant 66 | 67 | getUserById :: Resolver UserId Context m User 68 | getUserById userId = do 69 | userDB <- asks (users . dataSources) 70 | let user = userDB `getById` userId 71 | lift user 72 | 73 | getAllUsers :: Resolver () Context m [User] 74 | getAllUsers () = do 75 | userDB <- asks (users . dataSources) 76 | let userList = getAll userDB 77 | lift userList 78 | 79 | getClaimById :: Resolver ClaimId Context m Claim 80 | getClaimById claimId = do 81 | claimDb <- asks (claims . dataSources) 82 | let claim = claimDb `getById` claimId 83 | lift claim 84 | 85 | getUserClaims :: Resolver UserId Context m [UserClaim] 86 | getUserClaims userId = do 87 | userClaimDb <- asks (userClaims . dataSources) 88 | let claims = userClaimDb `getById` userId 89 | lift claims 90 | 91 | --todo:: Implement the following resolvers by composing existing ones 92 | --hint: In order to keep things DRY, do not use the context at all, 93 | -- you should only use the resolvers from above: 94 | -- getTenantById, getUserById, getAllUsers, getClaimById, getUserClaims 95 | 96 | getAllUsersByTenantId :: Resolver TenantId Context m [User] 97 | getAllUsersByTenantId tId = filter (\x -> _tenantId x == tId) <$> getAllUsers () 98 | 99 | getTenantByUserId :: Resolver UserId Context m Tenant 100 | getTenantByUserId = getUserById >=> getTenantById . _tenantId 101 | 102 | -- getTenantByUserId userId = do 103 | -- user <- getUserById userId 104 | -- let tid = _tenantId user 105 | -- getTenantById tid 106 | 107 | getUserHasClaim :: Resolver (UserId, ClaimName) Context m Bool 108 | getUserHasClaim (userId, claim) = do 109 | userClaims <- getUserClaims userId 110 | claims <- mapM getClaimById (_claimId <$> userClaims) 111 | if any (\x -> claimName x == claim) claims 112 | then return True 113 | else return False 114 | 115 | getAllUsersWithClaim :: Resolver ClaimName Context m [User] 116 | getAllUsersWithClaim claim = do 117 | users <- getAllUsers () 118 | filterM (\x -> getUserHasClaim (userId x, claim)) users 119 | 120 | 121 | resolver :: Resolver (Query a) Context m a 122 | resolver (GetTenantById query) = getTenantById query 123 | resolver (GetUserById query) = getUserById query 124 | resolver GetAllUsers = getAllUsers () 125 | resolver (GetClaimById query) = getClaimById query 126 | resolver (GetAllUsersByTenantId query) = getAllUsersByTenantId query 127 | resolver (GetTenantByUserId query) = getTenantByUserId query 128 | resolver (GetUserHasClaim query) = getUserHasClaim query 129 | resolver (GetAllUsersWithClaim query) = getAllUsersWithClaim query 130 | 131 | --test 132 | tenantMap :: Map.Map TenantId Tenant 133 | tenantMap = Map.fromList [(1, Tenant 1 "TS")] 134 | 135 | userMap :: Map.Map UserId User 136 | userMap = Map.fromList [(1, User 1 "radu" 1), (2, User 2 "matei" 1)] 137 | 138 | claimMap :: Map.Map Int Claim 139 | claimMap = Map.fromList [(1, Claim 1 "read"), (2, Claim 2 "write")] 140 | 141 | userClaimMap :: Map.Map UserId [UserClaim] 142 | userClaimMap = Map.fromList [(1, [UserClaim 1 1]), (2, [UserClaim 2 1])] 143 | 144 | fromMap :: (Ord i, Show i, Typeable a) => Map.Map i a -> DB i (MaybeT IO) a 145 | fromMap map = 146 | DB 147 | { getById = 148 | \id -> do 149 | let v = Map.lookup id map 150 | liftIO $ putStrLn $ "****DEBUG: getById " ++ show id ++ " ::" ++ show (typeOf v) 151 | MaybeT $ return v, 152 | getAll = do 153 | let xs = snd <$> Map.toList map 154 | liftIO $ putStrLn $ "****DEBUG: getAll " ++ " " ++ show (typeOf xs) 155 | return xs 156 | } 157 | 158 | fromMap' :: (Ord i) => Map.Map i a -> DB i Maybe a 159 | fromMap' map = 160 | DB 161 | { getById = (`Map.lookup` map), 162 | getAll = do 163 | let xs = snd <$> Map.toList map 164 | return xs 165 | } 166 | 167 | fromMap'' :: (Ord i) => Map.Map i a -> DB i Identity a 168 | fromMap'' map = 169 | DB 170 | { getById = return . fromJust . (`Map.lookup` map), 171 | getAll = do 172 | let xs = snd <$> Map.toList map 173 | return xs 174 | } 175 | 176 | ctx :: Context (MaybeT IO) 177 | ctx = Context $ DataSources (fromMap tenantMap) (fromMap userMap) (fromMap claimMap) (fromMap userClaimMap) 178 | 179 | ctx' :: Context Maybe 180 | ctx' = Context $ DataSources (fromMap' tenantMap) (fromMap' userMap) (fromMap' claimMap) (fromMap' userClaimMap) 181 | 182 | ctx'' :: Context Identity 183 | ctx'' = Context $ DataSources (fromMap'' tenantMap) (fromMap'' userMap) (fromMap'' claimMap) (fromMap'' userClaimMap) 184 | 185 | 186 | executeQuery :: Query a -> Context (MaybeT IO) -> IO (Maybe a) 187 | executeQuery q = runMaybeT . runReaderT (resolver q) 188 | 189 | executeQuery' :: Query a -> Context Maybe -> Maybe a 190 | executeQuery' = runReaderT . resolver 191 | 192 | executeQuery'' :: Query a -> Context Identity -> a 193 | executeQuery'' q = runIdentity . runReaderT (resolver q) 194 | 195 | tenant1 :: IO (Maybe Tenant) 196 | tenant1 = executeQuery (GetTenantByUserId 1) ctx 197 | 198 | tenant1' :: Maybe Tenant 199 | tenant1' = executeQuery' (GetTenantByUserId 1) ctx' 200 | 201 | tenant1'' :: Tenant 202 | tenant1'' = executeQuery'' (GetTenantByUserId 1) ctx'' 203 | 204 | user1HasReadAccess :: IO (Maybe Bool) 205 | user1HasReadAccess = executeQuery (GetUserHasClaim (1, "read")) ctx 206 | 207 | user1HasReadAccess' :: Maybe Bool 208 | user1HasReadAccess' = executeQuery' (GetUserHasClaim (1, "read")) ctx' 209 | 210 | user1HasReadAccess'' :: Bool 211 | user1HasReadAccess'' = executeQuery'' (GetUserHasClaim (1, "read")) ctx'' 212 | 213 | allUsersWithReadAccess :: IO (Maybe [User]) 214 | allUsersWithReadAccess = executeQuery (GetAllUsersWithClaim "read") ctx 215 | 216 | allUsersWithReadAccess' :: Maybe [User] 217 | allUsersWithReadAccess' = executeQuery' (GetAllUsersWithClaim "read") ctx' 218 | 219 | allUsersWithReadAccess'' :: [User] 220 | allUsersWithReadAccess'' = executeQuery'' (GetAllUsersWithClaim "read") ctx'' 221 | --------------------------------------------------------------------------------