From moritz.tacke at gmail.com Fri Feb 1 14:14:32 2019 From: moritz.tacke at gmail.com (Moritz Tacke) Date: Fri, 1 Feb 2019 15:14:32 +0100 Subject: [Haskell-beginners] Using a monad function inside the monad transfomer variant Message-ID: Hi, I am running into difficulties regarding the use of monad transformers. The situation is as follows: I implemented some functions returning "RVar" results. Now, in a different part of the program, I am using STUArrays. Therefore my idea was to create a monad transformer stack which would have this type: someFunction:: a -> b -> RVarT (ST s) (STUArray s Int Double) I still want to use the functions that return RVars, so eg. rvarDouble :: RVar Double and then the definition of the transformer function would be: someFunction a b = do ... the_double <- rvarDouble .... This does not compile, complaining that; • Couldn't match type ‘Data.Functor.Identity.Identity’ with ‘ST s’ Expected type: RVarT (ST s) Double Actual type: RVar Double How can I re-user the RVar function in the RVarT monad transformer? Sincerely yours, Moritz From seph at codex.scot Fri Feb 1 17:57:17 2019 From: seph at codex.scot (Seph Shewell Brockway) Date: Fri, 1 Feb 2019 17:57:17 +0000 Subject: [Haskell-beginners] Using a monad function inside the monad transfomer variant In-Reply-To: References: Message-ID: <20190201175717.acbhtmqs2wv23c5p@leviathan> On Fri, Feb 01, 2019 at 03:14:32PM +0100, Moritz Tacke wrote: > Hi, > > I still want to use the functions that return RVars, so eg. > > rvarDouble :: RVar Double > > and then the definition of the transformer function would be: > > someFunction a b = > do ... > the_double <- rvarDouble > .... > > This does not compile, complaining that; > > • Couldn't match type ‘Data.Functor.Identity.Identity’ with ‘ST s’ > Expected type: RVarT (ST s) Double > Actual type: RVar Double > > How can I re-user the RVar function in the RVarT monad transformer? Your declaration of rvarDouble needs to be polymorphic in the monad: rvarDouble :: Monad m => RVarT m Double The crucial observation is that RVar is actually a type synonym for RVarT Identity, so the function can still be made to return a plain RVar Double, but it can also return an RVarT (ST s) Double, satisfying the type-checker in the example that you gave. -- Seph Shewell Brockway, BSc MSc (Glas.) From Leonhard.Applis at protonmail.com Sat Feb 2 08:02:36 2019 From: Leonhard.Applis at protonmail.com (Leonhard Applis) Date: Sat, 02 Feb 2019 08:02:36 +0000 Subject: [Haskell-beginners] Parsing Terms in Brackets for Calculator Message-ID: Hello, I'm currently doing my first steps in Haskell with a calculator and I'm stuck at the parser. I have a data Term which will build ... basically a tree of operations, and works fine. I need help for the function termify :: [Either Operator Term] -> Term It takes operators (such as +,**) and terms and output a new, bigger term and is mostly trivial. However, all attempts I've done for parsing brackets seem very ... crude and not like Haskell at all. The very first pattern match should check for the innermost brackets, and return termify for everything in between. I guess that I'm missing some really cool, haskelly solution here. Best Regards Leonhard -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Sat Feb 2 16:44:09 2019 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Sat, 2 Feb 2019 11:44:09 -0500 Subject: [Haskell-beginners] Parsing Terms in Brackets for Calculator In-Reply-To: References: Message-ID: You're in luck! Text.Megaparsec.Expr[1] is designed to handle exactly this problem. I put a tutorial of sorts[2] in a fork of it on Github. [1] https://www.stackage.org/haddock/nightly-2015-12-08/megaparsec-4.2.0/Text-Megaparsec-Expr.html [2] https://github.com/JeffreyBenjaminBrown/megaparsec/tree/master/Expr-studies On Sat, Feb 2, 2019 at 3:03 AM Leonhard Applis < Leonhard.Applis at protonmail.com> wrote: > Hello, > > I'm currently doing my first steps in Haskell with a calculator and I'm > stuck at the parser. > I have a *data Term* which will build ... basically a tree of operations, > and works fine. > > I need help for the function > termify :: [Either Operator Term] -> Term > > It takes operators (such as +,**) and terms and output a new, bigger term > and is mostly trivial. > However, all attempts I've done for parsing brackets seem very ... crude > and not like Haskell at all. > > The very first pattern match should check for the innermost brackets, and > return termify for everything in between. > I guess that I'm missing some really cool, haskelly solution here. > > Best Regards > Leonhard > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Jeff Brown | Jeffrey Benjamin Brown Website | Facebook | LinkedIn (spammy, so I often miss messages here) | Github -------------- next part -------------- An HTML attachment was scrubbed... URL: From moritz.tacke at gmail.com Sat Feb 2 18:50:22 2019 From: moritz.tacke at gmail.com (Moritz Tacke) Date: Sat, 2 Feb 2019 19:50:22 +0100 Subject: [Haskell-beginners] Using a monad function inside the monad transfomer variant In-Reply-To: <20190201175717.acbhtmqs2wv23c5p@leviathan> References: <20190201175717.acbhtmqs2wv23c5p@leviathan> Message-ID: Ok, thank you, I'll try! Just to understand this: Is this due to a specific reason? Couldn't the compiler infer from a definition of a RVar that the same function can also be used in the RVarT situation? It would (somehow) look cleaner and I do not see any differences in the semantics On Fri, Feb 1, 2019 at 6:57 PM Seph Shewell Brockway wrote: > > On Fri, Feb 01, 2019 at 03:14:32PM +0100, Moritz Tacke wrote: > > Hi, > > > > I still want to use the functions that return RVars, so eg. > > > > rvarDouble :: RVar Double > > > > and then the definition of the transformer function would be: > > > > someFunction a b = > > do ... > > the_double <- rvarDouble > > .... > > > > This does not compile, complaining that; > > > > • Couldn't match type ‘Data.Functor.Identity.Identity’ with ‘ST s’ > > Expected type: RVarT (ST s) Double > > Actual type: RVar Double > > > > How can I re-user the RVar function in the RVarT monad transformer? > > Your declaration of rvarDouble needs to be polymorphic in the monad: > > rvarDouble :: Monad m => RVarT m Double > > The crucial observation is that RVar is actually a type synonym for > RVarT Identity, so the function can still be made to return a plain > RVar Double, but it can also return an RVarT (ST s) Double, satisfying > the type-checker in the example that you gave. > > -- > Seph Shewell Brockway, BSc MSc (Glas.) > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From borgauf at gmail.com Mon Feb 4 16:45:44 2019 From: borgauf at gmail.com (Lawrence Bottorff) Date: Mon, 4 Feb 2019 10:45:44 -0600 Subject: [Haskell-beginners] Install advice Message-ID: So I've got a new machine with a fresh install of Ubuntu 18.10. How should I install latest-greatest Haskell? (Perhaps review my previous post about having so much trouble with conflicting Haskell install theories.) LB -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Mon Feb 4 17:16:10 2019 From: michael at snoyman.com (Michael Snoyman) Date: Mon, 4 Feb 2019 19:16:10 +0200 Subject: [Haskell-beginners] Install advice In-Reply-To: References: Message-ID: There are multiple approaches, but my biased[1] recommendation is to use Stack, which can automatically install the appropriate GHC version. There are instructions available at: https://haskell-lang.org/get-started/linux I'd also recommend checking out the "next steps" section for how to get started using Stack. Also, there's a Gitter channel where you can ask follow up questions at: https://gitter.im/commercialhaskell/stack [1] I'm one of the Stack authors On Mon, Feb 4, 2019 at 6:46 PM Lawrence Bottorff wrote: > So I've got a new machine with a fresh install of Ubuntu 18.10. How should > I install latest-greatest Haskell? (Perhaps review my previous post about > having so much trouble with conflicting Haskell install theories.) > > LB > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From michele.alzetta at gmail.com Sun Feb 10 16:10:13 2019 From: michele.alzetta at gmail.com (Michele Alzetta) Date: Sun, 10 Feb 2019 17:10:13 +0100 Subject: [Haskell-beginners] Use of interact Message-ID: I solved the hacker-rank hello world n times challenge thus: hello_worlds :: Int -> IO () hello_worlds n | n < 1 = return () | otherwise = do putStrLn "Hello World" hello_worlds (n-1) main :: IO() main = do n <- readLn :: IO Int hello_worlds n I would like to solve this by using the interact function. If I leave my hello_worlds function as is and change the main function as follows: main = interact $ show . hello_worlds . read::Int I get: Couldn't match expected type ‘IO t0’ with actual type ‘Int’ • In the expression: main When checking the type of the IO action ‘main’ helloworlds.hs:14:8-44: error: • Couldn't match expected type ‘Int’ with actual type ‘IO ()’ • In the expression: interact $ show . hello_worlds . read :: Int In an equation for ‘main’: main = interact $ show . hello_worlds . read :: Int could someone please explain why this can't work? Is it possible to use interact in such a context? Thanks -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sun Feb 10 16:39:09 2019 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 10 Feb 2019 17:39:09 +0100 Subject: [Haskell-beginners] Use of interact In-Reply-To: References: Message-ID: <20190210163909.3eaccd55uceq6umv@x60s.casa> Ciao Michele, On Sun, Feb 10, 2019 at 05:10:13PM +0100, Michele Alzetta wrote: > If I leave my hello_worlds function as is and change the main function as > follows: > > main = interact $ show . hello_worlds . read::Int > > I get: [...] > > helloworlds.hs:14:8-44: error: > • Couldn't match expected type ‘Int’ with actual type ‘IO ()’ > • In the expression: interact $ show . hello_worlds . read :: Int > In an equation for ‘main’: > main = interact $ show . hello_worlds . read :: Int Two facts: - (.) is an operator which concatenates function - to concatenate functions, input/outputs must match So let's analyse this: 1. `read` has type `Read a => String -> a` 2. `hello_worlds` has type `Int -> IO ()` 3. `show` has type `Show a => a -> String` and there is no way to convert `IO ()` to `String`. Remember that hello_worlds does *not* return a series of Strings, but an IO action (in this case, "blit something to screen") Your `interact` example would function if written like this: main = interact $ unlines . map (hello_pure . read) . lines -- with `hello_pure :: Int -> String` `lines` and `unlines` are there to keep input lazy for each line. Do you think you can you fill-in "hello_pure" yourself? -F From michele.alzetta at gmail.com Sun Feb 10 20:59:54 2019 From: michele.alzetta at gmail.com (Michele Alzetta) Date: Sun, 10 Feb 2019 21:59:54 +0100 Subject: [Haskell-beginners] Use of interact In-Reply-To: <20190210163909.3eaccd55uceq6umv@x60s.casa> References: <20190210163909.3eaccd55uceq6umv@x60s.casa> Message-ID: Francesco, thanks, that was very enlightening. That concatenated functions should have matching inputs / outputs is obvious of course, but I just didn't think of that. Duh! That IO () can't be converted to String is probably just as obvious, but it wasn't for me. For hello_pure I tried this: hello_pure :: Int -> String hello_pure n | n < 1 = "" | otherwise = "Hello World" ++ "\n" ++ hello_pure ( n - 1 ) And it works, although ++ "\n" ++ doesn't feel so elegant. -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sun Feb 10 22:59:32 2019 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 10 Feb 2019 23:59:32 +0100 Subject: [Haskell-beginners] Use of interact In-Reply-To: References: <20190210163909.3eaccd55uceq6umv@x60s.casa> Message-ID: <20190210225932.tr4yx7pldkvrp6pt@x60s.casa> On Sun, Feb 10, 2019 at 09:59:54PM +0100, Michele Alzetta wrote: > For hello_pure I tried this: > > hello_pure :: Int -> String > hello_pure n > | n < 1 = "" > | otherwise = "Hello World" ++ "\n" ++ hello_pure ( n - 1 ) > Very good! > And it works, although > ++ "\n" ++ > doesn't feel so elegant. If you want, you can rewrite is as a one-liner like this: hp2 :: Int -> String hp2 n = unlines $ replicate n "Hello world" -F From michelhaber1994 at gmail.com Sat Feb 23 15:36:24 2019 From: michelhaber1994 at gmail.com (Michel Haber) Date: Sat, 23 Feb 2019 16:36:24 +0100 Subject: [Haskell-beginners] A game of life implementation Message-ID: Hello everyone, I'm a new haskeller, and (like many others, I assume) I thought I'd try my hand at Conway's "Game of Life". So here is my code that seems to work (up to this point). I am looking for feedback in order to improve my Haskell code on all levels. Especially (In no particular order): 0- Find and fix bugs 1- Write more performance optimal code. 2- Good use of polymorphic types. 3- Good use of higher-order functions. 4- Good use of Haskell's common (and uncommon) abstractions. 5- Coding style (I'm finding it hard to let go of the function types :p) 6- Good code structuring allowing for reuse and updates. 7- Best options to give to the compiler. 8- Anything else that comes to your mind! So I'd really appreciate your feedback :) This is the wikipedia reference for the game of life: https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life And this is the code: START OF CODE -- Game of life Haskell Implementation import Data.List import Control.Monad.State import qualified Data.Map as M -- The cell state is isomorphic to Bool. type CellState = Bool -- The coordinates of a cell type Coord = (Int, Int) -- The board size is (length, width) type Size = (Int, Int) -- The state of the board is simply the coordinates of its live cells type Board = [Coord] -- The state carried in the State Monad, used to count tags for cells type TallyState = State (M.Map Coord (CellState, Int)) () -- The type of the game rules type Rules = (Coord, CellState, Int) -> CellState -- The type for the neighbor functions type Neighbors = Coord -> [Coord] -- Tally the live neighbors of live cells and relevant dead cells tallyBoard :: Neighbors -> Board -> TallyState tallyBoard nb = mapM_ $ tallyCoord nb -- Tally a live cell: Set its state to True (alive) and tag its neighbors -- This function takes the neighbors function as its first argument. We can use -- different neighbor functions to change the zone of influence of a cell tallyCoord :: Neighbors -> Coord -> TallyState tallyCoord nb c = do let merge (a1,b1) (a2,b2) = (a1 || a2, b1 + b2) s <- get let s' = M.insertWith merge c (True, 0) s let neighbors = nb c put $ foldl' (\acc x -> M.insertWith merge x (False, 1) acc) s' neighbors -- Extract the results from a TallyState toResults :: TallyState -> [(Coord, CellState, Int)] toResults s = map flatten . M.toList . execState s $ M.empty where flatten (x,(y,z)) = (x,y,z) -- Use A Rules and Neighbors function to advance the board one step in time advance :: Rules -> Neighbors -> Board -> Board advance rules nb = map first . filter rules . toResults . tallyBoard nb where first (x,_,_) = x -- The standard neighbors function stdNeighbors :: Neighbors stdNeighbors (x,y) = [ (a,b) | a <- [x-1, x, x+1] , b <- [y-1, y, y+1] , (a /= x) || (b /= y) ] -- Standard game rules stdRules :: Size -> Rules stdRules (a,b) ((x,y),_,_) | (x < 0) || (y < 0) || (x >= a) || (y >= b) = False stdRules _ (_,True,c) | (c == 2) || (c == 3) = True | otherwise = False stdRules _ (_,False,3) = True stdRules _ _ = False -- Main loop loop :: (Board -> Board) -> Board -> IO () loop f b = do print b unless (null b) $ loop f (f b) -- Main function main :: IO () main = do putStrLn "Choose board size (x,y)" input <- getLine putStrLn "Choose starting points" start <- getLine putStrLn "Game:" let size = read input let rules = stdRules size let initial = map read . words $ start let game = advance rules stdNeighbors loop game initial END OF CODE Thanks :) -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sun Feb 24 00:34:43 2019 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 24 Feb 2019 01:34:43 +0100 Subject: [Haskell-beginners] A game of life implementation In-Reply-To: References: Message-ID: <20190224003443.hsqoxhifaujx5exz@x60s.casa> Hello Michel, On Sat, Feb 23, 2019 at 04:36:24PM +0100, Michel Haber wrote: > I am looking for feedback in order to improve my Haskell code on > all levels. [...] Minor lint suggestion: why > main :: IO () > main = do > let size = read input > let rules = stdRules size > let initial = map read . words $ start > let game = advance rules stdNeighbors > loop game initial instead of? > let size = read input > rules = stdRules size > initial = map read . words $ start > game = advance rules stdNeighbors Other than that, code is readable and clear! -F From michelhaber1994 at gmail.com Sun Feb 24 17:35:44 2019 From: michelhaber1994 at gmail.com (Michel Haber) Date: Sun, 24 Feb 2019 18:35:44 +0100 Subject: [Haskell-beginners] A game of life implementation In-Reply-To: <20190224003443.hsqoxhifaujx5exz@x60s.casa> References: <20190224003443.hsqoxhifaujx5exz@x60s.casa> Message-ID: Thanks Francesco, I will correct this. Any ideas for improvements on other levels? Michel:) On Sun, Feb 24, 2019 at 1:35 AM Francesco Ariis wrote: > Hello Michel, > > On Sat, Feb 23, 2019 at 04:36:24PM +0100, Michel Haber wrote: > > I am looking for feedback in order to improve my Haskell code on > > all levels. [...] > > Minor lint suggestion: why > > > main :: IO () > > main = do > > let size = read input > > let rules = stdRules size > > let initial = map read . words $ start > > let game = advance rules stdNeighbors > > loop game initial > > instead of? > > > let size = read input > > rules = stdRules size > > initial = map read . words $ start > > game = advance rules stdNeighbors > > Other than that, code is readable and clear! > -F > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From lists at utdemir.com Sun Feb 24 19:59:34 2019 From: lists at utdemir.com (Utku Demir) Date: Sun, 24 Feb 2019 14:59:34 -0500 Subject: [Haskell-beginners] A game of life implementation In-Reply-To: References: Message-ID: <196550c6-471e-4c1a-a304-5f76984b508e@www.fastmail.com> Looks great to me, I especially liked how you extracted 'stdRules' out :). A few minor suggestions: * Instead of type aliases, you can try using 'newtype' wrappers or concrete data types. e.g `newtype Size = Size (Int, Int)` or `data Size = Size Int Int`. This way it'll be a compiler error when you accidently pass a Size when actually a Coord is expected etc. You might need to do a bit of wrapping/unwrapping but it's usually worth the type safety they bring. * This is a bit contraversial, but you can use some light point-free notation in a few places. e.g `tallyBoard = mapM_ . tallyCoord` and `toResults = map flatten . M.toList . flip execState M.empty` * 'read' is a partial function, an especially when using external inputs it'd be better to use 'readMaybe', or a proper parser like 'trifecta' for more complex inputs. -- Utku Demir On Sun, Feb 24, 2019, at 4:37 AM, Michel Haber wrote: > Hello everyone, > I'm a new haskeller, and (like many others, I assume) I thought I'd try my hand > at Conway's "Game of Life". > > So here is my code that seems to work (up to this point). > I am looking for feedback in order to improve my Haskell code on all levels. > Especially (In no particular order): > 0- Find and fix bugs > 1- Write more performance optimal code. > 2- Good use of polymorphic types. > 3- Good use of higher-order functions. > 4- Good use of Haskell's common (and uncommon) abstractions. > 5- Coding style (I'm finding it hard to let go of the function types :p) > 6- Good code structuring allowing for reuse and updates. > 7- Best options to give to the compiler. > 8- Anything else that comes to your mind! > > So I'd really appreciate your feedback :) > > This is the wikipedia reference for the game of life: https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life > > And this is the code: > > START OF CODE > -- Game of life Haskell Implementation > > import Data.List > import Control.Monad.State > import qualified Data.Map as M > > -- The cell state is isomorphic to Bool. > type CellState = Bool > > -- The coordinates of a cell > type Coord = (Int, Int) > > -- The board size is (length, width) > type Size = (Int, Int) > > -- The state of the board is simply the coordinates of its live cells > type Board = [Coord] > > -- The state carried in the State Monad, used to count tags for cells > type TallyState = State (M.Map Coord (CellState, Int)) () > > -- The type of the game rules > type Rules = (Coord, CellState, Int) -> CellState > > -- The type for the neighbor functions > type Neighbors = Coord -> [Coord] > > -- Tally the live neighbors of live cells and relevant dead cells > tallyBoard :: Neighbors -> Board -> TallyState > tallyBoard nb = mapM_ $ tallyCoord nb > > -- Tally a live cell: Set its state to True (alive) and tag its neighbors > -- This function takes the neighbors function as its first argument. We can use > -- different neighbor functions to change the zone of influence of a cell > tallyCoord :: Neighbors -> Coord -> TallyState > tallyCoord nb c = do > let merge (a1,b1) (a2,b2) = (a1 || a2, b1 + b2) > s <- get > let s' = M.insertWith merge c (True, 0) s > let neighbors = nb c > put $ foldl' (\acc x -> M.insertWith merge x (False, 1) acc) s' neighbors > > -- Extract the results from a TallyState > toResults :: TallyState -> [(Coord, CellState, Int)] > toResults s = map flatten . M.toList . execState s $ M.empty > where flatten (x,(y,z)) = (x,y,z) > > -- Use A Rules and Neighbors function to advance the board one step in time > advance :: Rules -> Neighbors -> Board -> Board > advance rules nb = map first . filter rules . toResults . tallyBoard nb > where first (x,_,_) = x > > -- The standard neighbors function > stdNeighbors :: Neighbors > stdNeighbors (x,y) = > [ (a,b) > | a <- [x-1, x, x+1] > , b <- [y-1, y, y+1] > , (a /= x) || (b /= y) > ] > > -- Standard game rules > stdRules :: Size -> Rules > stdRules (a,b) ((x,y),_,_) > | (x < 0) || (y < 0) || (x >= a) || (y >= b) = False > stdRules _ (_,True,c) > | (c == 2) || (c == 3) = True > | otherwise = False > stdRules _ (_,False,3) = True > stdRules _ _ = False > > > -- Main loop > loop :: (Board -> Board) -> Board -> IO () > loop f b = do > print b > unless (null b) $ loop f (f b) > > -- Main function > main :: IO () > main = do > putStrLn "Choose board size (x,y)" > input <- getLine > putStrLn "Choose starting points" > start <- getLine > putStrLn "Game:" > let size = read input > let rules = stdRules size > let initial = map read . words $ start > let game = advance rules stdNeighbors > loop game initial > > END OF CODE > > Thanks :) > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From michelhaber1994 at gmail.com Sun Feb 24 22:10:17 2019 From: michelhaber1994 at gmail.com (Michel Haber) Date: Sun, 24 Feb 2019 23:10:17 +0100 Subject: [Haskell-beginners] A game of life implementation In-Reply-To: <196550c6-471e-4c1a-a304-5f76984b508e@www.fastmail.com> References: <196550c6-471e-4c1a-a304-5f76984b508e@www.fastmail.com> Message-ID: Thanks for the suggestions, I will update the code :) Is it better to go with parallelizing the code? Or using ST for some mutations? On Sun, Feb 24, 2019, 8:59 PM Utku Demir wrote: > Looks great to me, I especially liked how you extracted 'stdRules' out :). > A few minor suggestions: > > * Instead of type aliases, you can try using 'newtype' wrappers or > concrete data types. e.g `newtype Size = Size (Int, Int)` or `data Size = > Size Int Int`. This way it'll be a compiler error when you accidently pass > a Size when actually a Coord is expected etc. You might need to do a bit of > wrapping/unwrapping but it's usually worth the type safety they bring. > * This is a bit contraversial, but you can use some light point-free > notation in a few places. e.g `tallyBoard = mapM_ . tallyCoord` and > `toResults = map flatten . M.toList . flip execState M.empty` > * 'read' is a partial function, an especially when using external inputs > it'd be better to use 'readMaybe', or a proper parser like 'trifecta' for > more complex inputs. > > -- > Utku Demir > > > > On Sun, Feb 24, 2019, at 4:37 AM, Michel Haber wrote: > > Hello everyone, > I'm a new haskeller, and (like many others, I assume) I thought I'd try my > hand > at Conway's "Game of Life". > > So here is my code that seems to work (up to this point). > I am looking for feedback in order to improve my Haskell code on all > levels. > Especially (In no particular order): > 0- Find and fix bugs > 1- Write more performance optimal code. > 2- Good use of polymorphic types. > 3- Good use of higher-order functions. > 4- Good use of Haskell's common (and uncommon) abstractions. > 5- Coding style (I'm finding it hard to let go of the function types :p) > 6- Good code structuring allowing for reuse and updates. > 7- Best options to give to the compiler. > 8- Anything else that comes to your mind! > > So I'd really appreciate your feedback :) > > This is the wikipedia reference for the game of life: > https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life > > And this is the code: > > START OF CODE > -- Game of life Haskell Implementation > > import Data.List > import Control.Monad.State > import qualified Data.Map as M > > -- The cell state is isomorphic to Bool. > type CellState = Bool > > -- The coordinates of a cell > type Coord = (Int, Int) > > -- The board size is (length, width) > type Size = (Int, Int) > > -- The state of the board is simply the coordinates of its live cells > type Board = [Coord] > > -- The state carried in the State Monad, used to count tags for cells > type TallyState = State (M.Map Coord (CellState, Int)) () > > -- The type of the game rules > type Rules = (Coord, CellState, Int) -> CellState > > -- The type for the neighbor functions > type Neighbors = Coord -> [Coord] > > -- Tally the live neighbors of live cells and relevant dead cells > tallyBoard :: Neighbors -> Board -> TallyState > tallyBoard nb = mapM_ $ tallyCoord nb > > -- Tally a live cell: Set its state to True (alive) and tag its neighbors > -- This function takes the neighbors function as its first argument. We > can use > -- different neighbor functions to change the zone of influence of a cell > tallyCoord :: Neighbors -> Coord -> TallyState > tallyCoord nb c = do > let merge (a1,b1) (a2,b2) = (a1 || a2, b1 + b2) > s <- get > let s' = M.insertWith merge c (True, 0) s > let neighbors = nb c > put $ foldl' (\acc x -> M.insertWith merge x (False, 1) acc) s' > neighbors > > -- Extract the results from a TallyState > toResults :: TallyState -> [(Coord, CellState, Int)] > toResults s = map flatten . M.toList . execState s $ M.empty > where flatten (x,(y,z)) = (x,y,z) > > -- Use A Rules and Neighbors function to advance the board one step in time > advance :: Rules -> Neighbors -> Board -> Board > advance rules nb = map first . filter rules . toResults . tallyBoard nb > where first (x,_,_) = x > > -- The standard neighbors function > stdNeighbors :: Neighbors > stdNeighbors (x,y) = > [ (a,b) > | a <- [x-1, x, x+1] > , b <- [y-1, y, y+1] > , (a /= x) || (b /= y) > ] > > -- Standard game rules > stdRules :: Size -> Rules > stdRules (a,b) ((x,y),_,_) > | (x < 0) || (y < 0) || (x >= a) || (y >= b) = False > stdRules _ (_,True,c) > | (c == 2) || (c == 3) = True > | otherwise = False > stdRules _ (_,False,3) = True > stdRules _ _ = False > > > -- Main loop > loop :: (Board -> Board) -> Board -> IO () > loop f b = do > print b > unless (null b) $ loop f (f b) > > -- Main function > main :: IO () > main = do > putStrLn "Choose board size (x,y)" > input <- getLine > putStrLn "Choose starting points" > start <- getLine > putStrLn "Game:" > let size = read input > let rules = stdRules size > let initial = map read . words $ start > let game = advance rules stdNeighbors > loop game initial > > END OF CODE > > Thanks :) > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From shaegis at gmail.com Tue Feb 26 06:47:59 2019 From: shaegis at gmail.com (S. H. Aegis) Date: Tue, 26 Feb 2019 15:47:59 +0900 Subject: [Haskell-beginners] Error Message: Can not find C library. How can I do this? Message-ID: Hello. I’m new to stack & FFI. I created a dll file by http://www.mingw.org/wiki/sampleDLL And I put all files into dll folder. (Those files are example_dll.cpp, example_dll.dll, example_dll.h, example_dll.o, example_exe.cpp, libexample_dll.a) I test example_exe.exe file, and confirmed that works. (Windows7 Pro, stack 1.9.3) executables: test2-exe: main: Main.hs source-dirs: app ghc-options: - -threaded - -rtsopts - -with-rtsopts=-N dependencies: - test2 extra-libraries: - example_dll.a extra-lib-dirs: - dll # Extra directories used by stack for building extra-include-dirs: - dll extra-lib-dirs: - dll {-# LANGUAGE ForeignFunctionInterface #-} module Main where -- import Lib import Foreign foreign import ccall "example_dll.h hello" c_hello :: IO() main :: IO () main = c_hello #include #include "example_dll.h" __stdcall void hello(const char *s) { printf("Hello %s\n", s); } int Double(int x) { return 2 * x; } void CppFunc(void) { puts("CppFunc"); } void MyClass::func(void) { puts("MyClass.func()"); } When I try to stack build, I get error messages. *C:\Users\shaegis\Documents\Haskell\test2\dll>stack build* *Building all executables for `test2' once. After a successful build of all of them, only specified executables will be rebuilt.* *test2-0.1.0.0: configure (lib + exe)* *Configuring test2-0.1.0.0...* *Cabal-simple_Z6RU0evB_2.4.0.1_ghc-8.6.3.exe: Missing dependency on a foreign* *library:* ** Missing (or bad) C library: example_dll.a* *This problem can usually be solved by installing the system package that* *provides this library (you may need the "-dev" version). If the library is* *already installed but in a non-standard location then you can use the flags* *--extra-include-dirs= and --extra-lib-dirs= to specify where it is.If the* *library file does exist, it may contain errors that are caught by the C* *compiler at the preprocessing stage. In this case you can re-run configure* *with the verbosity flag -v3 to see the error messages.* *-- While building package test2-0.1.0.0 using:* * C:\sr\setup-exe-cache\x86_64-windows\Cabal-simple_Z6RU0evB_2.4.0.1_ghc-8.6.3.exe --builddir=.stack-work\dist\e626a42b configure --with-ghc=C:\Users\shaegis\AppData\Local\Programs\stack\x86_64-windows\ghc-8.6.3\bin\ghc.EXE --with-ghc-pkg=C:\Users\shaegis\AppData\Local\Programs\stack\x86_64-windows\ghc-8.6.3\bin\ghc-pkg.EXE --user --package-db=clear --package-db=global --package-db=C:\sr\snapshots\3233b5e2\pkgdb --package-db=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\pkgdb --libdir=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\lib --bindir=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\bin --datadir=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\share --libexecdir=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\libexec --sysconfdir=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\etc --docdir=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\doc\test2-0.1.0.0 --htmldir=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\doc\test2-0.1.0.0 --haddockdir=C:\Users\shaegis\Documents\Haskell\test2\.stack-work\install\784ab3f0\doc\test2-0.1.0.0 --dependency=base=base-4.12.0.0 --extra-include-dirs=C:\Users\shaegis\AppData\Local\Programs\stack\x86_64-windows\msys2-20180531\mingw64\include --extra-include-dirs=C:\Users\shaegis\Documents\Haskell\test2\dll --extra-lib-dirs=C:\Users\shaegis\AppData\Local\Programs\stack\x86_64-windows\msys2-20180531\mingw64\bin --extra-lib-dirs=C:\Users\shaegis\AppData\Local\Programs\stack\x86_64-windows\msys2-20180531\mingw64\lib --extra-lib-dirs=C:\Users\shaegis\Documents\Haskell\test2\dll --enable-tests --enable-benchmarks* *Process exited with code: ExitFailure 1* How can I fix this? I did a lot of things on the webpages, but I could not. Please, help me. Sincerely, S. Chang. -------------- next part -------------- An HTML attachment was scrubbed... URL: