├── gradle └── wrapper │ ├── gradle-wrapper.jar │ └── gradle-wrapper.properties ├── .gitignore ├── src └── main │ └── frege │ └── learnyou │ ├── chapter07 │ ├── LoadingModules.fr │ ├── geometry │ │ ├── Cube.fr │ │ ├── Sphere.fr │ │ └── Cuboid.fr │ ├── MakingOurOwnModules.fr │ ├── DataChar.fr │ ├── DataSet.fr │ ├── DataMap.fr │ └── DataList.fr │ ├── chapter06 │ ├── FunctionApplicationWithDollar.fr │ ├── CurriedFunctions.fr │ ├── Lambdas.fr │ ├── FunctionComposition.fr │ ├── SomeHigherOrderismIsInOrder.fr │ ├── OnlyFoldsAndHorses.fr │ └── MapsAndFilters.fr │ ├── chapter12 │ ├── TheMonadTypeClass.fr │ ├── GettingOurFeetWetWithMaybe.fr │ ├── MonadLaws.fr │ ├── DoNotation.fr │ ├── TheListMonad.fr │ └── WalkTheLine.fr │ ├── chapter13 │ ├── ErrorErrorOnTheWall.fr │ ├── ReaderUghNotThisJokeAgain.fr │ ├── MakingMonads.fr │ ├── TastefulStatefulComputations.fr │ ├── SomeUsefulMonadicFunctions.fr │ └── WriterIHardlyKnowHer.fr │ ├── chapter05 │ ├── MaximumAwesome.fr │ ├── QuickSort.fr │ └── AFewMoreRecursiveFunctions.fr │ ├── chapter02 │ ├── TexasRanges.fr │ ├── BabysFirstFunctions.fr │ ├── Tuples.fr │ ├── ReadySetGo.fr │ ├── ImAListComprehension.fr │ └── AnIntroToLists.fr │ ├── chapter14 │ ├── FocusingOnLists.fr │ ├── WatchYourStep.fr │ ├── TakingAWalk.fr │ ├── ATrailOfBreadcrumbs.fr │ └── AVerySimpleFileSystem.fr │ ├── chapter04 │ ├── CaseExpressions.fr │ ├── LetItBe.fr │ ├── GuardsGuards.fr │ ├── Where.fr │ └── PatternMatching.fr │ ├── chapter08 │ ├── KindsAndSomeTypeFoo.fr │ ├── RecordSyntax.fr │ ├── Typeclasses102.fr │ ├── TheFunctorTypeclass.fr │ ├── AlgebraicDataTypesIntro.fr │ ├── AYesNoTypeclass.fr │ ├── DerivedInstances.fr │ ├── TypeSynonyms.fr │ ├── TypeParameters.fr │ └── RecursiveDataStructures.fr │ ├── chapter03 │ ├── BelieveTheType.fr │ └── Typeclasses101.fr │ ├── chapter11 │ ├── TheNewtypeKeyword.fr │ ├── FunctorsRedux.fr │ ├── ApplicativeFunctors.fr │ └── Monoids.fr │ ├── chapter10 │ ├── ReversePolishNotationCalculator.fr │ └── HeathrowToLondon.fr │ └── chapter09 │ ├── CommandLineArguments.fr │ ├── Exceptions.fr │ ├── HelloWorld.fr │ ├── Randomness.fr │ └── FilesAndStreams.fr ├── .travis.yml ├── gradlew.bat ├── gradlew └── README.md /gradle/wrapper/gradle-wrapper.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/y-taka-23/learn-you-a-frege/HEAD/gradle/wrapper/gradle-wrapper.jar -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .gradle 2 | build/ 3 | 4 | # Ignore Gradle GUI config 5 | gradle-app.setting 6 | 7 | # Avoid ignoring Gradle wrapper jar file (.jar files are usually ignored) 8 | !gradle-wrapper.jar 9 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/LoadingModules.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.LoadingModules where 2 | 3 | import Data.List as M ( nub ) 4 | 5 | numUniques :: (Eq a) => [a] -> Int 6 | numUniques = length . M.nub 7 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: java 2 | env: 3 | global: 4 | - GRADLE_OPTS="-Xmx1024m -Xms256m -XX:MaxPermSize=256m -XX:PermSize=256m" 5 | before_script: 6 | - sudo service mysql stop 7 | script: ./gradlew compileFrege 8 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter06/FunctionApplicationWithDollar.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter06.FunctionApplicationWithDollar where 2 | 3 | import frege.prelude.Math 4 | 5 | main _ = do 6 | println $ map ($ 3) [ (4 +), (10 *), (^ 2), sqrt ] 7 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter12/TheMonadTypeClass.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter12.TheMonadTypeClass where 2 | 3 | main _ = do 4 | 5 | println $ (return "What" :: Maybe String) 6 | println $ Just 9 >>= \x -> return (x * 10) 7 | println $ Nothing >>= \x -> return (x * 10) 8 | -------------------------------------------------------------------------------- /gradle/wrapper/gradle-wrapper.properties: -------------------------------------------------------------------------------- 1 | #Thu Dec 31 05:33:12 JST 2015 2 | distributionBase=GRADLE_USER_HOME 3 | distributionPath=wrapper/dists 4 | zipStoreBase=GRADLE_USER_HOME 5 | zipStorePath=wrapper/dists 6 | distributionUrl=https\://services.gradle.org/distributions/gradle-2.1-bin.zip 7 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/geometry/Cube.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.geometry.Cube where 2 | 3 | import learnyou.chapter07.geometry.Cuboid () 4 | 5 | volume :: Float -> Float 6 | volume side = Cuboid.volume side side side 7 | 8 | area :: Float -> Float 9 | area side = Cuboid.area side side side 10 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/geometry/Sphere.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.geometry.Sphere where 2 | 3 | import frege.prelude.Math () 4 | 5 | volume :: Float -> Float 6 | volume radius = (4.0 / 3.0) * Math.pi * (radius ^ 3) 7 | 8 | area :: Float -> Float 9 | area radius = 4 * Math.pi * (radius ^ 2) 10 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter13/ErrorErrorOnTheWall.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter13.ErrorErrorOnTheWall where 2 | 3 | main _ = do 4 | println $ Left "boom" >>= \x -> return (x + 1) 5 | println $ (Right 100 >>= \x -> Left "no way!" :: Either String Int) 6 | println $ (Right 3 >>= \x -> return (x + 100) :: Either String Int) 7 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/geometry/Cuboid.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.geometry.Cuboid where 2 | 3 | volume :: Float -> Float -> Float -> Float 4 | volume a b c = rectangleArea a b * c 5 | 6 | area :: Float -> Float -> Float -> Float 7 | area a b c = 8 | rectangleArea a b * 2 + rectangleArea a c * 2 + rectangleArea c b * 2 9 | 10 | private rectangleArea :: Float -> Float -> Float 11 | private rectangleArea a b = a * b 12 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter13/ReaderUghNotThisJokeAgain.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter13.ReaderUghNotThisJokeAgain where 2 | 3 | addStuff :: Int -> Int 4 | addStuff = do 5 | a <- (* 2) 6 | b <- (+ 10) 7 | return (a + b) 8 | 9 | addStuff' :: Int -> Int 10 | addStuff' x = 11 | let a = (* 2) x 12 | b = (+ 10) x 13 | in a + b 14 | 15 | main _ = do 16 | println $ addStuff 3 17 | println $ addStuff' 3 18 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter05/MaximumAwesome.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter05.MaximumAwesome where 2 | 3 | maximum1 :: (Ord a) => [a] -> a 4 | maximum1 [] = error "maximum of empty list" 5 | maximum1 [x] = x 6 | maximum1 (x : xs) 7 | | x > maxTail = x 8 | | otherwise = maxTail 9 | where maxTail = maximum1 xs 10 | 11 | maximum2 :: (Ord a) => [a] -> a 12 | maximum2 [] = error "maximum of empty list" 13 | maximum2 [x] = x 14 | maximum2 (x : xs) = max x (maximum2 xs) 15 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter05/QuickSort.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter05.QuickSort where 2 | 3 | quicksort :: (Ord a) => [a] -> [a] 4 | quicksort [] = [] 5 | quicksort (x : xs) = 6 | let smallerSorted = quicksort [a | a <- xs, a <= x] 7 | biggerSorted = quicksort [a | a <- xs, a > x] 8 | in smallerSorted ++ [x] ++ biggerSorted 9 | 10 | main _ = do 11 | println $ quicksort [ 10, 2, 5, 3, 1, 6, 7, 4, 2, 3, 4, 8, 9 ] 12 | println $ packed . quicksort . unpacked $ 13 | "the quick brown fox jumps over the lazy dog" 14 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/MakingOurOwnModules.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.MakingOurOwnModules where 2 | 3 | import learnyou.chapter07.geometry.Sphere () 4 | import learnyou.chapter07.geometry.Cuboid () 5 | import learnyou.chapter07.geometry.Cube () 6 | 7 | main _ = do 8 | 9 | println $ Sphere.volume 2 10 | println $ Sphere.area 2 11 | 12 | println $ Cuboid.volume 1 2 3 13 | println $ Cuboid.area 1 2 3 14 | --println $ Cuboid.rectangleArea 1 2 --> error, due to its private scope. 15 | 16 | println $ Cube.volume 2 17 | println $ Cube.area 2 18 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter02/TexasRanges.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter02.TexasRanges where 2 | 3 | main _ = do 4 | 5 | println $ [ 1 .. 20 ] 6 | println $ [ 'a' .. 'z' ] 7 | println $ packed [ 'a' .. 'z' ] 8 | println $ [ 'K' .. 'Z' ] 9 | 10 | println $ [ 2, 4 .. 20 ] 11 | println $ [ 3, 6 .. 20 ] 12 | println $ [ 20, 19 .. 1 ] 13 | 14 | println $ take 6 (iterate (+ 0.2) 0.1) 15 | 16 | println $ take 10 (cycle [ 1, 2, 3 ]) 17 | println $ packed (take 12 (cycle "LOL ".toList)) 18 | println $ take 10 (repeat 5) 19 | println $ replicate 3 10 20 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter14/FocusingOnLists.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter14.FocusingOnLists where 2 | 3 | type ListZipper a = ([a], [a]) 4 | 5 | goForward :: ListZipper a -> ListZipper a 6 | goForward ([], bs) = ([], bs) 7 | goForward (x : xs, bs) = (xs, x : bs) 8 | 9 | goBack :: ListZipper a -> ListZipper a 10 | goBack (xs, []) = (xs, []) 11 | goBack (xs, b : bs) = (b : xs, bs) 12 | 13 | main _ = do 14 | let xs = [ 1, 2, 3, 4 ] 15 | println $ goForward (xs, []) 16 | println $ goForward ([ 2, 3, 4 ], [ 1 ]) 17 | println $ goForward ([ 3, 4 ], [ 2, 1 ]) 18 | println $ goBack ([ 4 ], [ 3, 2, 1 ]) 19 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter04/CaseExpressions.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter04.CaseExpressions where 2 | 3 | head' :: [a] -> a 4 | head' xs = case xs of 5 | [] -> error "No head for empty lists!" 6 | (x : _) -> x 7 | 8 | describeList :: [a] -> String 9 | describeList xs = "The list is " ++ 10 | case xs of 11 | [] -> "empty." 12 | [x] -> "a singleton list." 13 | xs -> "a longer list." 14 | 15 | describeList' :: [a] -> String 16 | describeList' xs = "The list is " ++ what xs 17 | where what [] = "empty." 18 | what [x] = "a singleton list." 19 | what xs = "a longer list." 20 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/KindsAndSomeTypeFoo.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.KindsAndSomeTypeFoo where 2 | 3 | class Tofu t where 4 | tofu :: j a -> t a j 5 | 6 | data Frank a b = Frank { frankField :: b a } 7 | derive (Show (b a)) => Show (Frank a b) 8 | 9 | instance Tofu Frank where 10 | tofu x = Frank x 11 | 12 | data Barry t k p = Barry { yabba :: p, dabba :: t k } 13 | 14 | instance Functor (Barry a b) where 15 | fmap f (Barry { yabba = x, dabba = y }) = Barry { yabba = f x, dabba = y } 16 | 17 | main _ = do 18 | println $ (tofu (Just 'a') :: Frank Char Maybe) 19 | println $ (tofu (["HELLO"]) :: Frank String []) 20 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter06/CurriedFunctions.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter06.CurriedFunctions where 2 | 3 | multThree :: (Num a) => a -> a -> a -> a 4 | multThree x y z = x * y * z 5 | 6 | multTwoWithNine = multThree 9 7 | multWithEighteen = multTwoWithNine 2 8 | 9 | compareWithHundred :: (Num a) => a -> Ordering 10 | compareWithHundred = compare 100 11 | 12 | divideByTen :: (Real a) => a -> a 13 | divideByTen = (/ 10) 14 | 15 | isUpperAlphanum :: Char -> Bool 16 | isUpperAlphanum = (`elem` ['A'..'Z']) 17 | 18 | main _ = do 19 | 20 | println $ max 4 5 21 | println $ (max 4) 5 22 | 23 | println $ multTwoWithNine 2 3 24 | println $ multWithEighteen 10 25 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter03/BelieveTheType.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter03.BelieveTheType where 2 | 3 | import Prelude.Math 4 | 5 | removeNonUppercase :: String -> String 6 | removeNonUppercase st = packed [ c | c <- st, c `elem` ['A'..'Z'] ] 7 | 8 | addThree :: Int -> Int -> Int -> Int 9 | addThree x y z = x + y + z 10 | 11 | factorial :: Integer -> Integer 12 | factorial n = product [ 1 .. n ] 13 | 14 | circumference :: Float -> Float 15 | circumference r = 2 * pi * r 16 | 17 | circumference' :: Double -> Double 18 | circumference' r = 2 * pi * r 19 | 20 | main _ = do 21 | println $ factorial 50 22 | println $ circumference 4.0 23 | println $ circumference' 4.0 24 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter06/Lambdas.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter06.Lambdas where 2 | 3 | chain :: (Integral a) => a -> [a] 4 | chain 1 = [1] 5 | chain n 6 | | even n = n : chain (n `div` 2) 7 | | otherwise = n : chain (n * 3 + 1) 8 | 9 | numLongChains :: Int 10 | numLongChains = length (filter (\xs -> length xs > 15) (map chain [1..100])) 11 | 12 | addThree :: (Num a) => a -> a -> a -> a 13 | addThree = \x -> \y -> \z -> x + y + z 14 | 15 | flip' :: (a -> b -> c) -> b -> a -> c 16 | flip' f = \x \y -> f y x 17 | 18 | main _ = do 19 | println $ zipWith (\a \b -> (a * 30 + 3) / b) 20 | [ 5, 4, 3, 2, 1 ] [ 1, 2, 3, 4, 5 ] 21 | println $ map (\(a, b) -> a + b) [ (1, 2), (3, 5), (6, 3), (2, 6), (2, 5) ] 22 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter04/LetItBe.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter04.LetItBe where 2 | 3 | import frege.prelude.Math 4 | 5 | cylinder :: (Floating a) => a -> a -> a 6 | cylinder r h = 7 | let sideArea = 2 * pi * r * h 8 | topArea = pi * r ^ 2 9 | in sideArea + 2 * topArea 10 | 11 | calcBmis :: (Real a) => [(a, a)] -> [a] 12 | calcBmis xs = [ bmi | (w, h) <- xs, bmi = w / h ^ 2, bmi >= 25.0 ] 13 | 14 | main _ = do 15 | println $ 4 * (let a = 9 in a + 1) + 2 16 | println $ [let square x = x * x in (square 5, square 3, square 2)] 17 | println $ 18 | ( let a = 100; b = 200; c = 300 in a * b * c 19 | , let foo = "Hey "; bar = "there!" in foo ++ bar 20 | ) 21 | println $ (let (a, b, c) = (1, 2, 3) in a + b + c) * 100 22 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter12/GettingOurFeetWetWithMaybe.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter12.GettingOurFeetWetWithMaybe where 2 | 3 | applyMaybe :: Maybe a -> (a -> Maybe b) -> Maybe b 4 | applyMaybe Nothing _ = Nothing 5 | applyMaybe (Just x) f = f x 6 | 7 | main _ = do 8 | 9 | println $ (\x -> Just (x + 1)) 1 10 | println $ (\x -> Just (x + 1)) 100 11 | 12 | println $ Just 3 `applyMaybe` \x -> Just (x + 1) 13 | println $ Just "smile" `applyMaybe` \x -> Just (x ++ " :)") 14 | println $ Nothing `applyMaybe` \x -> Just (x + 1) 15 | println $ Nothing `applyMaybe` \x -> Just (x ++ " :)") 16 | 17 | println $ Just 3 `applyMaybe` \x -> if x > 2 then Just x else Nothing 18 | println $ Just 1 `applyMaybe` \x -> if x > 2 then Just x else Nothing 19 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter02/BabysFirstFunctions.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter02.BabysFirstFunctions where 2 | 3 | doubleMe x = x + x 4 | 5 | --doubleUs x y = x * 2 + y * 2 6 | doubleUs x y = doubleMe x + doubleMe y 7 | 8 | doubleSmallNumber :: Num a => a -> a 9 | doubleSmallNumber x = 10 | if x > 100 11 | then x 12 | else x * 2 13 | 14 | doubleSmallNumber' :: Num a => a -> a 15 | doubleSmallNumber' x = (if x > 100 then x else x * 2) + 1 16 | 17 | --conanO'Brien = "It's a-me, Conan O'Brien!" --> error 18 | conanOBrien = "It's a-me, Conan O'Brien!" 19 | 20 | main _ = do 21 | 22 | println $ doubleMe 9 23 | println $ doubleMe 8.3 24 | 25 | println $ doubleUs 4 9 26 | println $ doubleUs 2.3 34.2 27 | println $ doubleUs 28 88 + doubleMe 123 28 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter04/GuardsGuards.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter04.GuardsGuards where 2 | 3 | bmiTell :: (Real a) => a -> a -> String 4 | bmiTell weight height 5 | | weight / height ^ 2 <= 18.5 = "You're underweight, you emo, you!" 6 | | weight / height ^ 2 <= 25.0 = "You're supposedly normal. Pffft, I bet you're ugly!" 7 | | weight / height ^ 2 <= 30.0 = "You're fat! Lose some weight, fatty!" 8 | | otherwise = "You're a whale, congratulations!" 9 | 10 | max' :: (Ord a) => a -> a -> a 11 | max' a b 12 | | a > b = a 13 | | otherwise = b 14 | 15 | myCompare :: (Ord a) => a -> a -> Ordering 16 | a `myCompare` b 17 | | a > b = Gt 18 | | a == b = Eq 19 | | otherwise = Lt 20 | 21 | main _ = do 22 | println $ bmiTell 85 1.90 23 | println $ 3 `myCompare` 2 24 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter05/AFewMoreRecursiveFunctions.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter05.AFewMoreRecursiveFunctions where 2 | 3 | replicate' :: (Num i) => i -> a -> [a] 4 | replicate' n x 5 | | n <= 0 = [] 6 | | otherwise = x : replicate' (n - 1) x 7 | 8 | take' :: (Num i) => i -> [a] -> [a] 9 | take' n _ 10 | | n <= 0 = [] 11 | take' _ [] = [] 12 | take' n (x : xs) = x : take' (n - 1) xs 13 | 14 | reverse' :: [a] -> [a] 15 | reverse' [] = [] 16 | reverse' (x : xs) = reverse' xs ++ [x] 17 | 18 | repeat' :: a -> [a] 19 | repeat' x = x : repeat' x 20 | 21 | zip' :: [a] -> [b] -> [(a, b)] 22 | zip' _ [] = [] 23 | zip' [] _ = [] 24 | zip' (x : xs) (y : ys) = (x, y) : zip' xs ys 25 | 26 | elem' :: (Eq a) => a -> [a] -> Bool 27 | elem' a [] = false 28 | elem' a (x : xs) 29 | | a == x = true 30 | | otherwise = elem' a xs 31 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter04/Where.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter04.Where where 2 | 3 | bmiTell :: (Real a) => a -> a -> String 4 | bmiTell weight height 5 | | bmi <= skinny = "You're underweight, you emo, you!" 6 | | bmi <= normal = "You're supposedly normal. Pffft, I bet you're ugly!" 7 | | bmi <= fat = "You're fat! Lose some weight, fatty!" 8 | | otherwise = "You're a whale, congratulations!" 9 | where bmi = weight / height ^ 2 10 | (skinny, normal, fat) = (18.5, 25.0, 30.0) 11 | 12 | initials :: String -> String -> String 13 | initials firstname lastname = (ctos f) ++ ". " ++ (ctos l) ++ "." 14 | where f = head firstname.toList 15 | l = head lastname.toList 16 | 17 | calcBmis :: (Real a) => [(a, a)] -> [a] 18 | calcBmis xs = [ bmi w h | (w, h) <- xs ] 19 | where bmi weight height = weight / height ^ 2 20 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter02/Tuples.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter02.Tuples where 2 | 3 | triangles = [ (a, b, c) | c <- [1..10], b <- [1..10], a <- [1..10] ] 4 | 5 | rightTriangles = 6 | [ (a, b, c) | c <- [1..10], b <- [1..c], a <- [1..b], a^2 + b^2 == c^2 ] 7 | 8 | rightTriangles' = 9 | [ (a, b, c) | c <- [1..10], b <- [1..c], a <- [1..b], a^2 + b^2 == c^2, a + b + c == 24 ] 10 | 11 | main _ = do 12 | 13 | println $ fst (8, 11) 14 | println $ fst ("Wow", false) 15 | 16 | println $ snd (8, 11) 17 | println $ snd ("Wow", false) 18 | 19 | println $ zip [ 1, 2, 3, 4, 5 ] [ 5, 5, 5, 5, 5 ] 20 | println $ zip [ 1 .. 5 ] [ "one", "two", "three", "four", "five" ] 21 | 22 | println $ zip [ 5, 3, 2, 6, 2, 7, 2, 5, 4, 6, 6 ] [ "im", "a", "turtle" ] 23 | println $ zip [ 1 .. ] [ "apple", "orange", "cherry", "mango" ] 24 | 25 | println $ rightTriangles' 26 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter02/ReadySetGo.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter02.ReadySetGo where 2 | 3 | main _ = do 4 | 5 | println $ 2 + 15 6 | println $ 49 * 100 7 | println $ 1892 - 1472 8 | println $ 5 / 2 9 | 10 | println $ (50 * 100) - 4999 11 | println $ 50 * 100 - 4999 12 | println $ 50 * (100 - 4999) 13 | println $ 5 * -3 14 | 15 | println $ true && false 16 | println $ true && true 17 | println $ false || true 18 | println $ not false 19 | println $ not (true && true) 20 | 21 | println $ 5 == 5 22 | println $ 1 == 0 23 | println $ 5 != 5 24 | println $ 5 != 4 25 | println $ "hello" == "hello" 26 | 27 | println $ succ 8 28 | println $ min 9 10 29 | println $ min 3.4 3.2 30 | println $ max 100 101 31 | 32 | println $ succ 9 + max 5 4 + 1 33 | println $ (succ 9) + (max 5 4) + 1 34 | println $ 92 `div` 10 35 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter12/MonadLaws.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter12.MonadLaws where 2 | 3 | import learnyou.chapter12.WalkTheLine ( landLeft, landRight ) 4 | 5 | main _ = do 6 | 7 | println $ return 3 >>= (\x -> Just (x + 100000)) 8 | println $ (\x -> Just (x + 100000)) 3 9 | 10 | println $ return "WoM" >>= (\x -> [ x, x, x ]) 11 | println $ (\x -> [ x, x, x ]) "WoM" 12 | 13 | println $ Just "move on up" >>= (\x -> return x) 14 | println $ [ 1, 2, 3, 4 ] >>= (\x -> return x) 15 | putStrLn "Wah!" >>= (\x -> return x) 16 | 17 | println $ ((return (0, 0) >>= landRight 2) >>= landLeft 2) >>= landRight 2 18 | println $ 19 | return (0, 0) >>= (\x -> 20 | landRight 2 x >>= (\y -> 21 | landLeft 2 y >>= (\z -> 22 | landRight 2 z))) 23 | 24 | let f x = [ x, -x ] 25 | let g x = [ x * 3, x * 2 ] 26 | let h = f <=< g 27 | println $ h 3 28 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/RecordSyntax.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.RecordSyntax where 2 | 3 | data Person = Person 4 | { firstName :: String 5 | , lastName :: String 6 | , age :: Int 7 | , height :: Float 8 | , phoneNumber :: String 9 | , flavor :: String 10 | } 11 | derive Show Person 12 | 13 | guy :: Person 14 | guy = Person 15 | { firstName = "Buddy" 16 | , lastName = "Finklestein" 17 | , age = 43 18 | , height = 184.2 19 | , phoneNumber = "526-2928" 20 | , flavor = "Chocolate" 21 | } 22 | 23 | data Car = Car 24 | { company :: String 25 | , model :: String 26 | , year :: Int 27 | } 28 | derive Show Car 29 | 30 | main _ = do 31 | 32 | println $ guy.firstName 33 | println $ guy.height 34 | println $ guy.flavor 35 | 36 | let ponyCar = Car { company = "Ford", model = "Mustang", year = 1967 } 37 | println $ ponyCar --> not a record-style showing... 38 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter06/FunctionComposition.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter06.FunctionComposition where 2 | 3 | import frege.prelude.Math 4 | 5 | sum' :: (Num a) => [a] -> a 6 | --sum' xs = fold (+) 0 xs 7 | sum' = fold (+) 0 8 | 9 | --fn x = ceil (negate (tan (cos (max 50 x)))) 10 | fn = ceil . negate . tan . cos . max 50 11 | 12 | oddSquareSum :: Integer 13 | --oddSquareSum = sum (takeWhile (< 10000) (filter odd (map (^ 2) [1..]))) 14 | --oddSquareSum = sum . takeWhile (< 10000) . filter odd . map (^ 2) $ [1..] 15 | oddSquareSum = 16 | let oddSquares = filter odd $ map (^ 2) [1..] 17 | belowLimit = takeWhile (< 10000) oddSquares 18 | in sum belowLimit 19 | 20 | main _ = do 21 | println $ map (\x -> negate (abs x)) [ 5, -3, -6, 7, -3, 2, -19, 24 ] 22 | println $ map (negate . abs) [ 5, -3, -6, 7, -3, 2, -19, 24 ] 23 | println $ map (\xs -> negate (sum (tail xs))) [ [1..5], [3..6], [1..7] ] 24 | println $ map (negate . sum . tail) [ [1..5], [3..6], [1..7] ] 25 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/Typeclasses102.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.Typeclasses102 where 2 | 3 | data TrafficLight = Red | Yellow | Green 4 | 5 | instance Eq TrafficLight where 6 | 7 | Red == Red = true 8 | Green == Green = true 9 | Yellow == Yellow = true 10 | _ == _ = false 11 | 12 | hashCode Red = 0 13 | hashCode Green = 1 14 | hashCode Yellow = 2 15 | 16 | instance Show TrafficLight where 17 | show Red = "Red light" 18 | show Yellow = "Yellow light" 19 | show Green = "Green light" 20 | 21 | data Maybe' a = Nothing' | Just' a 22 | 23 | instance (Eq m) => Eq (Maybe' m) where 24 | 25 | Just' x == Just' y = x == y 26 | Nothing' == Nothing' = true 27 | _ == _ = false 28 | 29 | hashCode (Just' x) = hashCode x 30 | hashCode Nothing' = 0 31 | 32 | main _ = do 33 | 34 | println $ Red == Red 35 | println $ Red == Yellow 36 | println $ Red `elem` [ Red, Yellow, Green ] 37 | println $ [ Red, Yellow, Green ] 38 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter11/TheNewtypeKeyword.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter11.TheNewtypeKeyword where 2 | 3 | data CharList = CharList { getCharList :: [Char] } 4 | derive Eq CharList 5 | derive Show CharList 6 | 7 | data Pair b a = Pair { getPair :: (a, b) } 8 | 9 | data Foo = Foo { foo :: String } 10 | 11 | instance Functor (Pair c) where 12 | fmap f (Pair (x, y)) = Pair (f x, y) 13 | 14 | data CoolBool = CoolBool { getCoolBool :: Bool } 15 | 16 | helloMe :: CoolBool -> String 17 | helloMe (CoolBool _) = "hello" 18 | 19 | main _ = do 20 | 21 | println $ CharList "this will be shown!".toList 22 | println $ CharList "benny".toList == CharList "benny".toList 23 | println $ CharList "benny".toList == CharList "oisters".toList 24 | 25 | let p1 = fmap (* 100) (Pair (2, 3)) 26 | p2 = fmap (packed . reverse . unpacked) (Pair ("london calling", 3)) 27 | println $ p1.getPair 28 | println $ p2.getPair 29 | 30 | -- Frege's 'data' is not lazy unlike Haskell's 'newtype' 31 | -- println $ helloMe undefined --> runtime error 32 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter03/Typeclasses101.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter03.Typeclasses101 where 2 | 3 | main _ = do 4 | 5 | println $ 5 == 5 6 | println $ 5 != 5 7 | println $ 'a' == 'a' 8 | println $ "Ho Ho" == "Ho Ho" 9 | println $ 3.432 == 3.432 10 | 11 | println $ "Abrakadabra" < "Zebra" 12 | println $ "Abrakadabra" `compare` "Zebra" 13 | println $ 5 >= 2 14 | println $ 5 `compare` 3 15 | 16 | println $ show 3 17 | println $ show 5.334 18 | println $ show True 19 | 20 | println $ atoi "5" 21 | 22 | println $ ['a'..'e'] 23 | println $ [Lt .. Gt] 24 | println $ [3 .. 5] 25 | println $ succ 'B' 26 | 27 | println $ (minBound :: Int) 28 | println $ show (maxBound :: Char) 29 | println $ (maxBound :: Bool) 30 | println $ (minBound :: Bool) 31 | println $ (maxBound :: (Bool, Int, Char)) 32 | 33 | println $ (20 :: Int) 34 | println $ (20 :: Integer) 35 | println $ (20 :: Float) 36 | println $ (20 :: Double) 37 | 38 | println $ fromIntegral (length [ 1, 2, 3, 4 ]) + 3.2 39 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter14/WatchYourStep.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter14.WatchYourStep where 2 | 3 | import learnyou.chapter14.TakingAWalk ( Tree ) 4 | import learnyou.chapter14.ATrailOfBreadcrumbs ( Zipper, Crumb ) 5 | 6 | goLeft :: Zipper a -> Maybe (Zipper a) 7 | goLeft (Node x l r, bs) = Just (l, LeftCrumb x r : bs) 8 | goLeft (Empty, _) = Nothing 9 | 10 | goRight :: Zipper a -> Maybe (Zipper a) 11 | goRight (Node x l r, bs) = Just (r, RightCrumb x l : bs) 12 | goRight (Empty, _) = Nothing 13 | 14 | goUp :: Zipper a -> Maybe (Zipper a) 15 | goUp (t, LeftCrumb x r : bs) = Just (Node x t r, bs) 16 | goUp (t, RightCrumb x l : bs) = Just (Node x l t, bs) 17 | goUp (_, []) = Nothing 18 | 19 | main _ = do 20 | 21 | println $ (goLeft (Empty, []) :: Maybe (Zipper Char)) 22 | println $ goLeft (Node 'A' Empty Empty, []) 23 | 24 | let coolTree = Node 1 Empty (Node 3 Empty Empty) 25 | println $ return (coolTree, []) >>= goRight 26 | println $ return (coolTree, []) >>= goRight >>= goRight 27 | println $ return (coolTree, []) >>= goRight >>= goRight >>= goRight 28 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/TheFunctorTypeclass.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.TheFunctorTypeclass where 2 | 3 | import frege.data.HashMap as HM () 4 | import learnyou.chapter08.RecursiveDataStructures ( Tree, treeInsert ) 5 | 6 | instance Functor Tree where 7 | fmap f EmptyTree = EmptyTree 8 | fmap f (Node x leftsub rightsub) = 9 | Node (f x) (fmap f leftsub) (fmap f rightsub) 10 | 11 | instance Functor (Either a) where 12 | fmap f (Right x) = Right (f x) 13 | fmap f (Left x) = Left x 14 | 15 | class Functor' f where 16 | fmap' :: (a -> b) -> f a -> f b 17 | 18 | instance Functor' (HM.HashMap k) where 19 | fmap' = HM.mapValues 20 | 21 | main _ = do 22 | 23 | println $ fmap (* 2) [ 1, 2, 3 ] 24 | println $ map (* 2) [ 1, 2, 3 ] 25 | 26 | println $ fmap (++ " HEY GUYS IM INSIDE THE JUST") (Just "Something serious.") 27 | println $ fmap (++ " HEY GUYS IM INSIDE THE JUST") Nothing 28 | println $ fmap (* 2) (Just 200) 29 | println $ fmap (* 2) Nothing 30 | 31 | println $ fmap (* 2) EmptyTree 32 | println $ fmap (* 4) (foldr treeInsert EmptyTree [ 5, 7, 3, 2, 1, 7 ]) 33 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter12/DoNotation.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter12.DoNotation where 2 | 3 | import learnyou.chapter12.WalkTheLine ( landLeft, landRight, Pole ) 4 | 5 | foo' :: Maybe String 6 | foo' = 7 | Just 3 >>= (\x -> 8 | Just "!" >>= (\y -> 9 | Just (show x ++ y))) 10 | 11 | foo :: Maybe String 12 | foo = do 13 | x <- Just 3 14 | y <- Just "!" 15 | return (show x ++ y) 16 | 17 | marySue :: Maybe Bool 18 | marySue = do 19 | x <- Just 9 20 | return (x > 8) 21 | 22 | routine1 :: Maybe Pole 23 | routine1 = do 24 | start <- return (0, 0) 25 | first <- landLeft 2 start 26 | second <- landRight 2 first 27 | landLeft 1 second 28 | 29 | routine2 :: Maybe Pole 30 | routine2 = do 31 | start <- return (0, 0) 32 | first <- landLeft 2 start 33 | Nothing 34 | second <- landRight 2 first 35 | landLeft 1 second 36 | 37 | justH :: Maybe Char 38 | justH = do 39 | (x : xs) <- Just "hello".toList 40 | return x 41 | 42 | wopwop :: Maybe Char 43 | wopwop = do 44 | (x : xs) <- Just "".toList 45 | return x 46 | 47 | main _ = do 48 | 49 | println routine1 50 | println routine2 51 | 52 | println wopwop 53 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter02/ImAListComprehension.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter02.ImAListComprehension where 2 | 3 | boomBangs xs = [ if x < 10 then "BOOM!" else "BANG!" | x <- xs, odd x ] 4 | 5 | nouns = [ "hobo", "frog", "pope" ] 6 | adjectives = [ "lazy", "grouchy", "scheming" ] 7 | 8 | length' xs = sum [ 1 | _ <- xs ] 9 | 10 | removeNonUppercase st = [ c | c <- st, c `elem` [ 'A' .. 'Z' ] ] 11 | 12 | xxs = [ [ 1, 3, 5, 2, 3, 1, 2, 4, 5 ] 13 | , [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ] 14 | , [ 1, 2, 4, 2, 1, 6, 3, 1, 3, 2, 3, 6 ] 15 | ] 16 | 17 | main _ = do 18 | 19 | println $ [ x * 2 | x <- [ 1 .. 10 ] ] 20 | println $ [ x * 2 | x <- [ 1 .. 10 ], x * 2 >= 12 ] 21 | println $ [ x | x <- [ 50 .. 100 ], x `mod` 7 == 3 ] 22 | 23 | println $ boomBangs [ 7 .. 13 ] 24 | println $ [ x | x <- [ 10 .. 20 ], x != 13, x != 15, x != 19 ] 25 | 26 | println $ [ x * y | x <- [ 2, 5, 10 ], y <- [ 8, 10, 11 ] ] 27 | println $ [ x * y | x <- [ 2, 5, 10 ], y <- [ 8, 10, 11 ], x * y > 50 ] 28 | 29 | println $ [ adjective ++ " " ++ noun | adjective <- adjectives, noun <- nouns ] 30 | 31 | println $ packed $ removeNonUppercase "Hahaha! Ahahaha!" 32 | println $ packed $ removeNonUppercase "IdontLIKEFROGS" 33 | 34 | println $ [ [ x | x <- xs, even x ] | xs <- xxs ] 35 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter06/SomeHigherOrderismIsInOrder.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter06.SomeHigherOrderismIsInOrder where 2 | 3 | applyTwice :: (a -> a) -> a -> a 4 | applyTwice f x = f (f x) 5 | 6 | multThree :: (Num a) => a -> a -> a -> a 7 | multThree x y z = x * y * z 8 | 9 | zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c] 10 | zipWith' _ [] _ = [] 11 | zipWith' _ _ [] = [] 12 | zipWith' f (x : xs) (y : ys) = f x y : zipWith' f xs ys 13 | 14 | flip' :: (a -> b -> c) -> b -> a -> c 15 | flip' f y x = f x y 16 | 17 | main _ = do 18 | 19 | println $ applyTwice (+ 3) 10 20 | println $ applyTwice (++ " HAHA") "HEY" 21 | println $ applyTwice ("HAHA " ++) "HEY" 22 | println $ applyTwice (multThree 2 2) 9 23 | println $ applyTwice (3 :) [1] 24 | 25 | println $ zipWith' (+) [ 4, 2, 5, 6 ] [ 2, 6, 2, 3 ] 26 | println $ zipWith' max [ 6, 3, 2, 1 ] [ 7, 3, 1, 5 ] 27 | println $ zipWith' (++) [ "foo ", "bar ", "baz " ] 28 | [ "fighters", "hoppers", "aldrin" ] 29 | println $ zipWith' (*) (replicate 5 2) [1 ..] 30 | println $ zipWith' (zipWith' (*)) [ [ 1, 2, 3 ], [ 3, 5, 6 ], [ 2, 3, 4 ] ] 31 | [ [ 3, 2, 2 ], [ 3, 4, 5 ], [ 5, 4, 3 ] ] 32 | 33 | println $ flip' zip [ 1, 2, 3, 4, 5 ] "hello".toList 34 | println $ zipWith (flip' div) (repeat 2) [ 10, 8, 6, 4, 2 ] 35 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/AlgebraicDataTypesIntro.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.AlgebraicDataTypesIntro where 2 | 3 | import frege.prelude.Math () 4 | 5 | data Point = Point Float Float 6 | derive Show Point 7 | 8 | data Shape = 9 | Circle Point Float 10 | | Rectangle Point Point 11 | derive Show Shape 12 | 13 | surface :: Shape -> Float 14 | surface (Circle _ r) = Math.pi * r ^ 2 15 | surface (Rectangle (Point x1 y1) (Point x2 y2)) = 16 | (abs $ x2 - x1) * (abs $ y2 - y1) 17 | 18 | nudge :: Shape -> Float -> Float -> Shape 19 | nudge (Circle (Point x y) r) a b = 20 | Circle (Point (x + a) (y + b)) r 21 | nudge (Rectangle (Point x1 y1) (Point x2 y2)) a b = 22 | Rectangle (Point (x1 + a) (y1 + b)) (Point (x2 + a) (y2 + b)) 23 | 24 | baseCircle :: Float -> Shape 25 | baseCircle r = Circle (Point 0 0) r 26 | 27 | baseRect :: Float -> Float -> Shape 28 | baseRect width height = Rectangle (Point 0 0) (Point width height) 29 | 30 | main _ = do 31 | 32 | println $ surface $ Circle (Point 10 20) 10 33 | println $ surface $ Rectangle (Point 0 0) (Point 100 100) 34 | 35 | println $ Circle (Point 10 10) 5 36 | println $ Rectangle (Point 50 230) (Point 60 90) 37 | 38 | println $ map (Circle (Point 10 20)) [ 4, 5, 6, 6 ] 39 | 40 | println $ nudge (Circle (Point 34 34) 10) 5 10 41 | 42 | println $ nudge (baseRect 40 100) 60 23 43 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter10/ReversePolishNotationCalculator.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter10.ReversePolishNotationCalculator where 2 | 3 | import frege.prelude.Math ( **, log ) 4 | 5 | solveRPN :: String -> Double 6 | solveRPN = head . fold foldFunction [] . words 7 | where foldFunction (x : y : ys) "*" = (y * x) : ys 8 | foldFunction (x : y : ys) "+" = (y + x) : ys 9 | foldFunction (x : y : ys) "-" = (y - x) : ys 10 | foldFunction (x : y : ys) "/" = (y / x) : ys 11 | foldFunction (x : y : ys) "^" = (y ** x) : ys 12 | foldFunction (x : xs) "ln" = (log x) : xs 13 | foldFunction xs "sum" = [sum xs] 14 | foldFunction xs numberString = 15 | case numberString.double of 16 | Right x -> x : xs 17 | Left _ -> error $ "cannot parse " ++ numberString ++ " into Double" 18 | 19 | main _ = do 20 | 21 | println $ solveRPN "10 4 3 + 2 * -" 22 | println $ solveRPN "2 3 +" 23 | println $ solveRPN "90 34 12 33 55 66 + * - +" 24 | println $ solveRPN "90 34 12 33 55 66 + * - + -" 25 | println $ solveRPN "90 34 12 33 55 66 + * - + -" 26 | println $ solveRPN "90 3 -" 27 | 28 | println $ solveRPN "2.7 ln" 29 | println $ solveRPN "10 10 10 10 sum 4 /" 30 | println $ solveRPN "10 10 10 10 10 sum 4 /" 31 | println $ solveRPN "10 2 ^" 32 | println $ solveRPN "43.2425 0.5 ^" 33 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter06/OnlyFoldsAndHorses.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter06.OnlyFoldsAndHorses where 2 | 3 | import frege.prelude.Math 4 | 5 | sum' :: (Num a) => [a] -> a 6 | --sum' xs = fold (\acc \x -> acc + x) 0 xs 7 | sum' = fold (+) 0 8 | 9 | elem' :: (Eq a) => a -> [a] -> Bool 10 | elem' y ys = fold (\acc \x -> if x == y then true else acc) false ys 11 | 12 | map' :: (a -> b) -> [a] -> [b] 13 | map' f xs = foldr (\x \acc -> f x : acc) [] xs 14 | 15 | maximum' :: (Ord a) => [a] -> a 16 | maximum' = foldr1 (\x \acc -> if x > acc then x else acc) 17 | 18 | reverse' :: [a] -> [a] 19 | reverse' = fold (\acc \x -> x : acc) [] 20 | 21 | product' :: (Num a) => [a] -> a 22 | product' = foldr1 (*) 23 | 24 | filter' :: (a -> Bool) -> [a] -> [a] 25 | filter' p = foldr (\x \acc -> if p x then x : acc else acc) [] 26 | 27 | head' :: [a] -> a 28 | head' = foldr1 (\x \_ -> x) 29 | 30 | last' :: [a] -> a 31 | last' = foldl1 (\_ \x -> x) 32 | 33 | sqrtSums :: Int 34 | sqrtSums = length (takeWhile (< 1000) (scanl1 (+) (map sqrt (iterate (+1) 1.0)))) + 1 35 | 36 | main _ = do 37 | 38 | println $ sum' [ 3, 5, 2, 1 ] 39 | 40 | println $ scanl (+) 0 [ 3, 5, 2, 1 ] 41 | println $ scanr (+) 0 [ 3, 5, 2, 1 ] 42 | println $ scanl1 (\acc \x -> if x > acc then x else acc) 43 | [ 3, 4, 5, 3, 7, 9, 2, 1 ] 44 | println $ scanl (flip (:)) [] [ 3, 2, 1 ] 45 | 46 | println $ sqrtSums 47 | println $ sum (map sqrt $ take 131 $ iterate (+1) 1.0) 48 | println $ sum (map sqrt $ take 130 $ iterate (+1) 1.0) 49 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/AYesNoTypeclass.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.AYesNoTypeclass where 2 | 3 | import learnyou.chapter08.RecursiveDataStructures ( Tree ) 4 | import learnyou.chapter08.Typeclasses102 ( TrafficLight ) 5 | 6 | class YesNo a where 7 | yesno :: a -> Bool 8 | 9 | instance YesNo Int where 10 | yesno 0 = false 11 | yesno _ = true 12 | 13 | instance YesNo [a] where 14 | yesno [] = false 15 | yesno _ = true 16 | 17 | instance YesNo Bool where 18 | yesno = id 19 | 20 | instance YesNo (Maybe a) where 21 | yesno (Just _) = true 22 | yesno Nothing = false 23 | 24 | instance YesNo (Tree a) where 25 | yesno EmptyTree = false 26 | yesno _ = true 27 | 28 | instance YesNo TrafficLight where 29 | yesno Red = false 30 | yesno _ = true 31 | 32 | yesnoIf :: (YesNo y) => y -> a -> a -> a 33 | yesnoIf yesnoVal yesResult noResult = 34 | if yesno yesnoVal 35 | then yesResult 36 | else noResult 37 | 38 | main _ = do 39 | 40 | println $ yesno $ length [] 41 | println $ yesno "haha".toList 42 | println $ yesno "".toList 43 | println $ yesno $ Just 0 44 | println $ yesno true 45 | println $ yesno (EmptyTree :: Tree Int) 46 | println $ yesno ([] :: [Int]) 47 | println $ yesno [ 0, 0, 0 ] 48 | 49 | println $ yesnoIf ([] :: [Int]) "YEAH!" "NO!" 50 | println $ yesnoIf [ 2, 3, 4 ] "YEAH!" "NO!" 51 | println $ yesnoIf true "YEAH!" "NO!" 52 | println $ yesnoIf (Just 500) "YEAH!" "NO!" 53 | println $ yesnoIf (Nothing :: Maybe Int) "YEAH!" "NO!" 54 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter14/TakingAWalk.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter14.TakingAWalk where 2 | 3 | data Tree a = Empty | Node a (Tree a) (Tree a) 4 | derive Show (Tree a) 5 | 6 | freeTree :: Tree Char 7 | freeTree = 8 | Node 'P' 9 | (Node 'O' 10 | (Node 'L' 11 | (Node 'N' Empty Empty) 12 | (Node 'T' Empty Empty) 13 | ) 14 | (Node 'Y' 15 | (Node 'S' Empty Empty) 16 | (Node 'A' Empty Empty) 17 | ) 18 | ) 19 | (Node 'L' 20 | (Node 'W' 21 | (Node 'C' Empty Empty) 22 | (Node 'R' Empty Empty) 23 | ) 24 | (Node 'A' 25 | (Node 'A' Empty Empty) 26 | (Node 'C' Empty Empty) 27 | ) 28 | ) 29 | 30 | data Direction = L | R 31 | derive Show Direction 32 | 33 | type Directions = [Direction] 34 | 35 | changeToP :: Directions -> Tree Char -> Tree Char 36 | changeToP _ Empty = Empty 37 | changeToP [] (Node _ l r) = Node 'P' l r 38 | changeToP (L : ds) (Node x l r) = Node x (changeToP ds l) r 39 | changeToP (R : ds) (Node x l r) = Node x l (changeToP ds r) 40 | 41 | -- 'elemAt' is already defined at ArrayElem.elemAt 42 | nodeAt :: Directions -> Tree a -> a 43 | nodeAt _ Empty = error "no element." 44 | nodeAt [] (Node x _ _) = x 45 | nodeAt (L : ds) (Node _ l _) = nodeAt ds l 46 | nodeAt (R : ds) (Node _ _ r) = nodeAt ds r 47 | 48 | main _ = do 49 | let newTree = changeToP [R, L] freeTree 50 | println $ nodeAt [R, L] newTree 51 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/DataChar.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.DataChar where 2 | 3 | import frege.Prelude hiding ( isNumber ) 4 | import frege.data.List 5 | import frege.data.Char 6 | 7 | encode :: Int -> String -> String 8 | encode shift msg = 9 | let ords = map ord $ unpacked msg 10 | shifted = map (+ shift) ords 11 | in packed $ map chr shifted 12 | 13 | decode :: Int -> String -> String 14 | decode shift msg = encode (negate shift) msg 15 | 16 | main _ = do 17 | 18 | println $ all isAlphaNum "bobby283".toList 19 | println $ all isAlphaNum "eddy the fish!".toList 20 | 21 | println $ words "hey guys its me" 22 | println $ filter (not . any isSpace) . groupBy ((==) `on` isSpace) $ 23 | "hey guys its me".toList 24 | 25 | println $ generalCategory ' ' 26 | println $ generalCategory 'A' 27 | println $ generalCategory 'a' 28 | println $ generalCategory '.' 29 | println $ generalCategory '9' 30 | println $ map generalCategory " \t\nA9?|".toList 31 | 32 | println $ map digitToInt "34538".toList 33 | println $ map digitToInt "FF85AB".toList 34 | 35 | println $ intToDigit 15 36 | println $ intToDigit 5 37 | 38 | println $ ord 'a' 39 | println $ chr 97 40 | println $ map ord "abcdefgh".toList 41 | 42 | println $ encode 3 "Heeeeey" 43 | println $ encode 4 "Heeeeey" 44 | println $ encode 1 "abcd" 45 | println $ encode 5 "Marry Christmas! Ho ho ho!" 46 | 47 | println $ encode 3 "Im a little teapot" 48 | println $ decode 3 "Lp#d#olwwoh#whdsrw" 49 | println $ decode 5 . encode 5 $ "This is a sentence" 50 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/DerivedInstances.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.DerivedInstances where 2 | 3 | data Person = Person 4 | { firstName :: String 5 | , lastName :: String 6 | , age :: Int 7 | } 8 | derive Eq Person 9 | derive Show Person 10 | 11 | mikeD = Person { firstName = "Michael", lastName = "Diamond", age = 43 } 12 | adRock = Person { firstName = "Adam", lastName = "Horovitz", age = 41 } 13 | mca = Person { firstName = "Adam", lastName = "Yauch", age = 44 } 14 | 15 | beastieBoys = [mca, adRock, mikeD] 16 | 17 | data Day = 18 | Monday 19 | | Tuesday 20 | | Wednesday 21 | | Thursday 22 | | Friday 23 | | Saturday 24 | | Sunday 25 | derive Eq Day 26 | derive Ord Day 27 | derive Show Day 28 | derive Bounded Day 29 | derive Enum Day 30 | 31 | main _ = do 32 | 33 | println $ mca == adRock 34 | println $ mikeD == adRock 35 | println $ mikeD == mikeD 36 | println $ mikeD == Person { firstName = "Michael", lastName = "Diamond", age = 43 } 37 | 38 | println $ mikeD `elem` beastieBoys 39 | 40 | println $ "mikeD is: " ++ show mikeD 41 | 42 | println $ true `compare` false 43 | println $ true > false 44 | println $ true < false 45 | 46 | println $ Nothing < Just 100 47 | println $ Nothing > Just (-49999) 48 | println $ Just 3 `compare` Just 2 49 | println $ Just 100 > Just 50 50 | 51 | println $ (minBound :: Day) 52 | println $ (maxBound :: Day) 53 | 54 | println $ succ Monday 55 | println $ pred Saturday 56 | println $ [ Thursday .. Sunday ] 57 | println $ ([ minBound .. maxBound ] :: [Day]) 58 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter09/CommandLineArguments.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter09.CommandLineArguments where 2 | 3 | import frege.data.List ( lookup, delete, !! ) 4 | 5 | -- Note: frege.system.Environment does not work well. 6 | 7 | dispatch :: [(String, [String] -> IO ())] 8 | dispatch = 9 | [ ("add", add) 10 | , ("view", view) 11 | , ("remove", remove) 12 | ] 13 | 14 | showUsage :: IO () 15 | showUsage = stderr.println "usege: todo (add | view | remove) FILE [task]" 16 | 17 | main [] = showUsage 18 | main (command : args) = do 19 | let mAction = lookup command dispatch 20 | case mAction of 21 | Just action = action args 22 | Nothing = showUsage 23 | 24 | add :: [String] -> IO () 25 | add [fileName, todoItem] = do 26 | appendFile fileName (todoItem ++ lineSeparator) 27 | add _ = showUsage 28 | 29 | view :: [String] -> IO () 30 | view [fileName] = do 31 | contents <- readFile fileName 32 | let todoItems = lines contents 33 | numberedItems = zipWith (\n \line -> show n ++ " - " ++ line) [0..] todoItems 34 | println $ unlines numberedItems 35 | view _ = showUsage 36 | 37 | remove :: [String] -> IO () 38 | remove [fileName, numberString] = do 39 | contents <- readFile fileName 40 | let number = atoi numberString 41 | todoItems = lines contents 42 | newTodoItems = delete (todoItems !! number) todoItems 43 | tempName <- File.createTempFile "temp" "" >>= (\f -> f.getName) 44 | writeFile tempName $ unlines newTodoItems 45 | old <- File.new tempName 46 | new <- File.new fileName 47 | old.renameTo new >> return () 48 | remove _ = showUsage 49 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/TypeSynonyms.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.TypeSynonyms where 2 | 3 | import frege.data.HashMap as HM () 4 | 5 | type PhoneNumber = String 6 | type Name = String 7 | type PhoneBook = [(Name, PhoneNumber)] 8 | 9 | inPhoneBook :: Name -> PhoneNumber -> PhoneBook -> Bool 10 | inPhoneBook name pnumber pbook = (name, pnumber) `elem` pbook 11 | 12 | type AssocList k v = [(k, v)] 13 | --type IntMap v = HM.HashMap Int v 14 | type IntMap = HM.HashMap Int 15 | 16 | data LockerState = Taken | Free 17 | derive Show LockerState 18 | derive Eq LockerState 19 | 20 | type Code = String 21 | type LockerMap = HM.HashMap Int (LockerState, Code) 22 | 23 | lockerLookup :: Int -> LockerMap -> (String | Code) 24 | lockerLookup lockerNumber map = 25 | case HM.lookup lockerNumber map of 26 | Nothing -> 27 | Left $ "Locker number " ++ show lockerNumber ++ " doesn't exist!" 28 | Just (state, code) -> 29 | if state != Taken 30 | then Right code 31 | else Left $ "Locker " ++ show lockerNumber ++ " is already taken!" 32 | 33 | lockers :: LockerMap 34 | lockers = HM.fromList 35 | [ (100, (Taken, "ZD39I")) 36 | , (101, (Free, "JAH3I")) 37 | , (103, (Free, "IQSA9")) 38 | , (105, (Free, "QOTSA")) 39 | , (109, (Taken, "893JJ")) 40 | , (110, (Taken, "99292")) 41 | ] 42 | 43 | main _ = do 44 | 45 | println $ (Right 20 :: (String | Int)) 46 | println $ (Left "w00t" :: (String | Int)) 47 | 48 | println $ lockerLookup 101 lockers 49 | println $ lockerLookup 100 lockers 50 | println $ lockerLookup 102 lockers 51 | println $ lockerLookup 110 lockers 52 | println $ lockerLookup 105 lockers 53 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter09/Exceptions.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter09.Exceptions where 2 | 3 | showLineCount :: String -> String 4 | showLineCount contents = 5 | "The file has " ++ (show . length . lines $ contents) ++ " lines!" 6 | 7 | lineCount1 :: [String] -> IO () 8 | lineCount1 [] = do 9 | println "input a filename." 10 | lineCount1 (fileName : _) = do 11 | contents <- readFile fileName 12 | println $ showLineCount contents 13 | 14 | lineCount2 :: [String] -> IO () 15 | lineCount2 [] = do 16 | println "input a filename." 17 | lineCount2 (fileName : _) = do 18 | file <- File.new fileName 19 | fileExists <- file.exists 20 | if fileExists 21 | then do 22 | contents <- readFile fileName 23 | println $ showLineCount contents 24 | else do 25 | println $ "The file doesn't exist!" 26 | 27 | -- Frege doesn't have exceptions equivalent to "isFullError" nor "isIllegalOperation" 28 | lineCount3 :: [String] -> IO () 29 | lineCount3 [] = do 30 | println "input a filename." 31 | lineCount3 (fileName : _) = do 32 | try (\fn -> readFile fn >>= println . showLineCount) fileName 33 | `catch` (\(fne :: FileNotFoundException) -> println "The file doesn't exist!") 34 | `catch` (\(ioe :: IOException) -> throwIO ioe) 35 | 36 | -- Frege doesn't have exceptions eequivalent to "ioeGetFileName" 37 | lineCount4:: [String] -> IO () 38 | lineCount4 [] = do 39 | println "input a filename." 40 | lineCount4 (fileName : _) = do 41 | try (\fn -> readFile fn >>= println . showLineCount) fileName 42 | `catch` (\(fne :: FileNotFoundException) -> println fne.getMessage) 43 | `catch` (\(ioe :: IOException) -> throwIO ioe) 44 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/TypeParameters.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.TypeParameters where 2 | 3 | data Car = Car 4 | { company :: String 5 | , model :: String 6 | , year :: Int 7 | } 8 | derive Show Car 9 | 10 | data Car' a b c = Car' 11 | { company :: a 12 | , model :: b 13 | , year :: c 14 | } 15 | derive Show (Car' a b c) 16 | 17 | tellCar :: Car -> String 18 | tellCar (Car {company = c, model = m, year = y}) = 19 | "This " ++ c ++ " " ++ m ++ " was made in " ++ show y 20 | 21 | tellCar' :: (Show a) => Car' String String a -> String 22 | tellCar' (Car' {company = c, model = m, year = y}) = 23 | "This " ++ c ++ " " ++ m ++ " was made in " ++ show y 24 | 25 | data Vector a = Vector a a a 26 | derive Show (Vector a) 27 | 28 | vplus :: (Num t) => Vector t -> Vector t -> Vector t 29 | (Vector i j k) `vplus` (Vector l m n) = Vector (i + l) (j + m) (k + n) 30 | 31 | scalarMult :: (Num t) => Vector t -> t -> Vector t 32 | (Vector i j k) `scalarMult` m = Vector (i * m) (j * m) (k * m) 33 | 34 | vectMult :: (Num t) => Vector t -> Vector t -> t 35 | (Vector i j k) `vectMult` (Vector l m n) = i * l + j * m + k * n 36 | 37 | main _ = do 38 | 39 | let stang = Car { company = "Ford", model = "Mustang", year = 1967 } 40 | println $ tellCar stang 41 | 42 | println $ tellCar' (Car' "Ford" "Mustang" 1967) 43 | println $ tellCar' (Car' "Ford" "Mustang" "nineteen sixty seven") 44 | 45 | println $ Vector 3 5 8 `vplus` Vector 9 2 8 46 | println $ (Vector 3 5 8 `vplus` Vector 9 2 8) `vplus` Vector 0 2 3 47 | println $ Vector 3 9 7 `scalarMult` 10 48 | println $ Vector 4 9 5 `vectMult` Vector 9.0 2.0 4.0 49 | println $ Vector 2 9 3 `scalarMult` (Vector 4 9 5 `vectMult` Vector 9 2 4) 50 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter12/TheListMonad.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter12.TheListMonad where 2 | 3 | listOfTuples :: [(Int, Char)] 4 | listOfTuples = do 5 | n <- [ 1, 2 ] 6 | ch <- [ 'a', 'b' ] 7 | return (n, ch) 8 | 9 | sevensOnly :: [Int] 10 | sevensOnly = do 11 | x <- [1 .. 50] 12 | guard ('7' `elem` (toList . show) x) 13 | return x 14 | 15 | type KnightPos = (Int, Int) 16 | 17 | moveKnight :: KnightPos -> [KnightPos] 18 | moveKnight (c, r) = do 19 | (c', r') <- [ (c + 2, r - 1), (c + 2, r + 1), (c - 2, r - 1), (c - 2, r + 1) 20 | , (c + 1, r - 2), (c + 1, r + 2), (c - 1, r - 2), (c - 1, r + 2) 21 | ] 22 | guard (c' `elem` [ 1 .. 8 ] && r' `elem` [ 1 .. 8 ]) 23 | return (c', r') 24 | 25 | in3 :: KnightPos -> [KnightPos] 26 | in3 start = return start >>= moveKnight >>= moveKnight >>= moveKnight 27 | 28 | canReachIn3 :: KnightPos -> KnightPos -> Bool 29 | canReachIn3 start end = end `elem` in3 start 30 | 31 | main _ = do 32 | 33 | println $ [ 3, 4, 5 ] >>= \x -> [ x, -x ] 34 | 35 | println $ [] >>= \x -> [ "bad", "mad", "rad" ] 36 | println $ [ 1, 2, 3 ] >>= \x -> ([] :: [Int]) 37 | 38 | println $ [ 1, 2 ] >>= \n -> [ 'a', 'b' ] >>= \ch -> return (n, ch) 39 | println $ [ (n,ch) | n <- [ 1, 2 ], ch <- [ 'a', 'b' ] ] 40 | 41 | println $ [ x | x <- [ 1 .. 50 ], '7' `elem` (toList . show) x ] 42 | 43 | println $ (guard (5 > 2) :: Maybe ()) 44 | println $ (guard (1 > 2) :: Maybe ()) 45 | println $ (guard (5 > 2) :: [()]) 46 | 47 | println $ (guard (5 > 2) >> return "cool" :: [String]) 48 | println $ (guard (1 > 2) >> return "cool" :: [String]) 49 | 50 | println $ moveKnight (6, 2) 51 | println $ moveKnight (8, 1) 52 | 53 | println $ (6, 2) `canReachIn3` (6, 1) 54 | println $ (6, 2) `canReachIn3` (7, 3) 55 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter11/FunctorsRedux.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter11.FunctorsRedux where 2 | 3 | import frege.data.Char ( toUpper ) 4 | import frege.data.List ( intersperse ) 5 | 6 | example1 :: IO () 7 | example1 = do 8 | line <- fmap (packed . reverse . unpacked) getLine 9 | putStrLn $ "You said " ++ line ++ " backwards!" 10 | putStrLn $ "Yes, you really said" ++ line ++ " backwards!" 11 | 12 | example2 :: IO () 13 | example2 = do 14 | line <- fmap (packed . intersperse '-' . reverse . map toUpper . unpacked) getLine 15 | putStrLn line 16 | 17 | data CMaybe a = CNothing | CJust Int a 18 | derive Show (CMaybe a) 19 | 20 | instance Functor CMaybe where 21 | fmap f CNothing = CNothing 22 | fmap f (CJust counter x) = CJust (counter + 1) (f x) 23 | 24 | main _ = do 25 | 26 | println $ fmap (* 3) (+ 100) 1 27 | println $ (* 3) `fmap` (+ 100) $ 1 28 | println $ (* 3) . (+ 100) $ 1 29 | println $ fmap (show . (* 3)) (* 100) 1 30 | 31 | println $ fmap (replicate 3) [ 1, 2, 3, 4 ] 32 | println $ fmap (replicate 3) (Just 4) 33 | println $ fmap (replicate 3) (Right "blah" :: (String | String)) 34 | println $ fmap (replicate 3) (Nothing :: Maybe Int) 35 | println $ fmap (replicate 3) (Left "foo" :: (String | String)) 36 | 37 | println $ fmap id (Just 3) 38 | println $ id (Just 3) 39 | println $ fmap id [ 1 .. 5 ] 40 | println $ id [ 1 .. 5 ] 41 | println $ fmap id ([] :: [Int]) 42 | println $ fmap id (Nothing :: Maybe Int) 43 | 44 | println $ (CNothing :: CMaybe String) 45 | println $ CJust 0 "haha" 46 | println $ CJust 100 [ 1, 2, 3 ] 47 | 48 | println $ fmap (++ "ha") (CJust 0 "ho") 49 | println $ fmap (++ "he") (fmap (++ "ha") (CJust 0 "ho")) 50 | println $ fmap (++ "blah") CNothing 51 | 52 | println $ fmap id (CJust 0 "haha") 53 | println $ id (CJust 0 "haha") 54 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter08/RecursiveDataStructures.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter08.RecursiveDataStructures where 2 | 3 | data List a = 4 | Empty 5 | | Cons a (List a) 6 | derive Show (List a) 7 | derive Eq (List a) 8 | derive Ord (List a) 9 | 10 | infixr 5 `:-:` 11 | (:-:) :: a -> List a -> List a 12 | x :-: xs = Cons x xs 13 | 14 | infixr 5 `.++` 15 | (.++) :: List a -> List a -> List a 16 | Empty .++ ys = ys 17 | (Cons x xs) .++ ys = Cons x (xs .++ ys) 18 | 19 | data Tree a = 20 | EmptyTree 21 | | Node a (Tree a) (Tree a) 22 | derive Show (Tree a) 23 | derive Eq (Tree a) 24 | 25 | singleton :: a -> Tree a 26 | singleton x = Node x EmptyTree EmptyTree 27 | 28 | treeInsert :: (Ord a) => a -> Tree a -> Tree a 29 | treeInsert x EmptyTree = singleton x 30 | treeInsert x (Node a left right) 31 | | x == a = Node x left right 32 | | x < a = Node a (treeInsert x left) right 33 | | otherwise = Node a left (treeInsert x right) 34 | 35 | treeElem :: (Ord a) => a -> Tree a -> Bool 36 | treeElem x EmptyTree = false 37 | treeElem x (Node a left right) 38 | | x == a = true 39 | | x < a = treeElem x left 40 | | otherwise = treeElem x right 41 | 42 | main _ = do 43 | 44 | println $ (Empty :: List Int) 45 | println $ 5 `Cons` Empty 46 | println $ 4 `Cons` (5 `Cons` Empty) 47 | println $ 3 `Cons` (4 `Cons` (5 `Cons` Empty)) 48 | 49 | println $ 3 :-: 4 :-: 5 :-: Empty 50 | let a = 3 :-: 4 :-: 5 :-: Empty 51 | println $ 100 :-: a 52 | 53 | let a = 3 :-: 4 :-: 5 :-: Empty 54 | let b = 6 :-: 7 :-: Empty 55 | println $ a .++ b 56 | 57 | let nums = [ 8, 6, 4, 1, 7, 3, 5 ] 58 | let numsTree = foldr treeInsert EmptyTree nums 59 | println $ numsTree 60 | 61 | println $ 8 `treeElem` numsTree 62 | println $ 100 `treeElem` numsTree 63 | println $ 1 `treeElem` numsTree 64 | println $ 10 `treeElem` numsTree 65 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter02/AnIntroToLists.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter02.AnIntroToLists where 2 | 3 | import frege.data.List 4 | 5 | lostNumbers = [ 4, 8, 15, 16, 23, 42 ] 6 | 7 | b = [ [ 1, 2, 3, 4 ] 8 | , [ 5, 3, 3, 3 ] 9 | , [ 1, 2, 2, 3, 4 ] 10 | , [ 1, 2, 3 ] 11 | ] 12 | 13 | main _ = do 14 | 15 | println $ [ 1, 2, 3, 4 ] ++ [ 9, 10, 11, 12 ] 16 | println $ "hello" ++ " " ++ "world" 17 | println $ packed $ [ 'w', 'o' ] ++ [ 'o', 't' ] 18 | 19 | println $ "A" ++ " SMALL CAT" 20 | println $ packed $ 'A' : toList " SMALL CAT" 21 | println $ 5 : [ 1, 2, 3, 4, 5 ] 22 | 23 | println $ (toList "Steve Buscemi") !! 6 24 | println $ "Steve Buscemi".charAt 6 25 | 26 | println $ b ++ [ [ 1, 1, 1, 1 ] ] 27 | println $ [ 6, 6, 6 ] : b 28 | println $ b !! 2 29 | 30 | println $ [ 3, 2, 1 ] > [ 2, 1, 0 ] 31 | println $ [ 3, 2, 1 ] > [ 2, 10, 100 ] 32 | println $ [ 3, 4, 2 ] > [ 3, 4 ] 33 | println $ [ 3, 4, 2 ] > [ 2, 4 ] 34 | println $ [ 3, 4, 2 ] == [ 3, 4, 2 ] 35 | 36 | println $ head [ 5, 4, 3, 2, 1 ] 37 | println $ tail [ 5, 4, 3, 2, 1 ] 38 | println $ last [ 5, 4, 3, 2, 1 ] 39 | println $ init [ 5, 4, 3, 2, 1 ] 40 | 41 | println $ length [ 5, 4, 3, 2, 1 ] 42 | 43 | println $ null [ 1, 2, 3 ] 44 | println $ null [] 45 | 46 | println $ reverse [ 5, 4, 3, 2, 1 ] 47 | 48 | println $ take 3 [ 5, 4, 3, 2, 1 ] 49 | println $ take 1 [ 3, 9, 3 ] 50 | println $ take 0 [ 6, 6, 6 ] 51 | 52 | println $ drop 3 [ 8, 4, 2, 1, 5, 6 ] 53 | println $ drop 0 [ 1, 2, 3, 4 ] 54 | println $ drop 100 [ 1, 2, 3, 4 ] 55 | 56 | println $ minimum [ 8, 4, 2, 1, 5, 6 ] 57 | println $ maximum [ 1, 9, 2, 3, 4 ] 58 | 59 | println $ sum [ 5, 2, 1, 6, 3, 2, 5, 7] 60 | println $ product [ 6, 2, 1, 2 ] 61 | println $ product [ 1, 2, 5, 6, 7, 9, 2, 0 ] 62 | 63 | println $ 4 `elem` [ 3, 4, 5, 6 ] 64 | println $ 10 `elem` [ 3, 4, 5, 6 ] 65 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter04/PatternMatching.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter04.PatternMatching where 2 | 3 | lucky :: (Integral a) => a -> String 4 | lucky 7 = "LUCKY NUMBER SEVEN!" 5 | lucky x = "Sorry, you're out of luck, pal!" 6 | 7 | sayMe :: (Integral a) => a -> String 8 | sayMe 1 = "One!" 9 | sayMe 2 = "Two!" 10 | sayMe 3 = "Three!" 11 | sayMe 4 = "Four!" 12 | sayMe 5 = "Five!" 13 | sayMe x = "Not between 1 and 5" 14 | 15 | factorial :: (Integral a) => a -> a 16 | factorial 0 = 1 17 | factorial n = n * factorial (n - 1) 18 | 19 | charName :: Char -> String 20 | charName 'a' = "Albert" 21 | charName 'b' = "Broseph" 22 | charName 'c' = "Cecil" 23 | charName _ = "No Name" 24 | 25 | addVectors :: (Num a) => (a, a) -> (a, a) -> (a, a) 26 | addVectors (x1, y1) (x2, y2) = (x1 + x2, y1 + y2) 27 | 28 | first :: (a, b, c) -> a 29 | first (x, _, _) = x 30 | 31 | second :: (a, b, c) -> b 32 | second (_, y, _) = y 33 | 34 | third :: (a, b, c) -> c 35 | third (_, _, z) = z 36 | 37 | head' :: [a] -> a 38 | head' [] = error "Can't call head on an empty list, dummy!" 39 | head' (x : _) = x 40 | 41 | tell :: (Show a) => [a] -> String 42 | tell [] = "The list is empty" 43 | tell (x : []) = 44 | "The list has one element: " ++ show x 45 | tell (x : y : []) = 46 | "The list has two elements: " ++ show x ++ " and " ++ show y 47 | tell (x : y : _) = 48 | "This list is long. The first two elements are: " ++ show x ++ " and " ++ show y 49 | 50 | length' :: (Num b) => [a] -> b 51 | length' [] = 0 52 | length' (_ : xs) = 1 + length' xs 53 | 54 | sum' :: (Num a) => [a] -> a 55 | sum' [] = 0 56 | sum' (x : xs) = x + sum' xs 57 | 58 | capital' :: [Char] -> String 59 | capital' [] = "Empty string, whoops!" 60 | capital' (all@(x : xs)) = 61 | "The first letter of " ++ (packed all) ++ " is " ++ (ctos x) 62 | 63 | main _ = do 64 | 65 | let xs = [ (1, 3), (4, 3), (2, 4), (5, 3), (5, 6), (3, 1) ] 66 | println $ [ a + b | (a, b) <- xs ] 67 | 68 | println $ head' [ 4, 5, 6 ] 69 | println $ head' "Hello".toList 70 | 71 | println $ capital' "Dracula".toList 72 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter13/MakingMonads.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter13.MakingMonads where 2 | 3 | data Rational = Rational Int Int 4 | 5 | private reduce :: Rational -> Rational 6 | private reduce (Rational x y) = Rational (x `div` g) (y `div` g) 7 | where g = gcd x y 8 | 9 | instance Show Rational where 10 | show (Rational x y) = show x ++ " % " ++ show y 11 | 12 | infixr 7 `%` 13 | (%) :: Int -> Int -> Rational 14 | x % y = reduce $ Rational x y 15 | 16 | infixl 6 `+.` 17 | (+.) :: Rational -> Rational -> Rational 18 | (Rational x1 y1) +. (Rational x2 y2) = (x1 * y2 + x2 * y1) % (y1 * y2) 19 | 20 | infixl 7 `*.` 21 | (*.) :: Rational -> Rational -> Rational 22 | (Rational x1 y1) *. (Rational x2 y2) = (x1 * x2) % (y1 * y2) 23 | 24 | data Prob a = Prob { getProb :: [(a, Rational)] } 25 | derive Show (Prob a) 26 | 27 | instance Functor Prob where 28 | fmap f (Prob xs) = Prob $ map (\(x, p) -> (f x, p)) xs 29 | 30 | thisSituation :: Prob (Prob Char) 31 | thisSituation = Prob 32 | [ (Prob [ ('a', 1 % 2), ('b', 1 % 2) ], 1 % 4) 33 | , (Prob [ ('c', 1 % 2), ('d', 1 % 2) ], 3 % 4) 34 | ] 35 | 36 | flatten :: Prob (Prob a) -> Prob a 37 | flatten (Prob xs) = Prob $ concat $ map multAll xs 38 | where multAll (Prob innerxs, p) = map (\(x, r) -> (x, r *. p)) innerxs 39 | 40 | instance Monad Prob where 41 | return x = Prob [(x, 1 % 1)] 42 | m >>= f = flatten (fmap f m) 43 | 44 | data Coin = Heads | Tails 45 | derive Eq Coin 46 | derive Show Coin 47 | 48 | coin :: Prob Coin 49 | coin = Prob [(Heads, 1 % 2), (Tails, 1 % 2)] 50 | 51 | loadedCoin :: Prob Coin 52 | loadedCoin = Prob [(Heads, 1 % 10), (Tails, 9 % 10)] 53 | 54 | flipThree :: Prob Bool 55 | flipThree = do 56 | a <- coin 57 | b <- coin 58 | c <- loadedCoin 59 | return (all (== Tails) [a, b, c]) 60 | 61 | main _ = do 62 | 63 | println $ 1 % 4 64 | println $ 1 % 2 +. 1 % 2 65 | println $ 1 % 3 +. 5 % 4 66 | 67 | println [ (3, 1 % 2), (5, 1 % 4), (9, 1 % 4) ] 68 | 69 | println $ fmap negate $ Prob [ (3, 1 % 2), (5, 1 % 4), (9, 1 % 4) ] 70 | 71 | println flipThree.getProb 72 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter13/TastefulStatefulComputations.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter13.TastefulStatefulComputations where 2 | 3 | import frege.control.monad.State 4 | import frege.system.Random 5 | 6 | type Stack = [Int] 7 | 8 | pop' :: Stack -> (Int, Stack) 9 | pop' [] = error "pop from the empty stack" 10 | pop' (x : xs) = (x, xs) 11 | 12 | push' :: Int -> Stack -> ((), Stack) 13 | push' a xs = ((), a : xs) 14 | 15 | stackManip' :: Stack -> (Int, Stack) 16 | stackManip' stack = 17 | let ((), newStack1) = push' 3 stack 18 | (a, newStack2) = pop' newStack1 19 | in pop' newStack2 20 | 21 | pop :: State Stack Int 22 | pop = do 23 | xs <- State.get 24 | case xs of 25 | [] -> error "pop from the empty stack" 26 | x : xs -> do 27 | State.put xs 28 | return x 29 | 30 | push :: Int -> State Stack () 31 | push a = do 32 | xs <- State.get 33 | State.put (a : xs) 34 | 35 | stackManip :: State Stack Int 36 | stackManip = do 37 | push 3 38 | pop 39 | pop 40 | 41 | stackStuff :: State Stack () 42 | stackStuff = do 43 | a <- pop 44 | if a == 5 45 | then push 5 46 | else do 47 | push 3 48 | push 8 49 | 50 | moreStack :: State Stack () 51 | moreStack = do 52 | a <- stackManip 53 | if a == 100 54 | then stackStuff 55 | else return () 56 | 57 | stackyStack :: State Stack () 58 | stackyStack = do 59 | stackNow <- State.get 60 | if stackNow == [ 1, 2, 3 ] 61 | then State.put [ 8, 3, 1 ] 62 | else State.put [ 9, 2, 1 ] 63 | 64 | randomSt :: (RandomGen g, Random a) => State g a 65 | randomSt = do 66 | gen <- State.get 67 | let (x, newGen) = random gen 68 | State.put newGen 69 | return x 70 | 71 | threeCoins :: State StdGen (Bool, Bool, Bool) 72 | threeCoins = do 73 | a <- randomSt 74 | b <- randomSt 75 | c <- randomSt 76 | return (a, b, c) 77 | 78 | main _ = do 79 | 80 | println $ stackManip' [ 5, 8, 2, 1 ] 81 | 82 | println $ stackManip.run [ 5, 8, 2, 1 ] 83 | 84 | println $ stackStuff.run [ 9, 0, 2, 1, 0 ] 85 | 86 | println $ fst $ threeCoins.run (mkStdGen 33) 87 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter14/ATrailOfBreadcrumbs.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter14.ATrailOfBreadcrumbs where 2 | 3 | import learnyou.chapter14.TakingAWalk ( Tree, Direction, freeTree ) 4 | 5 | type Breadcrumbs' = [Direction] 6 | 7 | goLeft' :: (Tree a, Breadcrumbs') -> (Tree a, Breadcrumbs') 8 | goLeft' (Empty, ds) = (Empty, ds) 9 | goLeft' (Node _ l _, bs) = (l, L : bs) 10 | 11 | goRight' :: (Tree a, Breadcrumbs') -> (Tree a, Breadcrumbs') 12 | goRight' (Empty, ds) = (Empty, ds) 13 | goRight' (Node _ _ r, bs) = (r, R : bs) 14 | 15 | infixl 7 `-:` 16 | (-:) :: a -> (a -> b) -> b 17 | x -: f = f x 18 | 19 | data Crumb a = 20 | LeftCrumb a (Tree a) 21 | | RightCrumb a (Tree a) 22 | derive Show (Crumb a) 23 | 24 | type Breadcrumbs a = [Crumb a] 25 | 26 | goLeft :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a) 27 | goLeft (Empty, ds) = (Empty, ds) 28 | goLeft (Node x l r, bs) = (l, LeftCrumb x r : bs) 29 | 30 | goRight :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a) 31 | goRight (Empty, ds) = (Empty, ds) 32 | goRight (Node x l r, bs) = (r, RightCrumb x l : bs) 33 | 34 | goUp :: (Tree a, Breadcrumbs a) -> (Tree a, Breadcrumbs a) 35 | goUp (t, []) = (t, []) 36 | goUp (t, LeftCrumb x r : bs) = (Node x t r, bs) 37 | goUp (t, RightCrumb x l : bs) = (Node x l t, bs) 38 | 39 | type Zipper a = (Tree a, Breadcrumbs a) 40 | 41 | modify :: (a -> a) -> Zipper a -> Zipper a 42 | modify f (Node x l r, bs) = (Node (f x) l r, bs) 43 | modify f (Empty, bs) = (Empty, bs) 44 | 45 | --newFocus = modify (\_ -> 'P') (goRight (goLeft (freeTree,[]))) 46 | newFocus = (freeTree,[]) -: goLeft -: goRight -: modify (\_ -> 'P') 47 | 48 | --newFocus2 = modify (\_ -> 'X') (goUp newFocus) 49 | newFocus2 = newFocus -: goUp -: modify (\_ -> 'X') 50 | 51 | attach :: Tree a -> Zipper a -> Zipper a 52 | attach t (_, bs) = (t, bs) 53 | 54 | farLeft = (freeTree,[]) -: goLeft -: goLeft -: goLeft -: goLeft 55 | newFocus3 = farLeft -: attach (Node 'Z' Empty Empty) 56 | 57 | topMost :: Zipper a -> Zipper a 58 | topMost (t, []) = (t, []) 59 | topMost z = topMost (goUp z) 60 | 61 | main _ = do 62 | println $ goLeft' (goRight' (freeTree, [])) 63 | println $ (freeTree, []) -: goRight' -: goLeft' 64 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter10/HeathrowToLondon.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter10.HeathrowToLondon where 2 | 3 | import frege.data.List ( !! ) 4 | 5 | data Section = Section 6 | { getA :: Int 7 | , getB :: Int 8 | , getC :: Int 9 | } 10 | derive Show Section 11 | 12 | type RoadSystem = [Section] 13 | 14 | heathrowToLondon :: RoadSystem 15 | heathrowToLondon = 16 | [ Section 50 10 30 17 | , Section 5 90 20 18 | , Section 40 2 25 19 | , Section 10 8 0 20 | ] 21 | 22 | data Label = A | B | C 23 | derive Show Label 24 | 25 | type Path = [(Label, Int)] 26 | 27 | roadStep :: (Path, Path) -> Section -> (Path, Path) 28 | roadStep (pathA, pathB) (Section a b c) = 29 | let priceA = sum $ map snd pathA 30 | priceB = sum $ map snd pathB 31 | forwardPriceToA = priceA + a 32 | clossPriceToA = priceB + b + c 33 | forwardPriceToB = priceB + b 34 | clossPriceToB = priceA + a + c 35 | newPathToA = 36 | if forwardPriceToA <= clossPriceToA 37 | then (A, a) : pathA 38 | else (C, c) : (B, b) : pathB 39 | newPathToB = 40 | if forwardPriceToB <= clossPriceToB 41 | then (B, b) : pathB 42 | else (C, c) : (A, a) : pathA 43 | in (newPathToA, newPathToB) 44 | 45 | optimalPath :: RoadSystem -> Path 46 | optimalPath roadSystem = 47 | let (bestAPath, bestBPath) = fold roadStep ([], []) roadSystem 48 | in if sum (map snd bestAPath) <= sum (map snd bestBPath) 49 | then reverse bestAPath 50 | else reverse bestBPath 51 | 52 | groupOf :: Int -> [a] -> [[a]] 53 | groupOf 0 _ = error "The first argument of 'groupOf' must be greater than 0." 54 | groupOf _ [] = [] 55 | groupOf n xs = take n xs : groupOf n (drop n xs) 56 | 57 | main _ = do 58 | contents <- getContents 59 | let threes = groupOf 3 . map atoi . lines $ contents 60 | roadSystem = map (\xs -> Section (xs !! 0) (xs !! 1) (xs !! 2)) threes 61 | path = optimalPath roadSystem 62 | pathString = concat $ map (show . fst) path 63 | pathPrice = sum $ map snd path 64 | putStrLn $ "The best path to take is: " ++ pathString 65 | putStrLn $ "The price is: " ++ show pathPrice 66 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter06/MapsAndFilters.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter06.MapsAndFilters where 2 | 3 | import frege.data.List 4 | 5 | myMap :: (a -> b) -> [a] -> [b] 6 | myMap _ [] = [] 7 | myMap f (x : xs) = f x : myMap f xs 8 | 9 | myFilter :: (a -> Bool) -> [a] -> [a] 10 | myFilter _ [] = [] 11 | myFilter p (x : xs) 12 | | p x = x : myFilter p xs 13 | | otherwise = myFilter p xs 14 | 15 | notNull :: [a] -> Bool 16 | notNull x = not (null x) 17 | 18 | quicksort :: (Ord a) => [a] -> [a] 19 | quicksort [] = [] 20 | quicksort (x:xs) = 21 | let smallerSorted = quicksort (filter (<= x) xs) 22 | biggerSorted = quicksort (filter (> x) xs) 23 | in smallerSorted ++ [x] ++ biggerSorted 24 | 25 | largestDivisible :: (Enum a, Integral a) => a 26 | largestDivisible = head (filter p (iterate pred 10000)) 27 | where p x = x `mod` 3829 == 0 28 | 29 | chain :: (Integral a) => a -> [a] 30 | chain 1 = [1] 31 | chain n 32 | | even n = n : chain (n `div` 2) 33 | | otherwise = n : chain (n * 3 + 1) 34 | 35 | numLongChains :: Int 36 | numLongChains = length (filter isLong (map chain [1..100])) 37 | where isLong xs = length xs > 15 38 | 39 | listOfFuns = map (*) [0..] 40 | 41 | main _ = do 42 | 43 | println $ map (+ 3) [ 1, 5, 3, 1, 6 ] 44 | println $ map (++ "!") [ "BIFF", "BANG", "POW" ] 45 | println $ map (replicate 3) [ 3 .. 6 ] 46 | println $ map (map (^ 2)) [ [ 1, 2 ], [ 3, 4, 5, 6 ], [ 7, 8 ] ] 47 | println $ map fst [ (1, 2), (3, 5), (6, 3), (2, 6), (2, 5) ] 48 | 49 | println $ filter (> 3) [ 1, 5, 3, 2, 1, 6, 4, 3, 2, 1 ] 50 | println $ filter (== 3) [ 1, 2, 3, 4, 5 ] 51 | println $ filter even [1 .. 10] 52 | println $ filter notNull [ [1,2,3], [], [3,4,5], [2,2], [], [], [] ] 53 | println $ filter (`elem` ['a'..'z']) 54 | "u LaUgH aT mE BeCaUsE I aM diFfeRent".toList 55 | println $ filter (`elem` ['A'..'Z']) 56 | "i lauGh At You BecAuse u r aLL the Same".toList 57 | 58 | println $ sum (takeWhile (< 10000) (filter odd (map (^ 2) [1..]))) 59 | println $ sum (takeWhile (< 10000) [ n ^ 2 | n <- [1..], odd (n ^ 2) ]) 60 | 61 | println $ chain 10 62 | println $ chain 1 63 | println $ chain 30 64 | 65 | println $ (listOfFuns !! 4) 5 66 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter09/HelloWorld.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter09.HelloWorld where 2 | 3 | import frege.data.Char ( toUpper ) 4 | 5 | reverseWords :: String -> String 6 | reverseWords = unwords . map (packed . reverse . unpacked) . words 7 | 8 | example1 :: IO () 9 | example1 = do 10 | putStrLn "What's your first name?" 11 | firstName <- getLine 12 | putStrLn "What's your last name?" 13 | lastName <- getLine 14 | let bigFirstName = packed . map toUpper . unpacked $ firstName 15 | bigLastName = packed . map toUpper . unpacked $ lastName 16 | putStrLn $ "hey " ++ bigFirstName ++ " " ++ bigLastName ++ ", how are you?" 17 | 18 | example2 :: IO () 19 | example2 = do 20 | line <- getLine 21 | if null line 22 | then return () 23 | else do 24 | putStrLn $ reverseWords line 25 | example2 26 | 27 | example3 :: IO () 28 | example3 = do 29 | let a = "hell" 30 | b = "year" 31 | putStrLn $ a ++ " " ++ b 32 | 33 | example4 :: IO () 34 | example4 = do 35 | c <- getChar 36 | if c != ' ' 37 | then do 38 | putChar c 39 | example4 40 | else return () 41 | 42 | example5 :: IO () 43 | example5 = do 44 | c <- getChar 45 | when (c != ' ') $ do 46 | putChar c 47 | example5 48 | 49 | example6 :: IO () 50 | example6 = do 51 | xs <- sequence [ getLine, getLine, getLine ] 52 | print xs 53 | 54 | example7 :: IO () 55 | example7 = forever $ do 56 | putStr "Give me some input: " 57 | l <- getLine 58 | putStrLn $ packed . map toUpper . unpacked $ l 59 | 60 | example8 :: IO [()] 61 | example8 = do 62 | colors <- forM [ 1, 2, 3, 4 ] $ \a -> do 63 | putStrLn $ "Which color do you associate with the number " ++ show a ++ "?" 64 | color <- getLine 65 | return "foo" 66 | putStrLn "The colors that you associate with 1, 2, 3 and 4 are: " 67 | mapM putStrLn colors 68 | 69 | main _ = do 70 | 71 | putStr "Hey, " 72 | putStr "I'm " 73 | putStrLn "Andy!" 74 | 75 | putChar 't' 76 | putChar 'e' 77 | putChar 'h' 78 | putChar '\n' 79 | 80 | println true 81 | println 2 82 | println "haha" 83 | println 3.2 84 | println [ 3, 4, 3 ] 85 | 86 | sequence $ map println [ 1, 2, 3, 4, 5 ] 87 | 88 | mapM println [ 1, 2, 3 ] 89 | mapM_ println [ 1, 2, 3 ] 90 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter12/WalkTheLine.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter12.WalkTheLine where 2 | 3 | type Birds = Int 4 | type Pole = (Birds, Birds) 5 | 6 | landLeft' :: Birds -> Pole -> Pole 7 | landLeft' n (left, right) = (left + n, right) 8 | 9 | landRight' :: Birds -> Pole -> Pole 10 | landRight' n (left, right) = (left, right + n) 11 | 12 | infixl 5 `-:` 13 | (-:) :: a -> (a -> b) -> b 14 | x -: f = f x 15 | 16 | landLeft :: Birds -> Pole -> Maybe Pole 17 | landLeft n (left, right) 18 | | abs ((left + n) - right) < 4 = Just (left + n, right) 19 | | otherwise = Nothing 20 | 21 | landRight :: Birds -> Pole -> Maybe Pole 22 | landRight n (left, right) 23 | | abs (left - (right + n)) < 4 = Just (left, right + n) 24 | | otherwise = Nothing 25 | 26 | banana :: Pole -> Maybe Pole 27 | banana _ = Nothing 28 | 29 | routine :: Maybe Pole 30 | routine = 31 | case landLeft 1 (0, 0) of 32 | Nothing -> Nothing 33 | Just pole1 -> 34 | case landRight 4 pole1 of 35 | Nothing -> Nothing 36 | Just pole2 -> 37 | case landLeft 2 pole2 of 38 | Nothing -> Nothing 39 | Just pole3 -> landLeft 1 pole3 40 | 41 | main _ = do 42 | 43 | println $ landLeft' 2 (0, 0) 44 | println $ landRight' 1 (1, 2) 45 | println $ landRight' (-1) (1, 2) 46 | 47 | println $ landLeft' 2 (landRight' 1 (landLeft' 1 (0, 0))) 48 | 49 | println $ 100 -: (* 3) 50 | println $ true -: not 51 | println $ (0, 0) -: landLeft' 2 52 | 53 | println $ (0, 0) -: landLeft' 1 -: landRight' 1 -: landLeft' 2 54 | 55 | println $ landLeft' 10 (0, 3) 56 | println $ (0,0) -: landLeft' 1 -: landRight' 4 -: landLeft' (-1) -: landRight' (-2) 57 | 58 | println $ landLeft 2 (0, 0) 59 | println $ landLeft 10 (0, 3) 60 | 61 | println $ landRight 1 (0, 0) >>= landLeft 2 62 | println $ Nothing >>= landLeft 2 63 | println $ return (0, 0) >>= landRight 2 >>= landLeft 2 >>= landRight 2 64 | 65 | println $ return (0, 0) >>= landLeft 1 >>= landRight 4 >>= landLeft (-1) >>= landRight (-2) 66 | 67 | println $ return (0, 0) >>= landLeft 1 >>= banana >>= landRight 1 68 | 69 | println $ Nothing >> Just 3 70 | println $ Just 3 >> Just 4 71 | println $ Just 3 >> (Nothing :: Maybe Int) 72 | 73 | println $ return (0, 0) >>= landLeft 1 >> Nothing >>= landRight 1 74 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter09/Randomness.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter09.Randomness where 2 | 3 | import frege.system.Random 4 | 5 | threeCoins :: StdGen -> (Bool, Bool, Bool) 6 | threeCoins gen = 7 | let (firstCoin, newGen) = random gen 8 | (secondCoin, newGen') = random newGen 9 | (thirdCoin, newGen'') = random newGen' 10 | in (firstCoin, secondCoin, thirdCoin) 11 | 12 | finiteRandoms :: (Random r, RandomGen g) => Int -> g -> ([r], g) 13 | finiteRandoms 0 gen = ([], gen) 14 | finiteRandoms n gen = 15 | let (value, newGen) = random gen 16 | (restOfList, finalGen) = finiteRandoms (n - 1) newGen 17 | in (value : restOfList, finalGen) 18 | 19 | askForNumber :: StdGen -> IO () 20 | askForNumber gen = do 21 | let (randNumber, newGen) = randomR (1, 10) gen :: (Int, StdGen) 22 | print "Which number in the range from 1 to 10 am I thinking of? " 23 | numberString <- getLine 24 | when (not $ null numberString) $ do 25 | let number = atoi numberString 26 | if randNumber == number 27 | then println "You are correct!" 28 | else println $ "Sorry, it was " ++ show randNumber 29 | askForNumber newGen 30 | 31 | main _ = do 32 | 33 | -- StdGen is not an instance of Show in Frege 34 | println $ fst (random (mkStdGen 100) :: (Int, StdGen)) 35 | println $ fst (random (mkStdGen 100) :: (Int, StdGen)) 36 | println $ fst (random (mkStdGen 949494) :: (Int, StdGen)) 37 | 38 | println $ fst (random (mkStdGen 949488) :: (Float, StdGen)) 39 | println $ fst (random (mkStdGen 949488) :: (Bool, StdGen)) 40 | println $ fst (random (mkStdGen 949488) :: (Integer, StdGen)) 41 | 42 | println $ threeCoins (mkStdGen 21) 43 | println $ threeCoins (mkStdGen 22) 44 | println $ threeCoins (mkStdGen 943) 45 | println $ threeCoins (mkStdGen 944) 46 | 47 | println $ take 5 (randoms (mkStdGen 11) :: [Int]) 48 | println $ take 5 (randoms (mkStdGen 11) :: [Bool]) 49 | println $ take 5 (randoms (mkStdGen 11) :: [Float]) 50 | 51 | println $ fst $ randomR (1, 6) (mkStdGen 359353) 52 | println $ fst $ randomR (1, 6) (mkStdGen 35935335) 53 | 54 | -- Char is not an instance of Random.Random 55 | println $ packed $ take 10 $ map chr $ randomRs (97, 122) (mkStdGen 3) 56 | 57 | -- In Frege, getStdGen returns different values on each invocations 58 | gen <- getStdGen 59 | println $ packed $ take 20 $ map chr $ randomRs (97, 122) gen 60 | gen2 <- getStdGen 61 | println $ packed $ take 20 $ map chr $ randomRs (97, 122) gen2 62 | gen3 <- getStdGen 63 | println $ packed $ take 20 $ map chr $ randomRs (97, 122) gen3 64 | -------------------------------------------------------------------------------- /gradlew.bat: -------------------------------------------------------------------------------- 1 | @if "%DEBUG%" == "" @echo off 2 | @rem ########################################################################## 3 | @rem 4 | @rem Gradle startup script for Windows 5 | @rem 6 | @rem ########################################################################## 7 | 8 | @rem Set local scope for the variables with windows NT shell 9 | if "%OS%"=="Windows_NT" setlocal 10 | 11 | @rem Add default JVM options here. You can also use JAVA_OPTS and GRADLE_OPTS to pass JVM options to this script. 12 | set DEFAULT_JVM_OPTS= 13 | 14 | set DIRNAME=%~dp0 15 | if "%DIRNAME%" == "" set DIRNAME=. 16 | set APP_BASE_NAME=%~n0 17 | set APP_HOME=%DIRNAME% 18 | 19 | @rem Find java.exe 20 | if defined JAVA_HOME goto findJavaFromJavaHome 21 | 22 | set JAVA_EXE=java.exe 23 | %JAVA_EXE% -version >NUL 2>&1 24 | if "%ERRORLEVEL%" == "0" goto init 25 | 26 | echo. 27 | echo ERROR: JAVA_HOME is not set and no 'java' command could be found in your PATH. 28 | echo. 29 | echo Please set the JAVA_HOME variable in your environment to match the 30 | echo location of your Java installation. 31 | 32 | goto fail 33 | 34 | :findJavaFromJavaHome 35 | set JAVA_HOME=%JAVA_HOME:"=% 36 | set JAVA_EXE=%JAVA_HOME%/bin/java.exe 37 | 38 | if exist "%JAVA_EXE%" goto init 39 | 40 | echo. 41 | echo ERROR: JAVA_HOME is set to an invalid directory: %JAVA_HOME% 42 | echo. 43 | echo Please set the JAVA_HOME variable in your environment to match the 44 | echo location of your Java installation. 45 | 46 | goto fail 47 | 48 | :init 49 | @rem Get command-line arguments, handling Windowz variants 50 | 51 | if not "%OS%" == "Windows_NT" goto win9xME_args 52 | if "%@eval[2+2]" == "4" goto 4NT_args 53 | 54 | :win9xME_args 55 | @rem Slurp the command line arguments. 56 | set CMD_LINE_ARGS= 57 | set _SKIP=2 58 | 59 | :win9xME_args_slurp 60 | if "x%~1" == "x" goto execute 61 | 62 | set CMD_LINE_ARGS=%* 63 | goto execute 64 | 65 | :4NT_args 66 | @rem Get arguments from the 4NT Shell from JP Software 67 | set CMD_LINE_ARGS=%$ 68 | 69 | :execute 70 | @rem Setup the command line 71 | 72 | set CLASSPATH=%APP_HOME%\gradle\wrapper\gradle-wrapper.jar 73 | 74 | @rem Execute Gradle 75 | "%JAVA_EXE%" %DEFAULT_JVM_OPTS% %JAVA_OPTS% %GRADLE_OPTS% "-Dorg.gradle.appname=%APP_BASE_NAME%" -classpath "%CLASSPATH%" org.gradle.wrapper.GradleWrapperMain %CMD_LINE_ARGS% 76 | 77 | :end 78 | @rem End local scope for the variables with windows NT shell 79 | if "%ERRORLEVEL%"=="0" goto mainEnd 80 | 81 | :fail 82 | rem Set variable GRADLE_EXIT_CONSOLE if you need the _script_ return code instead of 83 | rem the _cmd.exe /c_ return code! 84 | if not "" == "%GRADLE_EXIT_CONSOLE%" exit 1 85 | exit /b 1 86 | 87 | :mainEnd 88 | if "%OS%"=="Windows_NT" endlocal 89 | 90 | :omega 91 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter11/ApplicativeFunctors.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter11.ApplicativeFunctors where 2 | 3 | import frege.data.Traversable ( sequenceA ) 4 | import frege.data.wrapper.ZipList ( ZipList ) 5 | 6 | example1 :: IO () 7 | example1 = do 8 | a <- (++) <$> getLine <*> getLine 9 | putStrLn $ "The two lines concatenated turn out to be: " ++ a 10 | 11 | example2 :: IO [String] 12 | example2 = sequenceA [ getLine, getLine, getLine ] 13 | 14 | main _ = do 15 | 16 | -- println $ Just (+ 3) <*> Just 9 --> compilation warning. use <$> 17 | println $ pure (+ 3) <*> Just 10 18 | println $ pure (+ 3) <*> Just 9 19 | -- println $ Just (++ "hahah") <*> Nothing --> ditto. 20 | println $ (Nothing :: Maybe (String -> String)) <*> Just "woot" 21 | 22 | println $ pure (+) <*> Just 3 <*> Just 5 23 | println $ pure (+) <*> Just 3 <*> Nothing 24 | println $ pure (+) <*> Nothing <*> Just 5 25 | 26 | println $ (++) <$> Just "johntra" <*> Just "volta" 27 | 28 | println $ (pure "Hey" :: [String]) 29 | println $ (pure "Hey" :: Maybe String) 30 | 31 | println $ [ (* 0), (+ 100), (^ 2) ] <*> [ 1, 2, 3 ] 32 | println $ [ (+), (*) ] <*> [ 1, 2 ] <*> [ 3, 4 ] 33 | println $ (++) <$> [ "ha", "heh", "hmm" ] <*> [ "?", "!", "." ] 34 | 35 | println $ [ x * y | x <- [ 2, 5, 10 ], y <- [ 8, 10, 11 ] ] 36 | println $ (*) <$> [ 2, 5, 10 ] <*> [ 8, 10, 11 ] 37 | println $ filter (> 50) $ (*) <$> [ 2, 5, 10 ] <*> [ 8, 10, 11 ] 38 | 39 | println $ pure 3 "blah" 40 | println $ (+) <$> (+ 3) <*> (* 100) $ 5 41 | println $ (\x \y \z -> [ x, y, z ]) <$> (+ 3) <*> (* 2) <*> (/ 2) $ 5 42 | 43 | println $ toList $ (+) <$> ZipList [ 1, 2, 3 ] <*> ZipList [ 100, 100, 100 ] 44 | println $ toList $ (+) <$> ZipList [ 1, 2, 3 ] <*> ZipList [ 100, 100 .. ] 45 | println $ toList $ max <$> ZipList [ 1, 2, 3, 4, 5, 3 ] <*> ZipList [ 5, 3, 1, 2 ] 46 | println $ toList $ (,,) <$> ZipList "dog".toList <*> ZipList "cat".toList <*> ZipList "rat".toList 47 | 48 | println $ liftA2 (:) (Just 3) (Just [4]) 49 | println $ (:) <$> Just 3 <*> Just [4] 50 | 51 | println $ sequenceA [Just 3, Just 2, Just 1] 52 | println $ sequenceA [Just 3, Nothing, Just 1] 53 | println $ sequenceA [(+ 3), (+ 2), (+ 1)] 3 54 | println $ sequenceA [ [ 1, 2, 3 ], [ 4, 5, 6 ] ] 55 | println $ sequenceA [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 3, 4, 4 ], [] ] 56 | 57 | println $ sequenceA [ (> 4), (< 10), odd ] 7 58 | println $ and $ sequenceA [ (> 4), (< 10), odd ] 7 59 | 60 | println $ sequenceA [ [ 1, 2, 3 ], [ 4, 5, 6 ] ] 61 | println $ [ [ x, y ] | x <- [ 1, 2, 3 ], y <- [ 4, 5, 6 ] ] 62 | println $ sequenceA [ [ 1, 2 ], [ 3, 4 ] ] 63 | println $ [ [ x, y ] | x <- [ 1, 2 ], y <- [ 3, 4 ] ] 64 | println $ sequenceA [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ] 65 | println $ [ [ x, y, z ] | x <- [ 1, 2 ], y <- [ 3, 4 ], z <- [ 5, 6 ] ] 66 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter14/AVerySimpleFileSystem.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter14.AVerySimpleFileSystem where 2 | 3 | type Name = String 4 | type Data = String 5 | 6 | data FSItem = 7 | File Name Data 8 | | Folder Name [FSItem] 9 | derive Show FSItem 10 | 11 | myDisk :: FSItem 12 | myDisk = 13 | Folder "root" 14 | [ File "goat_yelling_like_man.wmv" "baaaaaa" 15 | , File "pope_time.avi" "god bless" 16 | , Folder "pics" 17 | [ File "ape_throwing_up.jpg" "bleargh" 18 | , File "watermelon_smash.gif" "smash!!" 19 | , File "skull_man(scary).bmp" "Yikes!" 20 | ] 21 | , File "dijon_poupon.doc" "best mustard" 22 | , Folder "programs" 23 | [ File "fartwizard.exe" "10gotofart" 24 | , File "owl_bandit.dmg" "mov eax, h00t" 25 | , File "not_a_virus.exe" "really not a virus" 26 | , Folder "source code" 27 | [ File "best_hs_prog.hs" "main = print (fix error)" 28 | , File "random.hs" "main = print 4" 29 | ] 30 | ] 31 | ] 32 | 33 | data FSCrumb = FSCrumb Name [FSItem] [FSItem] 34 | derive Show FSCrumb 35 | 36 | type FSZipper = (FSItem, [FSCrumb]) 37 | 38 | fsUp :: FSZipper -> FSZipper 39 | fsUp (item, []) = error "you are on the top of tree." 40 | fsUp (item, FSCrumb name ls rs : bs) = (Folder name (ls ++ [item] ++ rs), bs) 41 | 42 | fsTo :: Name -> FSZipper -> FSZipper 43 | fsTo name (File _ _, _) = error "now your focus is a file" 44 | fsTo name (Folder folderName items, bs) = 45 | let (ls, rs) = break (nameIs name) items 46 | in case rs of 47 | [] -> error "no such file or folder." 48 | item : rs'-> (item, FSCrumb folderName ls rs' : bs) 49 | 50 | nameIs :: Name -> FSItem -> Bool 51 | nameIs name (Folder folderName _) = name == folderName 52 | nameIs name (File fileName _) = name == fileName 53 | 54 | fsRename :: Name -> FSZipper -> FSZipper 55 | fsRename newName (Folder name items, bs) = (Folder newName items, bs) 56 | fsRename newName (File name dat, bs) = (File newName dat, bs) 57 | 58 | fsNewFile :: FSItem -> FSZipper -> FSZipper 59 | fsNewFile _ (File _ _, _) = error "you are on the top of tree." 60 | fsNewFile item (Folder folderName items, bs) = 61 | (Folder folderName (item : items), bs) 62 | 63 | infixl 7 `-:` 64 | (-:) :: a -> (a -> b) -> b 65 | x -: f = f x 66 | 67 | main _ = do 68 | 69 | let newFocus = (myDisk, []) -: fsTo "pics" -: fsTo "skull_man(scary).bmp" 70 | println $ fst newFocus 71 | 72 | let newFocus2 = newFocus -: fsUp -: fsTo "watermelon_smash.gif" 73 | println $ fst newFocus2 74 | 75 | let newFocus3 = (myDisk, []) -: fsTo "pics" -: fsRename "cspi" -: fsUp 76 | println $ fst newFocus3 77 | 78 | let newFocus4 = (myDisk, []) -: fsTo "pics" -: fsNewFile (File "heh.jpg" "lol") -: fsUp 79 | println $ fst newFocus4 80 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/DataSet.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.DataSet where 2 | 3 | import frege.Prelude hiding ( map, filter ) 4 | import frege.data.HashMap as HM () 5 | import frege.data.List ( nub ) 6 | 7 | type Set a = HM.HashMap a () 8 | 9 | map' :: (a -> b) -> [a] -> [b] 10 | map' _ [] = [] 11 | map' f (x : xs) = f x : map' f xs 12 | 13 | fromList :: (Eq a) => [a] -> Set a 14 | fromList = HM.fromList . map' (\x -> (x, ())) 15 | 16 | intersection :: (Eq a) => Set a -> Set a -> Set a 17 | intersection = HM.intersection 18 | 19 | difference :: (Eq a) => Set a -> Set a -> Set a 20 | difference = HM.difference 21 | 22 | union :: (Eq a) => Set a -> Set a -> Set a 23 | union = HM.union 24 | 25 | size :: Set a -> Int 26 | size = HM.size 27 | 28 | singleton :: (Eq a) => a -> Set a 29 | singleton x = HM.singleton x () 30 | 31 | insert :: (Eq a) => a -> Set a -> Set a 32 | insert x = HM.insert x () 33 | 34 | delete :: (Eq a) => a -> Set a -> Set a 35 | delete x = HM.delete x 36 | 37 | map :: (Eq a, Eq b) => (a -> b) -> Set a -> Set b 38 | map f = fromList . map' f . map' fst . HM.each 39 | 40 | filter :: (a -> Bool) -> Set a -> Set a 41 | filter f = HM.filterWithKey (\x \_ -> f x) 42 | 43 | each :: Set a -> [a] 44 | each = map' fst . HM.each 45 | 46 | isSubsetOf :: (Eq a) => Set a -> Set a -> Bool 47 | isSubsetOf xs ys = and $ map' (`elem` (each ys)) $ each xs 48 | 49 | isProperSubsetOf :: (Eq a) => Set a -> Set a -> Bool 50 | isProperSubsetOf xs ys = xs `isSubsetOf` ys && size xs < size ys 51 | 52 | setNub :: (Eq a) => [a] -> [a] 53 | setNub xs = each $ fromList xs 54 | 55 | text1 = "I just had an anime dream. Anime... Reality... Are they so different?" 56 | text2 = "The old man left his garbage can out and now his trash is all over my lawn!" 57 | 58 | set1 = fromList . unpacked $ text1 59 | set2 = fromList . unpacked $ text2 60 | 61 | main _ = do 62 | 63 | println $ set1 64 | println $ set2 65 | 66 | println $ intersection set1 set2 67 | 68 | println $ difference set1 set2 69 | println $ difference set2 set1 70 | 71 | println $ union set1 set2 72 | 73 | println $ null (empty :: Set Int) 74 | println $ null $ fromList [ 3, 4, 5, 5, 4, 3 ] 75 | println $ size $ fromList [ 3, 4, 5, 5, 4, 3 ] 76 | println $ singleton 9 77 | println $ insert 4 $ fromList [ 9, 3, 8, 1 ] 78 | println $ insert 8 $ fromList [ 5 .. 10 ] 79 | println $ delete 4 $ fromList [ 3, 4, 5, 4, 3, 4, 5 ] 80 | 81 | println $ fromList [ 2, 3, 4 ] `isSubsetOf` fromList [ 1, 2, 3, 4, 5 ] 82 | println $ fromList [ 1, 2, 3, 4, 5 ] `isSubsetOf` fromList [ 1, 2, 3, 4, 5 ] 83 | println $ fromList [ 1, 2, 3, 4, 5 ] `isProperSubsetOf` fromList [ 1, 2, 3, 4, 5 ] 84 | println $ fromList [ 2, 3, 4, 8 ] `isSubsetOf` fromList [ 1, 2, 3, 4, 5 ] 85 | 86 | println $ filter odd $ fromList [ 3, 4, 5, 6, 7, 2, 3, 4 ] 87 | println $ map (+ 1) $ fromList [ 3, 4, 5, 6, 7, 2, 3, 4 ] 88 | 89 | println $ setNub $ "HEY WHATS CRACKALACKIN".toList 90 | println $ nub $ "HEY WHATS CRACKALACKIN".toList 91 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter09/FilesAndStreams.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter09.FilesAndStreams where 2 | 3 | import frege.data.Char ( toUpper ) 4 | import frege.data.List ( delete, !! ) 5 | import frege.java.Util ( Scanner ) 6 | 7 | example1 :: IO () 8 | example1 = do 9 | contents <- getContents 10 | putStrLn $ packed . map toUpper . unpacked $ contents 11 | 12 | shortLinesOnly :: String -> String 13 | shortLinesOnly input = 14 | let allLines = lines input 15 | shortLines = filter (\line -> length line < 10) allLines 16 | result = unlines shortLines 17 | in result 18 | 19 | example2 :: IO () 20 | example2 = do 21 | contents <- getContents 22 | putStrLn (shortLinesOnly contents) 23 | 24 | example3 :: IO () 25 | example3 = interact $ unlines . filter ((< 10) . length) . lines 26 | 27 | respondPalindromes = unlines . map tellPalindrome . lines 28 | where tellPalindrome xs = if isPalindrome xs then "palindrome" else "not a palindrome" 29 | isPalindrome xs = xs == (packed . reverse . unpacked) xs 30 | 31 | example4 :: IO () 32 | example4 = interact respondPalindromes 33 | 34 | example5 :: IO () 35 | example5 = do 36 | sc <- File.new "girlfriend.txt" >>= Scanner.new 37 | contents <- sc.useDelimiter ´\uEdda$´ >>= Scanner.next 38 | println contents 39 | sc.close 40 | 41 | example6 :: IO () 42 | example6 = do 43 | contents <- readFile "girlfriend.txt" 44 | println contents 45 | 46 | example7 :: IO () 47 | example7 = do 48 | contents <- readFile "girlfriend.txt" 49 | writeFile "girlfriendcaps.txt" $ packed . map toUpper . unpacked $ contents 50 | 51 | example8 :: IO () 52 | example8 = do 53 | todoItem <- getLine 54 | appendFile "todo.txt" (todoItem ++ "\n") 55 | 56 | -- BufferedReader with a buffer size 57 | data SizedBufferedReader = mutable native java.io.BufferedReader where 58 | native new :: Reader -> Int -> IO BufferedReader 59 | 60 | getLines :: SizedBufferedReader -> IO [String] 61 | getLines br = go [] where 62 | go acc = do 63 | xms <- br.readLine 64 | case xms of 65 | Just s -> go (s : acc) 66 | _ -> br.close >> return (reverse acc) 67 | 68 | example9 :: IO () 69 | example9 = do 70 | fis <- FileInputStream.new "girlfriend.txt" 71 | isr <- InputStreamReader.new fis "UTF-8" 72 | sbr <- SizedBufferedReader.new isr 2048 73 | sbr.getLines >>= mapM_ println 74 | 75 | main _ = do 76 | 77 | contents <- readFile "todo.txt" 78 | let todoTasks = lines contents 79 | numberedTasks = zipWith (\n \line -> show n ++ " - " ++ line) [0..] todoTasks 80 | 81 | println "These are your TO-DO items:" 82 | println $ unlines numberedTasks 83 | println "Which one do you want to delete?" 84 | 85 | numberString <- getLine 86 | let number = atoi numberString 87 | newTodoTasks = delete (todoTasks !! number) todoTasks 88 | 89 | tempName <- File.createTempFile "temp" "" >>= (\f -> f.getName) 90 | writeFile tempName $ unlines newTodoTasks 91 | 92 | old <- File.new tempName 93 | new <- File.new "todo.txt" 94 | old.renameTo new >> return () 95 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/DataMap.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.DataMap where 2 | 3 | import frege.data.Char ( isUpper ) 4 | import frege.data.HashMap as HM () 5 | 6 | phoneBook1 = 7 | [ ("betty", "555-2938") 8 | , ("bonnie", "452-2928") 9 | , ("patsy", "493-2928") 10 | , ("lucille", "205-2928") 11 | , ("wendy", "939-8282") 12 | , ("penny", "853-2492") 13 | ] 14 | 15 | findKey :: (Eq k) => k -> [(k,v)] -> Maybe v 16 | --findKey key [] = Nothing 17 | --findKey key ((k,v):xs) = if key == k then Just v else findKey key xs 18 | findKey key = foldr (\(k, v) \acc -> if key == k then Just v else acc) Nothing 19 | 20 | fromList' :: (Ord k) => [(k, v)] -> HM.HashMap k v 21 | fromList' = foldr (\(k, v) \acc -> HM.insert k v acc) empty 22 | 23 | phoneBook2 = 24 | [ ("betty", "555-2938") 25 | , ("betty", "342-2492") 26 | , ("bonnie", "452-2928") 27 | , ("patsy", "493-2928") 28 | , ("patsy", "943-2929") 29 | , ("patsy", "827-9162") 30 | , ("lucille", "205-2928") 31 | , ("wendy", "939-8282") 32 | , ("penny", "853-2492") 33 | , ("penny", "555-2111") 34 | ] 35 | 36 | phoneBookToMap :: (Ord k) => [(k, String)] -> HM.HashMap k String 37 | phoneBookToMap xs = 38 | HM.fromListWith (\number1 \number2 -> number1 ++ ", " ++ number2) xs 39 | 40 | phoneBookToMap' :: (Ord k) => [(k, a)] -> HM.HashMap k [a] 41 | phoneBookToMap' xs = 42 | HM.fromListWith (++) $ map (\(k, v) -> (k, [v])) xs 43 | 44 | main _ = do 45 | 46 | println $ findKey "penny" phoneBook1 47 | println $ findKey "betty" phoneBook1 48 | println $ findKey "wilma" phoneBook1 49 | 50 | println $ HM.fromList $ 51 | [ ("betty", "555-2938"), ("bonnie", "452-2928"), ("lucille", "205-2928") ] 52 | println $ HM.fromList [ (1, 2), (3, 4), (3, 2), (5, 5) ] 53 | 54 | println $ (empty :: HM.HashMap Int Int) 55 | 56 | println $ HM.insert 5 600 (HM.insert 4 200 (HM.insert 3 100 empty)) 57 | println $ HM.insert 5 600 . HM.insert 4 200 . HM.insert 3 100 $ empty 58 | 59 | println $ null (empty :: HM.HashMap Int Int) 60 | println $ null $ HM.fromList [ (2, 3), (5, 5) ] 61 | 62 | println $ HM.size empty 63 | println $ HM.size $ HM.fromList [ (2, 4), (3, 3), (4, 2), (5, 4), (6, 4) ] 64 | 65 | println $ HM.singleton 3 9 66 | println $ HM.insert 5 9 $ HM.singleton 3 9 67 | 68 | println $ HM.member 3 $ HM.fromList [ (3, 6), (4, 3), (6, 9) ] 69 | println $ HM.member 3 $ HM.fromList [ (2, 5), (4, 5) ] 70 | 71 | println $ HM.mapValues (* 100) $ HM.fromList [ (1, 1), (2, 4), (3, 9) ] 72 | println $ HM.filterValues isUpper $ 73 | HM.fromList [ (1, 'a'), (2, 'A'), (3, 'b'), (4, 'B') ] 74 | 75 | println $ HM.each . HM.insert 9 2 $ HM.singleton 4 3 76 | 77 | println $ HM.lookup "patsy" $ phoneBookToMap phoneBook2 78 | println $ HM.lookup "wendy" $ phoneBookToMap phoneBook2 79 | println $ HM.lookup "betty" $ phoneBookToMap phoneBook2 80 | 81 | println $ HM.lookup "patsy" $ phoneBookToMap' phoneBook2 82 | 83 | println $ HM.fromListWith max $ 84 | [ (2, 3), (2, 5), (2, 100), (3, 29), (3, 22), (3, 11), (4, 22), (4, 15) ] 85 | println $ HM.fromListWith (+) $ 86 | [ (2, 3), (2, 5), (2, 100), (3, 29), (3, 22), (3, 11), (4, 22), (4, 15) ] 87 | 88 | println $ HM.insertWith (+) 3 100 $ HM.fromList [ (3, 4), (5, 103), (6, 339) ] 89 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter13/SomeUsefulMonadicFunctions.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter13.SomeUsefulMonadicFunctions where 2 | 3 | import frege.control.monad.State 4 | import frege.data.List 5 | import learnyou.chapter12.TheListMonad ( KnightPos, moveKnight ) 6 | import learnyou.chapter13.TastefulStatefulComputations ( pop, push ) 7 | import learnyou.chapter13.WriterIHardlyKnowHer ( MyWriter, tell ) 8 | 9 | joinedMaybes :: Maybe Int 10 | joinedMaybes = do 11 | m <- Just (Just 8) 12 | m 13 | 14 | keepSmall :: Int -> MyWriter [String] Bool 15 | keepSmall x 16 | | x < 4 = do 17 | tell ["Keeping " ++ show x] 18 | return true 19 | | otherwise = do 20 | tell [show x ++ " is too large, throwing it away"] 21 | return false 22 | 23 | powerset :: [a] -> [[a]] 24 | powerset xs = filterM (\x -> [true, false]) xs 25 | 26 | binSmalls :: Int -> Int -> Maybe Int 27 | binSmalls acc x 28 | | x > 9 = Nothing 29 | | otherwise = Just (acc + x) 30 | 31 | readMaybe :: String -> Maybe Double 32 | readMaybe st = 33 | case st.double of 34 | Right x -> Just x 35 | Left _ -> Nothing 36 | 37 | foldingFunction :: [Double] -> String -> Maybe [Double] 38 | foldingFunction (x : y : ys) "*" = return ((y * x) : ys) 39 | foldingFunction (x : y : ys) "+" = return ((y + x) : ys) 40 | foldingFunction (x : y : ys) "+" = return ((y - x) : ys) 41 | foldingFunction xs numberString = liftM (: xs) (readMaybe numberString) 42 | 43 | solveRPN :: String -> Maybe Double 44 | solveRPN st = do 45 | [result] <- foldM foldingFunction [] (words st) 46 | return result 47 | 48 | inMany :: Int -> KnightPos -> [KnightPos] 49 | inMany x start = return start >>= fold (<=<) return (replicate x moveKnight) 50 | 51 | canReachIn :: Int -> KnightPos -> KnightPos -> Bool 52 | canReachIn x start end = end `elem` inMany x start 53 | 54 | main _ = do 55 | 56 | println $ liftM (* 3) (Just 8) 57 | println $ fmap (* 3) (Just 8) 58 | println $ (liftM not $ MyWriter (true, "chickpeas") :: MyWriter String Bool).runWriter 59 | println $ (fmap not $ MyWriter (true, "chickpeas") :: MyWriter String Bool).runWriter 60 | println $ (liftM (+ 100) pop).run [ 1, 2, 3, 4 ] 61 | println $ (fmap (+ 100) pop).run [ 1, 2, 3, 4 ] 62 | 63 | println $ Just (+ 3) <*> Just 4 64 | println $ Just (+ 3) `ap` Just 4 65 | println $ [ (+ 1), (+ 2), (+ 3) ] <*> [ 10, 11 ] 66 | println $ [ (+ 1), (+ 2), (+ 3) ] `ap` [ 10, 11 ] 67 | 68 | println $ join (Just (Just 9)) 69 | println $ (join (Just Nothing) :: Maybe Int) 70 | println $ (join Nothing :: Maybe Int) 71 | 72 | println $ join [ [ 1, 2, 3 ], [ 4, 5, 6 ] ] 73 | println $ (join $ MyWriter (MyWriter (1, "aaa"), "bbb") :: MyWriter String Int).runWriter 74 | 75 | println (join (Right (Right 9)) :: Either String Int) 76 | println (join (Right (Left "error")) :: Either String Int) 77 | println (join (Left "error") :: Either String Int) 78 | 79 | let nestedState = State.get >>= (\s -> State.put (1 : 2 : s)) >> return (push 10) 80 | println $ (join nestedState).run [ 0, 0, 0 ] 81 | 82 | println $ fst (filterM keepSmall [ 9, 1, 5, 2, 10, 3 ]).runWriter 83 | 84 | mapM_ putStrLn $ snd (filterM keepSmall [ 9, 1, 5, 2, 10, 3 ]).runWriter 85 | 86 | println $ powerset [ 1, 2, 3 ] 87 | 88 | println $ foldM binSmalls 0 [ 2, 8, 3, 1 ] 89 | println $ foldM binSmalls 0 [ 2, 11, 3, 1 ] 90 | 91 | println $ readMaybe "1" 92 | println $ readMaybe "GO TO HELL" 93 | 94 | println $ foldingFunction [3, 2] "*" 95 | println $ foldingFunction [3, 2] "-" 96 | println $ foldingFunction [] "*" 97 | println $ foldingFunction [] "1" 98 | println $ foldingFunction [] "1 wawawawa" 99 | 100 | println $ solveRPN "1 2 * 4 +" 101 | println $ solveRPN "1 2 * 4 + 5 *" 102 | println $ solveRPN "1 2 * 4" 103 | println $ solveRPN "1 8 wharglbllargh" 104 | 105 | let f = (+ 1) . (* 100) 106 | println $ f 4 107 | let g = (\x -> return (x + 1)) <=< (\x -> return (x * 100)) 108 | println $ Just 4 >>= g 109 | 110 | let f = foldr (.) id [ (+ 1), (* 100), (+ 1) ] 111 | println $ f 1 112 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter11/Monoids.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter11.Monoids where 2 | 3 | import frege.data.Foldable as F () 4 | import frege.data.Monoid 5 | import frege.data.wrapper.Boolean 6 | import frege.data.wrapper.Num 7 | 8 | import learnyou.chapter08.RecursiveDataStructures ( Tree ) 9 | 10 | lengthCompare1 :: String -> String -> Ordering 11 | lengthCompare1 x y = 12 | (length x `compare` length y) `mappend` 13 | (x `compare` y) 14 | 15 | lengthCompare2 :: String -> String -> Ordering 16 | lengthCompare2 x y = 17 | (length x `compare` length y) `mappend` 18 | (vowels x `compare` vowels y) `mappend` 19 | (x `compare` y) 20 | where vowels = length . filter (`elem` "aeiou".toList) . unpacked 21 | 22 | instance Functor Tree where 23 | fmap _ EmptyTree = EmptyTree 24 | fmap f (Node x l r) = Node (f x) (fmap f l) (fmap f r) 25 | 26 | instance F.Foldable Tree where 27 | foldMap f EmptyTree = mempty 28 | foldMap f (Node x l r) = 29 | F.foldMap f l `mappend` f x `mappend` F.foldMap f r 30 | 31 | testTree :: Tree Int 32 | testTree = 33 | Node 5 34 | (Node 3 35 | (Node 1 EmptyTree EmptyTree) 36 | (Node 6 EmptyTree EmptyTree) 37 | ) 38 | (Node 9 39 | (Node 8 EmptyTree EmptyTree) 40 | (Node 10 EmptyTree EmptyTree) 41 | ) 42 | 43 | main _ = do 44 | 45 | println $ [ 1, 2, 3 ] `mappend` [ 4, 5, 6 ] 46 | println $ ("one" `mappend` "two") `mappend` "three" 47 | println $ "one" `mappend` ("two" `mappend` "three") 48 | println $ "one" `mappend` "two" `mappend` "tree" 49 | println $ "pang" `mappend` mempty 50 | println $ mconcat [ [ 1, 2 ], [ 3, 6 ], [ 9 ] ] 51 | println $ (mempty :: [Int]) 52 | 53 | println $ "one" `mappend` "two" 54 | println $ "two" `mappend` "one" 55 | 56 | println $ getProduct $ Product 3 `mappend` Product 9 57 | println $ getProduct $ Product 3 `mappend` mempty 58 | println $ getProduct $ Product 3 `mappend` Product 4 `mappend` Product 2 59 | println $ getProduct $ mconcat . map Product $ [ 3, 4, 2 ] 60 | 61 | println $ getSum $ Sum 2 `mappend` Sum 9 62 | println $ getSum $ mempty `mappend` Sum 3 63 | println $ getSum $ mconcat . map Sum $ [ 1, 2, 3 ] 64 | 65 | println $ getAny $ Any true `mappend` Any false 66 | println $ getAny $ mempty `mappend` Any true 67 | println $ getAny $ mconcat . map Any $ [ false, false, false, true ] 68 | println $ getAny $ mempty `mappend` mempty 69 | 70 | println $ getAll $ mempty `mappend` All true 71 | println $ getAll $ mempty `mappend` All false 72 | println $ getAll $ mconcat . map All $ [ true, true, true ] 73 | println $ getAll $ mconcat . map All $ [ true, true, false ] 74 | 75 | println $ Lt `mappend` Gt 76 | println $ Gt `mappend` Lt 77 | println $ mempty `mappend` Lt 78 | println $ mempty `mappend` Gt 79 | 80 | println $ lengthCompare1 "zen" "ants" 81 | println $ lengthCompare1 "zen" "ant" 82 | 83 | println $ lengthCompare2 "zen" "anna" 84 | println $ lengthCompare2 "zen" "ana" 85 | println $ lengthCompare2 "zen" "ann" 86 | 87 | println $ Nothing `mappend` Just "andy" 88 | println $ Just Lt `mappend` Nothing 89 | println $ Just (Sum 3) `mappend` Just (Sum 4) 90 | 91 | println (First (Just 'a') `mappend` First (Just 'b')).getFirst 92 | println (First Nothing `mappend` First (Just 'b')).getFirst 93 | println (First (Just 'a') `mappend` First Nothing).getFirst 94 | 95 | println (mconcat . map First $ [ Nothing, Just 9, Just 10 ]).getFirst 96 | 97 | println (mconcat . map Last $ [ Nothing, Just 9, Just 10 ]).getLast 98 | println (Last (Just "one") `mappend` Last (Just "two")).getLast 99 | 100 | println $ foldr (*) 1 [ 1, 2, 3 ] 101 | println $ F.foldr (*) 1 [ 1, 2, 3 ] 102 | 103 | println $ F.foldl (+) 2 (Just 9) 104 | println $ F.foldl (||) false (Just true) 105 | 106 | println $ F.foldl (+) 0 testTree 107 | println $ F.foldl (*) 1 testTree 108 | 109 | println $ getAny $ F.foldMap (\x -> Any $ x == 3) testTree 110 | println $ getAny $ F.foldMap (\x -> Any $ x > 15) testTree 111 | 112 | println $ F.foldMap (\x -> [x]) testTree 113 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter13/WriterIHardlyKnowHer.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter13.WriterIHardlyKnowHer where 2 | 3 | import frege.data.Monoid 4 | import frege.data.wrapper.Num 5 | 6 | isBigGang :: Int -> (Bool, String) 7 | isBigGang x = (x > 9, "Compared gang size to 9.") 8 | 9 | applyLog' :: (a, String) -> (a -> (b, String)) -> (b, String) 10 | applyLog' (x, log) f = 11 | let (y, newLog) = f x 12 | in (y, log ++ newLog) 13 | 14 | applyLog :: (Monoid m) => (a, m) -> (a -> (b, m)) -> (b, m) 15 | applyLog (x, log) f = 16 | let (y, newLog) = f x 17 | in (y, log `mappend` newLog) 18 | 19 | type Food = String 20 | type Price = Sum Int 21 | 22 | addDrink :: Food -> (Food, Price) 23 | addDrink "beans" = ("milk", Sum 25) 24 | addDrink "jerky" = ("whiskey", Sum 99) 25 | addDrink _ = ("beer", Sum 30) 26 | 27 | -- Frege's Writer is mapped to java.io.Writer 28 | data MyWriter w a = MyWriter { runWriter :: (a, w) } 29 | 30 | instance (Monoid w) => Monad (MyWriter w) where 31 | return x = MyWriter (x, mempty) 32 | (MyWriter (x, v)) >>= f = 33 | let (MyWriter (y, v')) = f x 34 | in MyWriter (y, v `mappend` v') 35 | 36 | logNumber :: Int -> MyWriter [String] Int 37 | logNumber x = MyWriter (x, ["Got number: " ++ show x]) 38 | 39 | tell :: w -> MyWriter w () 40 | tell v = MyWriter ((), v) 41 | 42 | multWithLog :: MyWriter [String] Int 43 | multWithLog = do 44 | a <- logNumber 3 45 | b <- logNumber 5 46 | tell ["Gonna multiply these two"] 47 | return (a * b) 48 | 49 | gcd' :: Int -> Int -> MyWriter [String] Int 50 | gcd' a b 51 | | b == 0 = do 52 | tell ["Finished with " ++ show a] 53 | return a 54 | | otherwise = do 55 | tell [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)] 56 | gcd' b (a `mod` b) 57 | 58 | gcdReverse :: Int -> Int -> MyWriter [String] Int 59 | gcdReverse a b 60 | | b == 0 = do 61 | tell ["Finished with " ++ show a] 62 | return a 63 | | otherwise = do 64 | result <- gcdReverse b (a `mod` b) 65 | tell [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)] 66 | return result 67 | 68 | data DiffList a = DiffList { getDiffList :: [a] -> [a] } 69 | 70 | toDiffList :: [a] -> DiffList a 71 | toDiffList xs = DiffList (xs ++) 72 | 73 | fromDiffList :: DiffList a -> [a] 74 | fromDiffList (DiffList f) = f [] 75 | 76 | instance Monoid (DiffList a) where 77 | mempty = DiffList (\xs -> [] ++ xs) 78 | (DiffList f) `mappend` (DiffList g) = DiffList (\xs -> f (g xs)) 79 | 80 | gcdReverse' :: Int -> Int -> MyWriter (DiffList String) Int 81 | gcdReverse' a b 82 | | b == 0 = do 83 | tell (toDiffList ["Finished with " ++ show a]) 84 | return a 85 | | otherwise = do 86 | result <- gcdReverse' b (a `mod` b) 87 | tell (toDiffList [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]) 88 | return result 89 | 90 | finalCountDown1 :: Int -> MyWriter (DiffList String) () 91 | finalCountDown1 0 = do 92 | tell (toDiffList ["0"]) 93 | finalCountDown1 x = do 94 | finalCountDown1 (x - 1) 95 | tell (toDiffList [show x]) 96 | 97 | finalCountDown2 :: Int -> MyWriter [String] () 98 | finalCountDown2 0 = do 99 | tell ["0"] 100 | finalCountDown2 x = do 101 | finalCountDown2 (x - 1) 102 | tell [show x] 103 | 104 | main _ = do 105 | 106 | println $ isBigGang 3 107 | println $ isBigGang 30 108 | 109 | println $ (3, "Smallish gang.") `applyLog'` isBigGang 110 | println $ (30, "A freaking platoon.") `applyLog'` isBigGang 111 | 112 | println $ ("Tobin", "Got outlaw name.") `applyLog'` (\x -> (length x, "Applied length.")) 113 | println $ ("Bathcat", "Got outlaw name.") `applyLog'` (\x -> (length x, "Applied length")) 114 | 115 | println $ ("beans", Sum 10) `applyLog` addDrink 116 | println $ ("jerky", Sum 25) `applyLog` addDrink 117 | println $ ("dogmeat", Sum 5) `applyLog` addDrink 118 | 119 | println $ (("dogmeat", Sum 5) `applyLog` addDrink) `applyLog` addDrink 120 | 121 | println ((return 3 :: MyWriter String Int).runWriter :: (Int, String)) 122 | println ((return 3 :: MyWriter (Sum Int) Int).runWriter :: (Int, Sum Int)) 123 | println ((return 3 :: MyWriter (Product Int) Int).runWriter :: (Int, Product Int)) 124 | 125 | println multWithLog.runWriter 126 | 127 | println $ fst (gcd' 8 3).runWriter 128 | 129 | mapM_ putStrLn $ snd (gcd' 8 3).runWriter 130 | mapM_ putStrLn $ snd (gcdReverse 8 3).runWriter 131 | 132 | println $ fromDiffList (toDiffList [ 1, 2, 3, 4 ] `mappend` toDiffList [ 1, 2, 3 ]) 133 | 134 | mapM_ putStrLn . fromDiffList . snd $ (gcdReverse' 110 34).runWriter 135 | 136 | -- java.lang.StackOverflowError! 137 | -- mapM_ putStrLn . fromDiffList . snd $ (finalCountDown1 500000).runWriter 138 | -- mapM_ putStrLn . snd $ (finalCountDown2 500000).runWriter 139 | -------------------------------------------------------------------------------- /gradlew: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | ############################################################################## 4 | ## 5 | ## Gradle start up script for UN*X 6 | ## 7 | ############################################################################## 8 | 9 | # Add default JVM options here. You can also use JAVA_OPTS and GRADLE_OPTS to pass JVM options to this script. 10 | DEFAULT_JVM_OPTS="" 11 | 12 | APP_NAME="Gradle" 13 | APP_BASE_NAME=`basename "$0"` 14 | 15 | # Use the maximum available, or set MAX_FD != -1 to use that value. 16 | MAX_FD="maximum" 17 | 18 | warn ( ) { 19 | echo "$*" 20 | } 21 | 22 | die ( ) { 23 | echo 24 | echo "$*" 25 | echo 26 | exit 1 27 | } 28 | 29 | # OS specific support (must be 'true' or 'false'). 30 | cygwin=false 31 | msys=false 32 | darwin=false 33 | case "`uname`" in 34 | CYGWIN* ) 35 | cygwin=true 36 | ;; 37 | Darwin* ) 38 | darwin=true 39 | ;; 40 | MINGW* ) 41 | msys=true 42 | ;; 43 | esac 44 | 45 | # For Cygwin, ensure paths are in UNIX format before anything is touched. 46 | if $cygwin ; then 47 | [ -n "$JAVA_HOME" ] && JAVA_HOME=`cygpath --unix "$JAVA_HOME"` 48 | fi 49 | 50 | # Attempt to set APP_HOME 51 | # Resolve links: $0 may be a link 52 | PRG="$0" 53 | # Need this for relative symlinks. 54 | while [ -h "$PRG" ] ; do 55 | ls=`ls -ld "$PRG"` 56 | link=`expr "$ls" : '.*-> \(.*\)$'` 57 | if expr "$link" : '/.*' > /dev/null; then 58 | PRG="$link" 59 | else 60 | PRG=`dirname "$PRG"`"/$link" 61 | fi 62 | done 63 | SAVED="`pwd`" 64 | cd "`dirname \"$PRG\"`/" >&- 65 | APP_HOME="`pwd -P`" 66 | cd "$SAVED" >&- 67 | 68 | CLASSPATH=$APP_HOME/gradle/wrapper/gradle-wrapper.jar 69 | 70 | # Determine the Java command to use to start the JVM. 71 | if [ -n "$JAVA_HOME" ] ; then 72 | if [ -x "$JAVA_HOME/jre/sh/java" ] ; then 73 | # IBM's JDK on AIX uses strange locations for the executables 74 | JAVACMD="$JAVA_HOME/jre/sh/java" 75 | else 76 | JAVACMD="$JAVA_HOME/bin/java" 77 | fi 78 | if [ ! -x "$JAVACMD" ] ; then 79 | die "ERROR: JAVA_HOME is set to an invalid directory: $JAVA_HOME 80 | 81 | Please set the JAVA_HOME variable in your environment to match the 82 | location of your Java installation." 83 | fi 84 | else 85 | JAVACMD="java" 86 | which java >/dev/null 2>&1 || die "ERROR: JAVA_HOME is not set and no 'java' command could be found in your PATH. 87 | 88 | Please set the JAVA_HOME variable in your environment to match the 89 | location of your Java installation." 90 | fi 91 | 92 | # Increase the maximum file descriptors if we can. 93 | if [ "$cygwin" = "false" -a "$darwin" = "false" ] ; then 94 | MAX_FD_LIMIT=`ulimit -H -n` 95 | if [ $? -eq 0 ] ; then 96 | if [ "$MAX_FD" = "maximum" -o "$MAX_FD" = "max" ] ; then 97 | MAX_FD="$MAX_FD_LIMIT" 98 | fi 99 | ulimit -n $MAX_FD 100 | if [ $? -ne 0 ] ; then 101 | warn "Could not set maximum file descriptor limit: $MAX_FD" 102 | fi 103 | else 104 | warn "Could not query maximum file descriptor limit: $MAX_FD_LIMIT" 105 | fi 106 | fi 107 | 108 | # For Darwin, add options to specify how the application appears in the dock 109 | if $darwin; then 110 | GRADLE_OPTS="$GRADLE_OPTS \"-Xdock:name=$APP_NAME\" \"-Xdock:icon=$APP_HOME/media/gradle.icns\"" 111 | fi 112 | 113 | # For Cygwin, switch paths to Windows format before running java 114 | if $cygwin ; then 115 | APP_HOME=`cygpath --path --mixed "$APP_HOME"` 116 | CLASSPATH=`cygpath --path --mixed "$CLASSPATH"` 117 | 118 | # We build the pattern for arguments to be converted via cygpath 119 | ROOTDIRSRAW=`find -L / -maxdepth 1 -mindepth 1 -type d 2>/dev/null` 120 | SEP="" 121 | for dir in $ROOTDIRSRAW ; do 122 | ROOTDIRS="$ROOTDIRS$SEP$dir" 123 | SEP="|" 124 | done 125 | OURCYGPATTERN="(^($ROOTDIRS))" 126 | # Add a user-defined pattern to the cygpath arguments 127 | if [ "$GRADLE_CYGPATTERN" != "" ] ; then 128 | OURCYGPATTERN="$OURCYGPATTERN|($GRADLE_CYGPATTERN)" 129 | fi 130 | # Now convert the arguments - kludge to limit ourselves to /bin/sh 131 | i=0 132 | for arg in "$@" ; do 133 | CHECK=`echo "$arg"|egrep -c "$OURCYGPATTERN" -` 134 | CHECK2=`echo "$arg"|egrep -c "^-"` ### Determine if an option 135 | 136 | if [ $CHECK -ne 0 ] && [ $CHECK2 -eq 0 ] ; then ### Added a condition 137 | eval `echo args$i`=`cygpath --path --ignore --mixed "$arg"` 138 | else 139 | eval `echo args$i`="\"$arg\"" 140 | fi 141 | i=$((i+1)) 142 | done 143 | case $i in 144 | (0) set -- ;; 145 | (1) set -- "$args0" ;; 146 | (2) set -- "$args0" "$args1" ;; 147 | (3) set -- "$args0" "$args1" "$args2" ;; 148 | (4) set -- "$args0" "$args1" "$args2" "$args3" ;; 149 | (5) set -- "$args0" "$args1" "$args2" "$args3" "$args4" ;; 150 | (6) set -- "$args0" "$args1" "$args2" "$args3" "$args4" "$args5" ;; 151 | (7) set -- "$args0" "$args1" "$args2" "$args3" "$args4" "$args5" "$args6" ;; 152 | (8) set -- "$args0" "$args1" "$args2" "$args3" "$args4" "$args5" "$args6" "$args7" ;; 153 | (9) set -- "$args0" "$args1" "$args2" "$args3" "$args4" "$args5" "$args6" "$args7" "$args8" ;; 154 | esac 155 | fi 156 | 157 | # Split up the JVM_OPTS And GRADLE_OPTS values into an array, following the shell quoting and substitution rules 158 | function splitJvmOpts() { 159 | JVM_OPTS=("$@") 160 | } 161 | eval splitJvmOpts $DEFAULT_JVM_OPTS $JAVA_OPTS $GRADLE_OPTS 162 | JVM_OPTS[${#JVM_OPTS[*]}]="-Dorg.gradle.appname=$APP_BASE_NAME" 163 | 164 | exec "$JAVACMD" "${JVM_OPTS[@]}" -classpath "$CLASSPATH" org.gradle.wrapper.GradleWrapperMain "$@" 165 | -------------------------------------------------------------------------------- /src/main/frege/learnyou/chapter07/DataList.fr: -------------------------------------------------------------------------------- 1 | module learnyou.chapter07.DataList where 2 | 3 | import frege.data.List 4 | 5 | stock = [ (994.4, 2008, 9, 1) 6 | , (995.2, 2008, 9, 2) 7 | , (999.2, 2008, 9, 3) 8 | , (1001.4, 2008, 9, 4) 9 | , (998.3, 2008, 9, 5) 10 | ] 11 | 12 | derive Show (a, b, c, d) 13 | 14 | search :: (Eq a) => [a] -> [a] -> Bool 15 | search needle haystack = 16 | let nlen = length needle 17 | in fold (\acc \x -> if take nlen x == needle then True else acc) 18 | false (tails haystack) 19 | 20 | compress :: [a] -> (a, Int) 21 | compress [] = error "empty list" 22 | compress (x : xs) = (x, length (x : xs)) 23 | 24 | values = [ -4.3, -2.4, -1.2, 0.4, 2.3 25 | , 5.9, 10.5, 29.1, 5.3, -2.4 26 | , -14.5, 2.9, 2.3 27 | ] 28 | 29 | main _ = do 30 | 31 | println $ packed $ intersperse '.' "MONKEY".toList 32 | println $ intersperse 0 [ 1, 2, 3, 4, 5, 6 ] 33 | 34 | println $ packed $ 35 | intercalate " ".toList $ map toList [ "hey", "there", "guys" ] 36 | println $ intercalate [ 0, 0, 0 ] [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ] ] 37 | 38 | println $ transpose [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ] ] 39 | println $ (map packed) $ transpose $ (map unpacked) [ "hey", "there", "guys" ] 40 | 41 | println $ map sum $ 42 | transpose [ [ 0, 3, 5, 9 ], [ 10, 0, 0, 9 ], [ 8, 5, 1, -1 ] ] 43 | 44 | println $ concat [ "foo", "bar", "car" ] 45 | println $ concat [ [ 3, 4, 5 ], [ 2, 3, 4 ], [ 2, 1, 1 ] ] 46 | 47 | println $ concatMap (replicate 4) [ 1 .. 3 ] 48 | 49 | println $ and $ map (> 4) [ 5, 6, 7, 8 ] 50 | println $ and $ map (== 4) [ 4, 4, 4, 3, 4 ] 51 | 52 | println $ or $ map (== 4) [ 2, 3, 4, 5, 6, 1 ] 53 | println $ or $ map (> 4) [ 1, 2, 3 ] 54 | 55 | println $ any (== 4) [ 2, 3, 5, 6, 1, 4 ] 56 | println $ all (> 4) [ 6, 9, 10 ] 57 | println $ all (`elem` ['A'..'Z']) "HEYGUYSwhatsup".toList 58 | println $ any (`elem` ['A'..'Z']) "HEYGUYSwhatsup".toList 59 | 60 | println $ take 10 $ iterate (* 2) 1 61 | println $ take 3 $ iterate (++ "haha") "haha" 62 | 63 | println $ splitAt 3 "heyman" 64 | -- println $ splitAt 100 "heyman" --> StringIndexOutOfBoundsExeption 65 | -- println $ splitAt (-3) "heyman" --> StringIndexOutOfBoundsExeption 66 | let (a, b) = splitAt 3 "foobar" 67 | println $ b ++ a 68 | 69 | println $ takeWhile (> 3) [ 6, 5, 4, 3, 2, 1, 2, 3, 4, 5, 4, 3, 2, 1 ] 70 | println $ packed $ takeWhile (!= ' ') "This is a sentence".toList 71 | println $ sum $ takeWhile (< 10000) $ map (^ 3) [1..] 72 | 73 | println $ packed $ dropWhile (!= ' ') "This is a sentence".toList 74 | println $ dropWhile (< 3) [ 1, 2, 2, 2, 3, 4, 5, 4, 3, 2, 1 ] 75 | println $ head (dropWhile (\(val, y, m, d) -> val < 1000) stock) 76 | 77 | let (fw, rest) = span (!= ' ') "This is a sentence".toList 78 | println $ "First word:" ++ (packed fw) ++ ", the rest:" ++ (packed rest) 79 | 80 | println $ break (== 4) [ 1, 2, 3, 4, 5, 6, 7 ] 81 | println $ span (!= 4) [ 1, 2, 3, 4, 5, 6, 7 ] 82 | 83 | println $ sort [ 8, 5, 3, 2, 1, 6, 4, 2 ] 84 | println $ packed $ sort "This will be sorted soon".toList 85 | 86 | println $ group [ 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 2, 2, 2, 5, 6, 7 ] 87 | println $ map compress . group . sort $ 88 | [ 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 2, 2, 2, 5, 6, 7 ] 89 | 90 | println $ map packed $ inits $ unpacked "w00t" 91 | println $ map packed $ tails $ unpacked "w00t" 92 | println $ zip (map packed . inits . unpacked $ "w00t") 93 | (map packed . tails . unpacked $ "w00t") 94 | 95 | println $ "cat".toList `isInfixOf` "im a cat burglar".toList 96 | println $ "Cat".toList `isInfixOf` "im a cat burglar".toList 97 | println $ "cats".toList `isInfixOf` "im a cat burglar".toList 98 | 99 | println $ "hey".toList `isPrefixOf` "hey there!".toList 100 | println $ "hey".toList `isPrefixOf` "oh hey there!".toList 101 | println $ "there!".toList `isSuffixOf` "oh hey there!".toList 102 | println $ "there!".toList `isSuffixOf` "oh hey there".toList 103 | 104 | println $ (\(x, y) -> (packed x, packed y)) $ 105 | partition (`elem` ['A'..'Z']) "BOBsidneyMORGANeddy".toList 106 | println $ partition (> 3) [ 1, 3, 5, 6, 3, 2, 1, 0, 3, 7 ] 107 | println $ (\(x, y) -> (packed x, packed y)) $ 108 | span (`elem` ['A'..'Z']) "BOBsidneyMORGANeddy".toList 109 | 110 | println $ find (> 4) [ 1, 2, 3, 4, 5, 6 ] 111 | println $ find (> 9) [ 1, 2, 3, 4, 5, 6 ] 112 | 113 | println $ 4 `elemIndex` [ 1, 2, 3, 4, 5, 6 ] 114 | println $ 10 `elemIndex` [ 1, 2, 3, 4, 5, 6 ] 115 | 116 | println $ ' ' `elemIndices` "Where are the spaces?".toList 117 | 118 | println $ findIndex (== 4) [ 5, 3, 2, 1, 6, 4 ] 119 | println $ findIndex (== 7) [ 5, 3, 2, 1, 6, 4 ] 120 | println $ findIndices (`elem` ['A'..'Z']) "Where Are The Caps?".toList 121 | 122 | println $ zipWith3 (\x \y \z -> x + y + z) 123 | [ 1, 2, 3 ] [ 4, 5, 2, 2 ] [ 2, 2, 3 ] 124 | println $ zip4 [ 2, 3, 3 ] [ 2, 2, 2 ] [ 5, 5, 3 ] [ 2, 2, 2 ] 125 | 126 | println $ lines "first line\nsecond line\nthird line" 127 | println $ show $ unlines [ "first line", "second line", "third line" ] 128 | 129 | println $ words "hey these are the words in this sentence" 130 | println $ words "hey these are the words in this\nsentence" 131 | println $ unwords [ "hey", "there", "mate" ] 132 | 133 | println $ nub [ 1, 2, 3, 4, 3, 2, 1, 2, 3, 4, 3, 2, 1 ] 134 | println $ packed $ nub "Lots of words and stuff".toList 135 | 136 | println $ packed $ delete 'h' "hey there ghang!".toList 137 | println $ packed $ delete 'h' . delete 'h' $ "hey there ghang!".toList 138 | println $ packed $ delete 'h' . delete 'h' . delete 'h' $ "hey there ghang!".toList 139 | 140 | println $ [ 1 .. 10 ] \\ [ 2, 5, 9 ] 141 | println $ packed $ "Im a big baby".toList \\ "big".toList 142 | 143 | println $ packed $ "hey man".toList `union` "man what's up".toList 144 | println $ [ 1 .. 7 ] `union` [ 5 .. 10 ] 145 | 146 | println $ [ 1 .. 7 ] `intersect` [ 5 .. 10 ] 147 | 148 | println $ insert 4 [ 3, 5, 1, 2, 8, 2 ] 149 | println $ insert 4 [ 1, 3, 4, 4, 1 ] 150 | println $ insert 4 [ 1, 2, 3, 5, 6, 7 ] 151 | println $ packed $ insert 'g' $ ['a'..'f'] ++ ['h'..'z'] 152 | println $ insert 3 [ 1, 2, 4, 3, 2, 1 ] 153 | 154 | println $ groupBy (\x \y -> (x > 0) == (y > 0)) values 155 | println $ groupBy ((==) `on` (> 0)) values 156 | 157 | let xs = [ [ 5, 4, 5, 4, 4 ], [ 1, 2, 3 ], [ 3, 5, 4, 3 ], [], [ 2 ], [ 2, 2 ] ] 158 | println $ sortBy (compare `on` length) xs 159 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Learn You a Frege for Great Good! 2 | 3 | [![Build Status](https://travis-ci.org/y-taka-23/learn-you-a-frege.svg?branch=master)](https://travis-ci.org/y-taka-23/learn-you-a-frege) 4 | 5 | [Frege](https://github.com/Frege/frege) implementation of examples in the book ["Learn You a Haskell for Great Good!"](http://learnyouahaskell.com/). See also [LYAH adaptions for Frege](https://github.com/Frege/frege/wiki/LYAH-adaptions-for-Frege) in the official wiki. 6 | 7 | ## Table of Contents 8 | 9 | ### 1. Introduction 10 | 11 | 1. About this tutorial (no examples) 12 | 2. So what's Haskell? (no examples) 13 | 3. What you need to dive in (no examples) 14 | 15 | ### 2. Starting Out 16 | 17 | 1. [Ready, set, go!](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter02/ReadySetGo.fr) 18 | 2. [Baby's first functions](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter02/BabysFirstFunctions.fr) 19 | 3. [An intro to lists](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter02/AnIntroToLists.fr) 20 | 4. [Texas ranges](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter02/TexasRanges.fr) 21 | 5. [I'm a list comprehension](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter02/ImAListComprehension.fr) 22 | 6. [Tuples](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter02/Tuples.fr) 23 | 24 | ### 3. Types and Typeclasses 25 | 26 | 1. [Believe the type](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter03/BelieveTheType.fr) 27 | 2. Type variables (no examples) 28 | 3. [Typeclasses 101](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter03/Typeclasses101.fr) 29 | 30 | ### 4. Syntax in Functions 31 | 32 | 1. [Pattern matching](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter04/PatternMatching.fr) 33 | 2. [Guards, guards!](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter04/GuardsGuards.fr) 34 | 3. [Where!?](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter04/Where.fr) 35 | 4. [Let it be](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter04/LetItBe.fr) 36 | 5. [Case expressions](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter04/CaseExpressions.fr) 37 | 38 | ### 5. Recursion 39 | 40 | 1. Hello recursion! (no examples) 41 | 2. [Maximum awesome](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter05/MaximumAwesome.fr) 42 | 3. [A few more recursive functions](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter05/AFewMoreRecursiveFunctions.fr) 43 | 4. [Quick, sort!](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter05/QuickSort.fr) 44 | 5. Thinking recursively (no examples) 45 | 46 | ### 6. Higher Order Functions 47 | 48 | 1. [Curried functions](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter06/CurriedFunctions.fr) 49 | 2. [Some higher-orderism is in order](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter06/SomeHigherOrderismIsInOrder.fr) 50 | 3. [Maps and filters](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter06/MapsAndFilters.fr) 51 | 4. [Lambdas](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter06/Lambdas.fr) 52 | 5. [Only folds and horses](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter06/OnlyFoldsAndHorses.fr) 53 | 6. [Function application with $](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter06/FunctionApplicationWithDollar.fr) 54 | 7. [Function composition](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter06/FunctionComposition.fr) 55 | 56 | ### 7. Modules 57 | 58 | 1. [Loading modules](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter07/LoadingModules.fr) 59 | 2. [Data.List](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter07/DataList.fr) 60 | 3. [Data.Char](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter07/DataChar.fr) 61 | 4. [Data.Map](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter07/DataMap.fr) 62 | 5. [Data.Set](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter07/DataSet.fr) 63 | 6. [Making our own modules](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter07/MakingOurOwnModules.fr) 64 | 65 | ### 8. Making Our Own Types and Typeclasses 66 | 67 | 1. [Algebraic data types intro](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/AlgebraicDataTypesIntro.fr) 68 | 2. [Record syntax](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/RecordSyntax.fr) 69 | 3. [Type parameters](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/TypeParameters.fr) 70 | 4. [Derived instances](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/DerivedInstances.fr) 71 | 5. [Type synonyms](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/TypeSynonyms.fr) 72 | 6. [Recursive data structures](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/RecursiveDataStructures.fr) 73 | 7. [Typeclasses 102](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/Typeclasses102.fr) 74 | 8. [A yes-no typeclass](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/AYesNoTypeclass.fr) 75 | 9. [The Functor typeclass](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/TheFunctorTypeclass.fr) 76 | 10. [Kinds and some type-foo](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter08/KindsAndSomeTypeFoo.fr) 77 | 78 | ### 9. Input and Output 79 | 80 | 1. [Hello, world!](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter09/HelloWorld.fr) 81 | 2. [Files and streams](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter09/FilesAndStreams.fr) 82 | 3. [Command line arguments](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter09/CommandLineArguments.fr) 83 | 4. [Randomness](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter09/Randomness.fr) 84 | 5. Bytestrings (omitted: `String` is not a synonym of `[Char]` in Frege) 85 | 6. [Exceptions](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter09/Exceptions.fr) 86 | 87 | ### 10. Functionally Solving Problems 88 | 89 | 1. [Reverse Polish notation calculator](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter10/ReversePolishNotationCalculator.fr) 90 | 2. [Heathrow to London](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter10/HeathrowToLondon.fr) 91 | 92 | ### 11. Functors, Applicative Functors and Monoids 93 | 94 | 1. [Functors redux](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter11/FunctorsRedux.fr) 95 | 2. [Applicative functors](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter11/ApplicativeFunctors.fr) 96 | 3. [The newtype keyword](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter11/TheNewtypeKeyword.fr) 97 | 4. [Monoids](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter11/Monoids.fr) 98 | 99 | ### 12. A Fistful of Monads 100 | 101 | 1. [Getting our feet wet with Maybe](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter12/GettingOurFeetWetWithMaybe.fr) 102 | 2. [The Monad type class](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter12/TheMonadTypeClass.fr) 103 | 3. [Walk the line](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter12/WalkTheLine.fr) 104 | 4. [do notation](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter12/DoNotation.fr) 105 | 5. [The list monad](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter12/TheListMonad.fr) 106 | 6. [Monad laws](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter12/MonadLaws.fr) 107 | 108 | ### 13. For a Few Monads More 109 | 110 | 1. [Writer? I hardly know her!](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter13/WriterIHardlyKnowHer.fr) 111 | 2. [Reader? Ugh, not this joke again.](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter13/ReaderUghNotThisJokeAgain.fr) 112 | 3. [Tasteful stateful computations](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter13/TastefulStatefulComputations.fr) 113 | 4. [Error error on the wall](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter13/ErrorErrorOnTheWall.fr) 114 | 5. [Some useful monadic functions](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter13/SomeUsefulMonadicFunctions.fr) 115 | 6. [Making monads](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter13/MakingMonads.fr) 116 | 117 | ### 14. Zippers 118 | 119 | 1. [Taking a walk](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter14/TakingAWalk.fr) 120 | 2. [A trail of breadcrumbs](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter14/ATrailOfBreadcrumbs.fr) 121 | 3. [Focusing on lists](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter14/FocusingOnLists.fr) 122 | 4. [A very simple file system](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter14/AVerySimpleFileSystem.fr) 123 | 5. [Watch your step](https://github.com/y-taka-23/learn-you-a-frege/blob/master/src/main/frege/learnyou/chapter14/WatchYourStep.fr) 124 | 125 | ## How to Build 126 | 127 | The project is built by Gradle and [Frege Gradle Plugin](https://github.com/Frege/frege-gradle-plugin). The Gradle wrapper is already committed in the repository, so what you have to do is execute: 128 | 129 | ``` 130 | $ ./gradlew compileFrege 131 | ``` 132 | 133 | Then you can find the generated `.java` and `.class` files under the `build/classes/main` directory. 134 | 135 | ## License 136 | 137 | This work is highly inspired by ["Learn You a Haskell for Great Good!"](http://learnyouahaskell.com/), and licensed under the [Creative Commons Attribution-Noncommercial-Share Alike 3.0 Unported License](http://creativecommons.org/licenses/by-nc-sa/3.0/legalcode), just like the original. 138 | 139 | [![CC BY-NC-SA](https://licensebuttons.net/l/by-nc-sa/3.0/88x31.png "CC BY-NC-SA")](http://creativecommons.org/licenses/by-nc-sa/3.0/) 140 | --------------------------------------------------------------------------------