From lanablack at amok.cc Thu Feb 1 21:23:49 2018 From: lanablack at amok.cc (Lana Black) Date: Thu, 1 Feb 2018 21:23:49 +0000 Subject: [Haskell-cafe] MonadBaseControl and Freer Message-ID: <60597a5e-f63b-a776-938b-1f4cabbbf8de@amok.cc> Hello, I have a problem with implementing a MonadBaseControl instance for freer monad (Eff from extensible-effects). Specifically, I don't really get what the associated type StM should be. As far as I understand, MonadBaseControl class does the following: captures the current state. Performs the action passed to lifeBaseWith or other wrapper functions. Returns the result wrapped in the captured state. Here's the instance I could come up with. instance (MonadBase m (Eff r), Typeable m, SetMember Lift (Lift m) r) => MonadBaseControl m (Eff r) where type StM (Eff r) a = Eff r a liftBaseWith f = lift (f return) restoreM = id It obviously doesn't work, but I currently have no idea how to fix it, because `Eff r a' contains the state that needs to be captured and cannot be decomposed without losing data as far as I can see. The code can be found in this branch: https://github.com/greydot/extensible-effects/tree/monadbasecontrol As a side matter, I couldn't find any tests for MonadBaseControl instances, and monad-control package itself lacks any tests whatsoever. I'm curious whether there's a way to test instance correctness without plugging it into working code, e.g. something using lifted-base, and hoping for the best. From johnw at newartisans.com Thu Feb 1 23:08:58 2018 From: johnw at newartisans.com (John Wiegley) Date: Thu, 01 Feb 2018 15:08:58 -0800 Subject: [Haskell-cafe] MonadBaseControl and Freer In-Reply-To: <60597a5e-f63b-a776-938b-1f4cabbbf8de@amok.cc> (Lana Black's message of "Thu, 1 Feb 2018 21:23:49 +0000") References: <60597a5e-f63b-a776-938b-1f4cabbbf8de@amok.cc> Message-ID: >>>>> "LB" == Lana Black writes: LB> As far as I understand, MonadBaseControl class does the following: LB> captures the current state. Performs the action passed to lifeBaseWith or LB> other wrapper functions. Returns the result wrapped in the captured state. LB> Here's the instance I could come up with. LB> instance (MonadBase m (Eff r), Typeable m, SetMember Lift (Lift m) r) => LB> MonadBaseControl m (Eff r) where LB> type StM (Eff r) a = Eff r a LB> liftBaseWith f = lift (f return) LB> restoreM = id LB> It obviously doesn't work, but I currently have no idea how to fix it, LB> because `Eff r a' contains the state that needs to be captured and cannot LB> be decomposed without losing data as far as I can see. Hmmm... all these type classes are getting in my way. I thought I had a good start here, but it's proving hard to use. Maybe others have an idea how to continue. {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module FreerQuestion where import Control.Monad.Base import Control.Monad.Freer import Control.Monad.Freer.Internal import Control.Monad.Freer.Reader import Control.Monad.Freer.State import Control.Monad.Trans.Class import Control.Monad.Trans.Control import Data.OpenUnion import Data.OpenUnion.Internal instance MonadBase m m => MonadBaseControl m (Eff '[m]) where type StM (Eff '[m]) a = a liftBaseWith f = sendM (f runM) restoreM = return instance (Data.OpenUnion.LastMember x (r ': s), Data.OpenUnion.Internal.FindElem x s (Reader e : r : s), MonadBase m x, MonadBaseControl m (Eff (r ': s))) => MonadBaseControl m (Eff (Reader e ': r : s)) where type StM (Eff (Reader e ': r ': s)) a = StM (Eff (r ': s)) a liftBaseWith f = do e <- ask raise $ liftBaseWith $ \runInBase -> f $ \k -> runInBase (runReader e k) restoreM = raise . restoreM instance (Data.OpenUnion.LastMember x (r ': s), MonadBase m x, Data.OpenUnion.Internal.FindElem x s (State e : r : s), MonadBaseControl m (Eff (r ': s))) => MonadBaseControl m (Eff (State e ': r : s)) where type StM (Eff (State e ': r ': s)) a = StM (Eff (r ': s)) (a, e) liftBaseWith f = do e <- get @e raise $ liftBaseWith $ \runInBase -> f $ \k -> runInBase (runState e k) restoreM x = do (a, e :: e) <- raise (restoreM x) put e return a foo :: (Member (Reader Int) r, Member (State Int) r, Member IO r) => Eff r () foo = do r <- ask @Int put @Int 1000 () <- control $ \runInBase -> do putStrLn "In IO!" s' <- runInBase $ do put @Int 2000 putStrLn "Back in IO!" return s' s <- get @Int send @IO $ print s main :: IO () main = runM . evalState (200 :: Int) . runReader (10 :: Int) $ foo -- John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 From lysxia at gmail.com Fri Feb 2 00:24:11 2018 From: lysxia at gmail.com (Li-yao Xia) Date: Thu, 1 Feb 2018 19:24:11 -0500 Subject: [Haskell-cafe] MonadBaseControl and Freer In-Reply-To: References: <60597a5e-f63b-a776-938b-1f4cabbbf8de@amok.cc> Message-ID: Since the MonadBase superclass is in the way, you could define a custom (EffMonadBaseControl m r) with no superclass (or at least not that one) and then instance (MonadBase m (Eff r), EffMonadBaseControl m r) => MonadBaseControl m (Eff r) (Here I also factored out Eff because why not.) Another way may be to have MonadBase instances for Eff to follow the same structure of going through one effect at a time, instead of jumping to the last element directly via the OpenUnion API as freer-simple does. On 02/01/2018 06:08 PM, John Wiegley wrote: >>>>>> "LB" == Lana Black writes: > > LB> As far as I understand, MonadBaseControl class does the following: > LB> captures the current state. Performs the action passed to lifeBaseWith or > LB> other wrapper functions. Returns the result wrapped in the captured state. > > LB> Here's the instance I could come up with. > > LB> instance (MonadBase m (Eff r), Typeable m, SetMember Lift (Lift m) r) => > LB> MonadBaseControl m (Eff r) where > LB> type StM (Eff r) a = Eff r a > LB> liftBaseWith f = lift (f return) > LB> restoreM = id > > LB> It obviously doesn't work, but I currently have no idea how to fix it, > LB> because `Eff r a' contains the state that needs to be captured and cannot > LB> be decomposed without losing data as far as I can see. > > Hmmm... all these type classes are getting in my way. I thought I had a good > start here, but it's proving hard to use. Maybe others have an idea how to > continue. > > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE FlexibleContexts #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE ScopedTypeVariables #-} > {-# LANGUAGE TupleSections #-} > {-# LANGUAGE TypeApplications #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE TypeOperators #-} > {-# LANGUAGE UndecidableInstances #-} > > module FreerQuestion where > > import Control.Monad.Base > import Control.Monad.Freer > import Control.Monad.Freer.Internal > import Control.Monad.Freer.Reader > import Control.Monad.Freer.State > import Control.Monad.Trans.Class > import Control.Monad.Trans.Control > import Data.OpenUnion > import Data.OpenUnion.Internal > > instance MonadBase m m => MonadBaseControl m (Eff '[m]) where > type StM (Eff '[m]) a = a > liftBaseWith f = sendM (f runM) > restoreM = return > > instance (Data.OpenUnion.LastMember x (r ': s), > Data.OpenUnion.Internal.FindElem x s (Reader e : r : s), > MonadBase m x, > MonadBaseControl m (Eff (r ': s))) > => MonadBaseControl m (Eff (Reader e ': r : s)) where > type StM (Eff (Reader e ': r ': s)) a = StM (Eff (r ': s)) a > liftBaseWith f = do > e <- ask > raise $ liftBaseWith $ \runInBase -> > f $ \k -> runInBase (runReader e k) > restoreM = raise . restoreM > > instance (Data.OpenUnion.LastMember x (r ': s), > MonadBase m x, > Data.OpenUnion.Internal.FindElem x s (State e : r : s), > MonadBaseControl m (Eff (r ': s))) > => MonadBaseControl m (Eff (State e ': r : s)) where > type StM (Eff (State e ': r ': s)) a = StM (Eff (r ': s)) (a, e) > liftBaseWith f = do > e <- get @e > raise $ liftBaseWith $ \runInBase -> > f $ \k -> runInBase (runState e k) > restoreM x = do > (a, e :: e) <- raise (restoreM x) > put e > return a > > foo :: (Member (Reader Int) r, Member (State Int) r, Member IO r) => Eff r () > foo = do > r <- ask @Int > put @Int 1000 > () <- control $ \runInBase -> do > putStrLn "In IO!" > s' <- runInBase $ do > put @Int 2000 > putStrLn "Back in IO!" > return s' > s <- get @Int > send @IO $ print s > > main :: IO () > main = runM . evalState (200 :: Int) . runReader (10 :: Int) $ foo > > -- > John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F > http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > From lanablack at amok.cc Fri Feb 2 14:06:20 2018 From: lanablack at amok.cc (Lana Black) Date: Fri, 2 Feb 2018 14:06:20 +0000 Subject: [Haskell-cafe] MonadBaseControl and Freer In-Reply-To: References: <60597a5e-f63b-a776-938b-1f4cabbbf8de@amok.cc> Message-ID: On 01/02/18 23:08, John Wiegley wrote: > Hmmm... all these type classes are getting in my way. I thought I had a good > start here, but it's proving hard to use. Maybe others have an idea how to > continue. > > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE FlexibleContexts #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE ScopedTypeVariables #-} > {-# LANGUAGE TupleSections #-} > {-# LANGUAGE TypeApplications #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE TypeOperators #-} > {-# LANGUAGE UndecidableInstances #-} > > module FreerQuestion where > > import Control.Monad.Base > import Control.Monad.Freer > import Control.Monad.Freer.Internal > import Control.Monad.Freer.Reader > import Control.Monad.Freer.State > import Control.Monad.Trans.Class > import Control.Monad.Trans.Control > import Data.OpenUnion > import Data.OpenUnion.Internal > > instance MonadBase m m => MonadBaseControl m (Eff '[m]) where > type StM (Eff '[m]) a = a > liftBaseWith f = sendM (f runM) > restoreM = return > > instance (Data.OpenUnion.LastMember x (r ': s), > Data.OpenUnion.Internal.FindElem x s (Reader e : r : s), > MonadBase m x, > MonadBaseControl m (Eff (r ': s))) > => MonadBaseControl m (Eff (Reader e ': r : s)) where > type StM (Eff (Reader e ': r ': s)) a = StM (Eff (r ': s)) a > liftBaseWith f = do > e <- ask > raise $ liftBaseWith $ \runInBase -> > f $ \k -> runInBase (runReader e k) > restoreM = raise . restoreM > > instance (Data.OpenUnion.LastMember x (r ': s), > MonadBase m x, > Data.OpenUnion.Internal.FindElem x s (State e : r : s), > MonadBaseControl m (Eff (r ': s))) > => MonadBaseControl m (Eff (State e ': r : s)) where > type StM (Eff (State e ': r ': s)) a = StM (Eff (r ': s)) (a, e) > liftBaseWith f = do > e <- get @e > raise $ liftBaseWith $ \runInBase -> > f $ \k -> runInBase (runState e k) > restoreM x = do > (a, e :: e) <- raise (restoreM x) > put e > return a > > foo :: (Member (Reader Int) r, Member (State Int) r, Member IO r) => Eff r () > foo = do > r <- ask @Int > put @Int 1000 > () <- control $ \runInBase -> do > putStrLn "In IO!" > s' <- runInBase $ do > put @Int 2000 > putStrLn "Back in IO!" > return s' > s <- get @Int > send @IO $ print s > > main :: IO () > main = runM . evalState (200 :: Int) . runReader (10 :: Int) $ foo Writing a separate instance for each effect didn't occur to me for some reason. Thank you! I'll try to follow this path. From stefan.wehr at gmail.com Sat Feb 3 19:04:07 2018 From: stefan.wehr at gmail.com (Stefan Wehr) Date: Sat, 3 Feb 2018 20:04:07 +0100 Subject: [Haskell-cafe] Call for Participation: BOB 2018 (February 23, Berlin) Message-ID: There are several Haskell-related talks and tutorials, see below for details! ================================================================ BOB 2018 Conference “What happens if we simply use what’s best?” February 23, 2018, Berlin http://bobkonf.de/2018/ Program: http://bobkonf.de/2018/en/program.html Registration: http://bobkonf.de/2018/en/registration.html ================================================================ BOB is the conference for developers, architects and decision-makers to explore technologies beyond the mainstream in software development, and to find the best tools available to software developers today. Our goal is for all participants of BOB to return home with new insights that enable them to improve their own software development experiences. The program features 14 talks and 8 tutorials on current topics: http://bobkonf.de/2018/en/program.html The subject range of talks includes functional programming, verticalization, formal methods, and data analytics. There will be two talks about Haskell: * Testing monadic programs using QuickCheck and state machine based models * New Hasql - a native Haskell Postgres driver faster than C The tutorials feature introductions to Haskell, Clojure, Livecoding, terminal programming in Haskell, Liquid Haskell, functional reactive programming, and domain-driven design. Leif Andersen will give the keynote talk. Registration is open online: http://bobkonf.de/2018/en/registration.html BOB cooperates with the :clojured conference on the following day. There is a registration discount available for participants of both events. http://www.clojured.de/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From yotam2206 at gmail.com Sun Feb 4 20:20:38 2018 From: yotam2206 at gmail.com (Yotam Ohad) Date: Sun, 4 Feb 2018 22:20:38 +0200 Subject: [Haskell-cafe] Yesod with lts-10.4 Message-ID: Hi, I'm trying to install yesod using stack and lts-10.4, but I get the following result: stack install yesod aeson-1.2.3.0: configure aeson-1.2.3.0: build Progress: 1/26 -- While building custom Setup.hs for package aeson-1.2.3.0 using: /home/yotam/.stack/setup-exe-cache/i386-linux-nopie/Cabal-simple_mPHDZzAJ_2.0.1.0_ghc-8.2.2 --builddir=.stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0 build --ghc-options " -ddump-hi -ddump-to-file -fdiagnostics-color=always" Process exited with code: ExitFailure 1 Logs have been written to: /home/yotam/TheMafsidan/.stack-work/logs/aeson-1.2.3.0.log Configuring aeson-1.2.3.0... Preprocessing library for aeson-1.2.3.0.. Building library for aeson-1.2.3.0.. [ 1 of 24] Compiling Data.Aeson.Compat ( Data/Aeson/Compat.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Compat.o ) [ 2 of 24] Compiling Data.Aeson.Internal.Functions ( Data/Aeson/Internal/Functions.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Internal/Functions.o ) [ 3 of 24] Compiling Data.Aeson.Parser.UnescapePure ( pure/Data/Aeson/Parser/UnescapePure.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/UnescapePure.o ) [ 4 of 24] Compiling Data.Aeson.Parser.Unescape ( Data/Aeson/Parser/Unescape.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Unescape.o ) [ 5 of 24] Compiling Data.Aeson.Types.Generic ( Data/Aeson/Types/Generic.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/Generic.o ) [ 6 of 24] Compiling Data.Aeson.Types.Internal ( Data/Aeson/Types/Internal.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/Internal.o ) [ 7 of 24] Compiling Data.Aeson.Parser.Internal ( Data/Aeson/Parser/Internal.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Internal.o ) [ 8 of 24] Compiling Data.Aeson.Parser ( Data/Aeson/Parser.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser.o ) [ 9 of 24] Compiling Data.Attoparsec.Time.Internal ( attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Attoparsec/Time/Internal.o ) [10 of 24] Compiling Data.Attoparsec.Time ( attoparsec-iso8601/Data/Attoparsec/Time.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Attoparsec/Time.o ) [11 of 24] Compiling Data.Aeson.Parser.Time ( Data/Aeson/Parser/Time.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Time.o ) [12 of 24] Compiling Data.Aeson.Types.FromJSON ( Data/Aeson/Types/FromJSON.hs, .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/FromJSON.o ) /tmp/stack15763/aeson-1.2.3.0/Data/Aeson/Types/FromJSON.hs:108:1: error: Bad interface file: /home/yotam/.stack/snapshots/i386-linux-nopie/lts-10.4/8.2.2/lib/i386-linux-ghc-8.2.2/time-locale-compat-0.1.1.3-EeYCrKbfyeWLGJYmfXhrGy/Data/Time/Locale/Compat.hi Data.Binary.getPrim: end of file | 108 | import Data.Time.Locale.Compat (defaultTimeLocale) | ^^ Is this a matter of just waiting for packages to update to 8.2.2 or is it something I can change myself? Yotam -------------- next part -------------- An HTML attachment was scrubbed... URL: From iustin at k1024.org Sun Feb 4 21:25:45 2018 From: iustin at k1024.org (Iustin Pop) Date: Sun, 4 Feb 2018 22:25:45 +0100 Subject: [Haskell-cafe] Yesod with lts-10.4 In-Reply-To: References: Message-ID: <20180204212545.GA30138@teal.hq.k1024.org> On 2018-02-04 22:20:38, Yotam Ohad wrote: > Hi, > I'm trying to install yesod using stack and lts-10.4, but I get the > following result: > stack install yesod > aeson-1.2.3.0: configure > aeson-1.2.3.0: build > Progress: 1/26 > -- While building custom Setup.hs for package aeson-1.2.3.0 using: > > /home/yotam/.stack/setup-exe-cache/i386-linux-nopie/Cabal-simple_mPHDZzAJ_2.0.1.0_ghc-8.2.2 > --builddir=.stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0 build > --ghc-options " -ddump-hi -ddump-to-file -fdiagnostics-color=always" > Process exited with code: ExitFailure 1 > Logs have been written to: > /home/yotam/TheMafsidan/.stack-work/logs/aeson-1.2.3.0.log … For what is worth, I'm using aeson (1.2.3.0) with lts-10.4 as a dependency in my code (together with yesod), and I don't see this problem: $ stack list-dependencies|grep -e aeson -e yesod aeson 1.2.3.0 aeson-compat 0.3.7.1 classy-prelude-yesod 1.3.1 yesod 1.4.5 yesod-auth 1.4.21 yesod-auth-hashdb 1.6.2 yesod-core 1.4.37.3 yesod-form 1.4.16 yesod-newsfeed 1.6 yesod-persistent 1.4.3 yesod-static 1.5.3.1 $ stack build - works Strange… iustin From sibi at psibi.in Sun Feb 4 21:45:07 2018 From: sibi at psibi.in (Sibi) Date: Sun, 04 Feb 2018 21:45:07 +0000 Subject: [Haskell-cafe] Yesod with lts-10.4 In-Reply-To: References: Message-ID: Is there any reason why you are trying to install rather than do a build? Regards, On Mon, Feb 5, 2018, 1:54 AM Yotam Ohad wrote: > Hi, > I'm trying to install yesod using stack and lts-10.4, but I get the > following result: > stack install yesod > aeson-1.2.3.0: configure > aeson-1.2.3.0: build > Progress: 1/26 > -- While building custom Setup.hs for package aeson-1.2.3.0 using: > > /home/yotam/.stack/setup-exe-cache/i386-linux-nopie/Cabal-simple_mPHDZzAJ_2.0.1.0_ghc-8.2.2 > --builddir=.stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0 build > --ghc-options " -ddump-hi -ddump-to-file -fdiagnostics-color=always" > Process exited with code: ExitFailure 1 > Logs have been written to: > /home/yotam/TheMafsidan/.stack-work/logs/aeson-1.2.3.0.log > > Configuring aeson-1.2.3.0... > Preprocessing library for aeson-1.2.3.0.. > Building library for aeson-1.2.3.0.. > [ 1 of 24] Compiling Data.Aeson.Compat ( Data/Aeson/Compat.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Compat.o ) > [ 2 of 24] Compiling Data.Aeson.Internal.Functions ( > Data/Aeson/Internal/Functions.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Internal/Functions.o > ) > [ 3 of 24] Compiling Data.Aeson.Parser.UnescapePure ( > pure/Data/Aeson/Parser/UnescapePure.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/UnescapePure.o > ) > [ 4 of 24] Compiling Data.Aeson.Parser.Unescape ( > Data/Aeson/Parser/Unescape.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Unescape.o > ) > [ 5 of 24] Compiling Data.Aeson.Types.Generic ( > Data/Aeson/Types/Generic.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/Generic.o > ) > [ 6 of 24] Compiling Data.Aeson.Types.Internal ( > Data/Aeson/Types/Internal.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/Internal.o > ) > [ 7 of 24] Compiling Data.Aeson.Parser.Internal ( > Data/Aeson/Parser/Internal.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Internal.o > ) > [ 8 of 24] Compiling Data.Aeson.Parser ( Data/Aeson/Parser.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser.o ) > [ 9 of 24] Compiling Data.Attoparsec.Time.Internal ( > attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Attoparsec/Time/Internal.o > ) > [10 of 24] Compiling Data.Attoparsec.Time ( > attoparsec-iso8601/Data/Attoparsec/Time.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Attoparsec/Time.o > ) > [11 of 24] Compiling Data.Aeson.Parser.Time ( > Data/Aeson/Parser/Time.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Time.o > ) > [12 of 24] Compiling Data.Aeson.Types.FromJSON ( > Data/Aeson/Types/FromJSON.hs, > .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/FromJSON.o > ) > > /tmp/stack15763/aeson-1.2.3.0/Data/Aeson/Types/FromJSON.hs:108:1: > error: > Bad interface file: > /home/yotam/.stack/snapshots/i386-linux-nopie/lts-10.4/8.2.2/lib/i386-linux-ghc-8.2.2/time-locale-compat-0.1.1.3-EeYCrKbfyeWLGJYmfXhrGy/Data/Time/Locale/Compat.hi > Data.Binary.getPrim: end of file > | > 108 | import Data.Time.Locale.Compat (defaultTimeLocale) > | ^^ > > Is this a matter of just waiting for packages to update to 8.2.2 or is it > something I can change myself? > > Yotam > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From adam at bergmark.nl Sun Feb 4 23:04:39 2018 From: adam at bergmark.nl (Adam Bergmark) Date: Sun, 04 Feb 2018 23:04:39 +0000 Subject: [Haskell-cafe] Yesod with lts-10.4 In-Reply-To: References: Message-ID: Hi Yotam, My guess is that some file has been corrupted. I'd remove `~/.stack` (you don't have to remove all of it, but i'm not sure exactly which parts need to go) and your project's `.stack-work` to do a clean rebuild. Heavy handed, but it should work. HTH, Adam On Sun, 4 Feb 2018 at 22:50 Sibi wrote: > Is there any reason why you are trying to install rather than do a build? > > Regards, > > > On Mon, Feb 5, 2018, 1:54 AM Yotam Ohad wrote: > >> Hi, >> I'm trying to install yesod using stack and lts-10.4, but I get the >> following result: >> stack install yesod >> aeson-1.2.3.0: configure >> aeson-1.2.3.0: build >> Progress: 1/26 >> -- While building custom Setup.hs for package aeson-1.2.3.0 using: >> >> /home/yotam/.stack/setup-exe-cache/i386-linux-nopie/Cabal-simple_mPHDZzAJ_2.0.1.0_ghc-8.2.2 >> --builddir=.stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0 build >> --ghc-options " -ddump-hi -ddump-to-file -fdiagnostics-color=always" >> Process exited with code: ExitFailure 1 >> Logs have been written to: >> /home/yotam/TheMafsidan/.stack-work/logs/aeson-1.2.3.0.log >> >> Configuring aeson-1.2.3.0... >> Preprocessing library for aeson-1.2.3.0.. >> Building library for aeson-1.2.3.0.. >> [ 1 of 24] Compiling Data.Aeson.Compat ( Data/Aeson/Compat.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Compat.o ) >> [ 2 of 24] Compiling Data.Aeson.Internal.Functions ( >> Data/Aeson/Internal/Functions.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Internal/Functions.o >> ) >> [ 3 of 24] Compiling Data.Aeson.Parser.UnescapePure ( >> pure/Data/Aeson/Parser/UnescapePure.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/UnescapePure.o >> ) >> [ 4 of 24] Compiling Data.Aeson.Parser.Unescape ( >> Data/Aeson/Parser/Unescape.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Unescape.o >> ) >> [ 5 of 24] Compiling Data.Aeson.Types.Generic ( >> Data/Aeson/Types/Generic.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/Generic.o >> ) >> [ 6 of 24] Compiling Data.Aeson.Types.Internal ( >> Data/Aeson/Types/Internal.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/Internal.o >> ) >> [ 7 of 24] Compiling Data.Aeson.Parser.Internal ( >> Data/Aeson/Parser/Internal.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Internal.o >> ) >> [ 8 of 24] Compiling Data.Aeson.Parser ( Data/Aeson/Parser.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser.o ) >> [ 9 of 24] Compiling Data.Attoparsec.Time.Internal ( >> attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Attoparsec/Time/Internal.o >> ) >> [10 of 24] Compiling Data.Attoparsec.Time ( >> attoparsec-iso8601/Data/Attoparsec/Time.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Attoparsec/Time.o >> ) >> [11 of 24] Compiling Data.Aeson.Parser.Time ( >> Data/Aeson/Parser/Time.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Time.o >> ) >> [12 of 24] Compiling Data.Aeson.Types.FromJSON ( >> Data/Aeson/Types/FromJSON.hs, >> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/FromJSON.o >> ) >> >> /tmp/stack15763/aeson-1.2.3.0/Data/Aeson/Types/FromJSON.hs:108:1: >> error: >> Bad interface file: >> /home/yotam/.stack/snapshots/i386-linux-nopie/lts-10.4/8.2.2/lib/i386-linux-ghc-8.2.2/time-locale-compat-0.1.1.3-EeYCrKbfyeWLGJYmfXhrGy/Data/Time/Locale/Compat.hi >> Data.Binary.getPrim: end of file >> | >> 108 | import Data.Time.Locale.Compat (defaultTimeLocale) >> | ^^ >> >> Is this a matter of just waiting for packages to update to 8.2.2 or is it >> something I can change myself? >> >> Yotam >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From harendra.kumar at gmail.com Mon Feb 5 05:02:30 2018 From: harendra.kumar at gmail.com (Harendra Kumar) Date: Mon, 5 Feb 2018 10:32:30 +0530 Subject: [Haskell-cafe] Fwd: rolling span and groupBy for lists In-Reply-To: References: Message-ID: Hi, I am looking for the decision making authority or a place where questions about haskell libraries like in the email below can be asked or answered. ghc-devs told me that their list is not the right place for this and redirected me to haskell-cafe or libraries at haskell.org. I tried sending an email to libraries at haskell.org but that seems to be a closed list, my email got rejected, so that also does not seem like the right place. Is haskell cafe the right place? I was under the impression that haskell-cafe is for general discussions and not an owner of any of the libraries or any other haskell code. Are there any other mailing lists that I am missing? I can raise a ticket at ghc trac but I guess that cannot be the primary way to ask simple questions. -harendra ---------- Forwarded message ---------- From: Date: 5 February 2018 at 09:34 Subject: Re: rolling span and groupBy for lists To: harendra.kumar at gmail.com You are not allowed to post to this mailing list, and your message has been automatically rejected. If you think that your messages are being rejected in error, contact the mailing list owner at libraries-owner at haskell.org. ---------- Forwarded message ---------- From: Harendra Kumar To: David Feuer , libraries Cc: ghc-devs at haskell.org Bcc: Date: Mon, 5 Feb 2018 10:07:55 +0530 Subject: Re: rolling span and groupBy for lists I was mainly asking if it makes sense to include these functions in base/Data.List. Since the base package is maintained and ships along with ghc, and the issues are also raised at ghc trac I thought this is the right list. I am copying to libraries at haskell.org as well. -harendra On 5 February 2018 at 09:53, David Feuer wrote: > This is the wrong list. You probably meant to email haskell-cafe or > perhaps libraries at haskell.org. > > > > David Feuer > Well-Typed, LLP > > -------- Original message -------- > From: Harendra Kumar > Date: 2/4/18 10:50 PM (GMT-05:00) > To: ghc-devs at haskell.org > Subject: rolling span and groupBy for lists > > Hi, > > For a small problem, I was looking for a groupBy like function that groups > based on a predicate on successive elements but I could not find one. I > wrote these little functions for that purpose: > > -- | Like span, but with a predicate that compares two successive elements. > The > -- span ends when the two successive elements do not satisfy the predicate. > rollingSpan :: (a -> a -> Bool) -> [a] -> ([a], [a]) > rollingSpan _ xs@[] = (xs, xs) > rollingSpan _ xs@[_] = (xs, []) > rollingSpan p (x1:xs@(x2:_)) > | p x1 x2 = > let (ys, zs) = rollingSpan p xs > in (x1 : ys, zs) > | otherwise = ([x1], xs) > > -- | Like 'groupBy' but with a predicate that compares two successive > elements. > -- A group ends when two successive elements do not satisfy the predicate. > rollingGroupBy :: (a -> a -> Bool) -> [a] -> [[a]] > rollingGroupBy _ [] = [] > rollingGroupBy cmp xs = > let (ys, zs) = rollingSpan cmp xs > in ys : rollingGroupBy cmp zs > > Are there any existing functions that serve this purpose or is there any > simpler way to achieve such functionality? If not, where is the right place > for these, if any. Can they be included in Data.List in base? > > Thanks, > Harendra > -------------- next part -------------- An HTML attachment was scrubbed... URL: From markus.l2ll at gmail.com Mon Feb 5 06:35:13 2018 From: markus.l2ll at gmail.com (=?UTF-8?B?TWFya3VzIEzDpGxs?=) Date: Mon, 5 Feb 2018 07:35:13 +0100 Subject: [Haskell-cafe] Fwd: rolling span and groupBy for lists In-Reply-To: References: Message-ID: Hi Harendra -- I think you just need to register to libraries at haskell.org to post there. On Mon, Feb 5, 2018 at 6:02 AM, Harendra Kumar wrote: > Hi, > > > I am looking for the decision making authority or a place where questions > about haskell libraries like in the email below can be asked or answered. > ghc-devs told me that their list is not the right place for this and > redirected me to haskell-cafe or libraries at haskell.org. I tried sending > an email to libraries at haskell.org but that seems to be a closed list, my > email got rejected, so that also does not seem like the right place. Is > haskell cafe the right place? I was under the impression that > haskell-cafe is for general discussions and not an owner of any of the > libraries or any other haskell code. Are there any other mailing lists that > I am missing? I can raise a ticket at ghc trac but I guess that cannot be > the primary way to ask simple questions. > > -harendra > > ---------- Forwarded message ---------- > From: > Date: 5 February 2018 at 09:34 > Subject: Re: rolling span and groupBy for lists > To: harendra.kumar at gmail.com > > > You are not allowed to post to this mailing list, and your message has > been automatically rejected. If you think that your messages are > being rejected in error, contact the mailing list owner at > libraries-owner at haskell.org. > > > > > ---------- Forwarded message ---------- > From: Harendra Kumar > To: David Feuer , libraries > Cc: ghc-devs at haskell.org > Bcc: > Date: Mon, 5 Feb 2018 10:07:55 +0530 > Subject: Re: rolling span and groupBy for lists > I was mainly asking if it makes sense to include these functions in > base/Data.List. Since the base package is maintained and ships along with > ghc, and the issues are also raised at ghc trac I thought this is the right > list. I am copying to libraries at haskell.org as well. > > -harendra > > On 5 February 2018 at 09:53, David Feuer wrote: > >> This is the wrong list. You probably meant to email haskell-cafe or >> perhaps libraries at haskell.org. >> >> >> >> David Feuer >> Well-Typed, LLP >> >> -------- Original message -------- >> From: Harendra Kumar >> Date: 2/4/18 10:50 PM (GMT-05:00) >> To: ghc-devs at haskell.org >> Subject: rolling span and groupBy for lists >> >> Hi, >> >> For a small problem, I was looking for a groupBy like function that groups >> based on a predicate on successive elements but I could not find one. I >> wrote these little functions for that purpose: >> >> -- | Like span, but with a predicate that compares two successive >> elements. >> The >> -- span ends when the two successive elements do not satisfy the >> predicate. >> rollingSpan :: (a -> a -> Bool) -> [a] -> ([a], [a]) >> rollingSpan _ xs@[] = (xs, xs) >> rollingSpan _ xs@[_] = (xs, []) >> rollingSpan p (x1:xs@(x2:_)) >> | p x1 x2 = >> let (ys, zs) = rollingSpan p xs >> in (x1 : ys, zs) >> | otherwise = ([x1], xs) >> >> -- | Like 'groupBy' but with a predicate that compares two successive >> elements. >> -- A group ends when two successive elements do not satisfy the predicate. >> rollingGroupBy :: (a -> a -> Bool) -> [a] -> [[a]] >> rollingGroupBy _ [] = [] >> rollingGroupBy cmp xs = >> let (ys, zs) = rollingSpan cmp xs >> in ys : rollingGroupBy cmp zs >> >> Are there any existing functions that serve this purpose or is there any >> simpler way to achieve such functionality? If not, where is the right >> place >> for these, if any. Can they be included in Data.List in base? >> >> Thanks, >> Harendra >> > > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- Markus Läll -------------- next part -------------- An HTML attachment was scrubbed... URL: From harendra.kumar at gmail.com Mon Feb 5 06:46:44 2018 From: harendra.kumar at gmail.com (Harendra Kumar) Date: Mon, 5 Feb 2018 12:16:44 +0530 Subject: [Haskell-cafe] Fwd: rolling span and groupBy for lists In-Reply-To: References: Message-ID: I guessed so and subscribed, CCing again to the libraries list, hoping it will work this time. I think instead of saying "You are not allowed to post to this mailing list" the message should say "You need to subscribe to post to this list" and it can provide info about how to subscribe as well. Is it too problematic (spam?) if these lists are open to all? -harendra On 5 February 2018 at 12:05, Markus Läll wrote: > Hi Harendra -- I think you just need to register to libraries at haskell.org > to post there. > > On Mon, Feb 5, 2018 at 6:02 AM, Harendra Kumar > wrote: > >> Hi, >> >> >> I am looking for the decision making authority or a place where questions >> about haskell libraries like in the email below can be asked or answered. >> ghc-devs told me that their list is not the right place for this and >> redirected me to haskell-cafe or libraries at haskell.org. I tried sending >> an email to libraries at haskell.org but that seems to be a closed list, my >> email got rejected, so that also does not seem like the right place. Is >> haskell cafe the right place? I was under the impression that >> haskell-cafe is for general discussions and not an owner of any of the >> libraries or any other haskell code. Are there any other mailing lists that >> I am missing? I can raise a ticket at ghc trac but I guess that cannot be >> the primary way to ask simple questions. >> >> -harendra >> >> ---------- Forwarded message ---------- >> From: >> Date: 5 February 2018 at 09:34 >> Subject: Re: rolling span and groupBy for lists >> To: harendra.kumar at gmail.com >> >> >> You are not allowed to post to this mailing list, and your message has >> been automatically rejected. If you think that your messages are >> being rejected in error, contact the mailing list owner at >> libraries-owner at haskell.org. >> >> >> >> >> ---------- Forwarded message ---------- >> From: Harendra Kumar >> To: David Feuer , libraries >> Cc: ghc-devs at haskell.org >> Bcc: >> Date: Mon, 5 Feb 2018 10:07:55 +0530 >> Subject: Re: rolling span and groupBy for lists >> I was mainly asking if it makes sense to include these functions in >> base/Data.List. Since the base package is maintained and ships along with >> ghc, and the issues are also raised at ghc trac I thought this is the right >> list. I am copying to libraries at haskell.org as well. >> >> -harendra >> >> On 5 February 2018 at 09:53, David Feuer wrote: >> >>> This is the wrong list. You probably meant to email haskell-cafe or >>> perhaps libraries at haskell.org. >>> >>> >>> >>> David Feuer >>> Well-Typed, LLP >>> >>> -------- Original message -------- >>> From: Harendra Kumar >>> Date: 2/4/18 10:50 PM (GMT-05:00) >>> To: ghc-devs at haskell.org >>> Subject: rolling span and groupBy for lists >>> >>> Hi, >>> >>> For a small problem, I was looking for a groupBy like function that >>> groups >>> based on a predicate on successive elements but I could not find one. I >>> wrote these little functions for that purpose: >>> >>> -- | Like span, but with a predicate that compares two successive >>> elements. >>> The >>> -- span ends when the two successive elements do not satisfy the >>> predicate. >>> rollingSpan :: (a -> a -> Bool) -> [a] -> ([a], [a]) >>> rollingSpan _ xs@[] = (xs, xs) >>> rollingSpan _ xs@[_] = (xs, []) >>> rollingSpan p (x1:xs@(x2:_)) >>> | p x1 x2 = >>> let (ys, zs) = rollingSpan p xs >>> in (x1 : ys, zs) >>> | otherwise = ([x1], xs) >>> >>> -- | Like 'groupBy' but with a predicate that compares two successive >>> elements. >>> -- A group ends when two successive elements do not satisfy the >>> predicate. >>> rollingGroupBy :: (a -> a -> Bool) -> [a] -> [[a]] >>> rollingGroupBy _ [] = [] >>> rollingGroupBy cmp xs = >>> let (ys, zs) = rollingSpan cmp xs >>> in ys : rollingGroupBy cmp zs >>> >>> Are there any existing functions that serve this purpose or is there any >>> simpler way to achieve such functionality? If not, where is the right >>> place >>> for these, if any. Can they be included in Data.List in base? >>> >>> Thanks, >>> Harendra >>> >> >> >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > > > -- > Markus Läll > -------------- next part -------------- An HTML attachment was scrubbed... URL: From icfp.publicity at googlemail.com Mon Feb 5 07:33:31 2018 From: icfp.publicity at googlemail.com (Lindsey Kuper) Date: Sun, 04 Feb 2018 23:33:31 -0800 Subject: [Haskell-cafe] Second Call for Papers: PACMPL issue ICFP 2018 Message-ID: <5a7808cb63caa_2e33fe5a9c53be46013e@landin.local.mail> PACMPL Volume 2, Issue ICFP 2018 Call for Papers accepted papers to be invited for presentation at The 23rd ACM SIGPLAN International Conference on Functional Programming St. Louis, Missouri, USA http://icfp18.sigplan.org/ ### Important dates Submissions due: 16 March 2018 (Friday) Anywhere on Earth https://icfp18.hotcrp.com Author response: 2 May (Wednesday) - 4 May (Friday) 14:00 UTC Notification: 18 May (Friday) Final copy due: 22 June (Friday) Conference: 24 September (Monday) - 26 September (Wednesday) ### About PACMPL Proceedings of the ACM on Programming Languages (PACMPL ) is a Gold Open Access journal publishing research on all aspects of programming languages, from design to implementation and from mathematical formalisms to empirical studies. Each issue of the journal is devoted to a particular subject area within programming languages and will be announced through publicized Calls for Papers, like this one. ### Scope [PACMPL](https://pacmpl.acm.org/) issue ICFP 2018 seeks original papers on the art and science of functional programming. Submissions are invited on all topics from principles to practice, from foundations to features, and from abstraction to application. The scope includes all languages that encourage functional programming, including both purely applicative and imperative languages, as well as languages with objects, concurrency, or parallelism. Topics of interest include (but are not limited to): * *Language Design*: concurrency, parallelism, and distribution; modules; components and composition; metaprogramming; type systems; interoperability; domain-specific languages; and relations to imperative, object-oriented, or logic programming. * *Implementation*: abstract machines; virtual machines; interpretation; compilation; compile-time and run-time optimization; garbage collection and memory management; multi-threading; exploiting parallel hardware; interfaces to foreign functions, services, components, or low-level machine resources. * *Software-Development Techniques*: algorithms and data structures; design patterns; specification; verification; validation; proof assistants; debugging; testing; tracing; profiling. * *Foundations*: formal semantics; lambda calculus; rewriting; type theory; monads; continuations; control; state; effects; program verification; dependent types. * *Analysis and Transformation*: control-flow; data-flow; abstract interpretation; partial evaluation; program calculation. * *Applications*: symbolic computing; formal-methods tools; artificial intelligence; systems programming; distributed-systems and web programming; hardware design; databases; XML processing; scientific and numerical computing; graphical user interfaces; multimedia and 3D graphics programming; scripting; system administration; security. * *Education*: teaching introductory programming; parallel programming; mathematical proof; algebra. Submissions will be evaluated according to their relevance, correctness, significance, originality, and clarity. Each submission should explain its contributions in both general and technical terms, clearly identifying what has been accomplished, explaining why it is significant, and comparing it with previous work. The technical content should be accessible to a broad audience. PACMPL issue ICFP 2018 also welcomes submissions in two separate categories — Functional Pearls and Experience Reports — that must be marked as such at the time of submission and that need not report original research results. Detailed guidelines on both categories are given at the end of this call. Please contact the principal editor if you have questions or are concerned about the appropriateness of a topic. ### Preparation of submissions **Deadline**: The deadline for submissions is Friday, March 16, 2018, Anywhere on Earth (). This deadline will be strictly enforced. **Formatting**: Submissions must be in PDF format, printable in black and white on US Letter sized paper, and interpretable by common PDF tools. All submissions must adhere to the "ACM Small" template that is available (in both LaTeX and Word formats) from . For authors using LaTeX, a lighter-weight package, including only the essential files, is available from . There is a limit of 27 pages for a full paper or 14 pages for an Experience Report; in either case, the bibliography will not be counted against these limits. These page limits have been chosen to allow essentially the same amount of content with the new single-column format as was possible with the two-column format used in past ICFP conferences. Submissions that exceed the page limits or, for other reasons, do not meet the requirements for formatting, will be summarily rejected. See also PACMPL's Information and Guidelines for Authors at . **Submission**: Submissions will be accepted at Improved versions of a paper may be submitted at any point before the submission deadline using the same web interface. **Author Response Period**: Authors will have a 72-hour period, starting at 14:00 UTC on Wednesday, May 2, 2018, to read reviews and respond to them. **Supplementary Materials**: Authors have the option to attach supplementary material to a submission, on the understanding that reviewers may choose not to look at it. The material should be uploaded at submission time, as a single pdf or a tarball, not via a URL. This supplementary material may or may not be anonymized; if not anonymized, it will only be revealed to reviewers after they have submitted their review of the paper and learned the identity of the author(s). **Authorship Policies**: All submissions are expected to comply with the ACM Policies for Authorship that are detailed at . **Republication Policies**: Each submission must adhere to SIGPLAN's republication policy, as explained on the web at . **Resubmitted Papers**: Authors who submit a revised version of a paper that has previously been rejected by another conference have the option to attach an annotated copy of the reviews of their previous submission(s), explaining how they have addressed these previous reviews in the present submission. If a reviewer identifies him/herself as a reviewer of this previous submission and wishes to see how his/her comments have been addressed, the principal editor will communicate to this reviewer the annotated copy of his/her previous review. Otherwise, no reviewer will read the annotated copies of the previous reviews. ### Review Process This section outlines the two-stage process with lightweight double-blind reviewing that will be used to select papers for PACMPL issue ICFP 2018. We anticipate that there will be a need to clarify and expand on this process, and we will maintain a list of frequently asked questions and answers on the conference website to address common concerns. **PACMPL issue ICFP 2018 will employ a two-stage review process.** The first stage in the review process will assess submitted papers using the criteria stated above and will allow for feedback and input on initial reviews through the author response period mentioned previously. At the review meeting, a set of papers will be conditionally accepted and all other papers will be rejected. Authors will be notified of these decisions on May 18, 2018. Authors of conditionally accepted papers will be provided with committee reviews (just as in previous conferences) along with a set of mandatory revisions. After five weeks (June 22, 2018), the authors will provide a second submission. The second and final reviewing phase assesses whether the mandatory revisions have been adequately addressed by the authors and thereby determines the final accept/reject status of the paper. The intent and expectation is that the mandatory revisions can be addressed within five weeks and hence that conditionally accepted papers will in general be accepted in the second phase. The second submission should clearly identify how the mandatory revisions were addressed. To that end, the second submission must be accompanied by a cover letter mapping each mandatory revision request to specific parts of the paper. The cover letter will facilitate a quick second review, allowing for confirmation of final acceptance within two weeks. Conversely, the absence of a cover letter will be grounds for the paper’s rejection. **PACMPL issue ICFP 2018 will employ a lightweight double-blind reviewing process.** To facilitate this, submitted papers must adhere to two rules: 1. **author names and institutions must be omitted**, and 2. **references to authors' own related work should be in the third person** (e.g., not "We build on our previous work ..." but rather "We build on the work of ..."). The purpose of this process is to help the reviewers come to an initial judgement about the paper without bias, not to make it impossible for them to discover the authors if they were to try. Nothing should be done in the name of anonymity that weakens the submission or makes the job of reviewing the paper more difficult (e.g., important background references should not be omitted or anonymized). In addition, authors should feel free to disseminate their ideas or draft versions of their paper as they normally would. For instance, authors may post drafts of their papers on the web or give talks on their research ideas. ### Information for Authors of Accepted Papers * As a condition of acceptance, final versions of all papers must adhere to the new ACM Small format. The page limits for final versions of papers will be increased to ensure that authors have space to respond to reviewer comments and mandatory revisions. * Authors of accepted submissions will be required to agree to one of the three ACM licensing options: open access on payment of a fee (**recommended**, and SIGPLAN can cover the cost as described next); copyright transfer to ACM; or retaining copyright but granting ACM exclusive publication rights. Further information about ACM author rights is available from . * PACMPL is a Gold Open Access journal. It will be archived in ACM’s Digital Library, but no membership or fee is required for access. Gold Open Access has been made possible by generous funding through ACM SIGPLAN, which will cover all open access costs in the event authors cannot. Authors who can cover the costs may do so by paying an Article Processing Charge (APC). PACMPL, SIGPLAN, and ACM Headquarters are committed to exploring routes to making Gold Open Access publication both affordable and sustainable. * ACM offers authors a range of copyright options, one of which is Creative Commons CC-BY publication; this is the option recommended by the PACMPL editorial board. A reasoned argument in favour of this option can be found in the article [Why CC-BY?](https://oaspa.org/why-cc-by/) published by OASPA, the Open Access Scholarly Publishers Association. * We intend that the papers will be freely available for download from the ACM Digital Library in perpetuity via the OpenTOC mechanism. * ACM Author-Izer is a unique service that enables ACM authors to generate and post links on either their home page or institutional repository for visitors to download the definitive version of their articles from the ACM Digital Library at no charge. Downloads through Author-Izer links are captured in official ACM statistics, improving the accuracy of usage and impact measurements. Consistently linking to the definitive version of an ACM article should reduce user confusion over article versioning. After an article has been published and assigned to the appropriate ACM Author Profile pages, authors should visit to learn how to create links for free downloads from the ACM DL. * At least one author of each accepted submissions will be expected to attend and present their paper at the conference. The schedule for presentations will be determined and shared with authors after the full program has been selected. Presentations will be videotaped and released online if the presenter consents. * The official publication date is the date the papers are made available in the ACM Digital Library. This date may be up to *two weeks prior* to the first day of the conference. The official publication date affects the deadline for any patent filings related to published work. ### Artifact Evaluation Authors of papers that are conditionally accepted in the first phase of the review process will be encouraged (but not required) to submit supporting materials for Artifact Evaluation. These items will then be reviewed by an Artifact Evaluation Committee, separate from the paper Review Committee, whose task is to assess how the artifacts support the work described in the associated paper. Papers that go through the Artifact Evaluation process successfully will receive a seal of approval printed on the papers themselves. Authors of accepted papers will be encouraged to make the supporting materials publicly available upon publication of the papers, for example, by including them as "source materials" in the ACM Digital Library. An additional seal will mark papers whose artifacts are made available, as outlined in the ACM guidelines for artifact badging. Participation in Artifact Evaluation is voluntary and will not influence the final decision regarding paper acceptance. Further information about the motivations and expectations for Artifact Evaluation can be found at . ### Special categories of papers In addition to research papers, PACMPL issue ICFP solicits two kinds of papers that do not require original research contributions: Functional Pearls, which are full papers, and Experience Reports, which are limited to half the length of a full paper. Authors submitting such papers should consider the following guidelines. #### Functional Pearls A Functional Pearl is an elegant essay about something related to functional programming. Examples include, but are not limited to: * a new and thought-provoking way of looking at an old idea * an instructive example of program calculation or proof * a nifty presentation of an old or new data structure * an interesting application of functional programming techniques * a novel use or exposition of functional programming in the classroom While pearls often demonstrate an idea through the development of a short program, there is no requirement or expectation that they do so. Thus, they encompass the notions of theoretical and educational pearls. Functional Pearls are valued as highly and judged as rigorously as ordinary papers, but using somewhat different criteria. In particular, a pearl is not required to report original research, but, it should be concise, instructive, and entertaining. A pearl is likely to be rejected if its readers get bored, if the material gets too complicated, if too much specialized knowledge is needed, or if the writing is inelegant. The key to writing a good pearl is polishing. A submission that is intended to be treated as a pearl must be marked as such on the submission web page, and should contain the words "Functional Pearl" somewhere in its title or subtitle. These steps will alert reviewers to use the appropriate evaluation criteria. Pearls will be combined with ordinary papers, however, for the purpose of computing the conference's acceptance rate. #### Experience Reports The purpose of an Experience Report is to help create a body of published, refereed, citable evidence that functional programming really works — or to describe what obstacles prevent it from working. Possible topics for an Experience Report include, but are not limited to: * insights gained from real-world projects using functional programming * comparison of functional programming with conventional programming in the context of an industrial project or a university curriculum * project-management, business, or legal issues encountered when using functional programming in a real-world project * curricular issues encountered when using functional programming in education * real-world constraints that created special challenges for an implementation of a functional language or for functional programming in general An Experience Report is distinguished from a normal PACMPL issue ICFP paper by its title, by its length, and by the criteria used to evaluate it. * Both in the papers and in any citations, the title of each accepted Experience Report must begin with the words "Experience Report" followed by a colon. The acceptance rate for Experience Reports will be computed and reported separately from the rate for ordinary papers. * Experience Report submissions can be at most 12 pages long, excluding bibliography. * Each accepted Experience Report will be presented at the conference, but depending on the number of Experience Reports and regular papers accepted, authors of Experience reports may be asked to give shorter talks. * Because the purpose of Experience Reports is to enable our community to accumulate a body of evidence about the efficacy of functional programming, an acceptable Experience Report need not add to the body of knowledge of the functional-programming community by presenting novel results or conclusions. It is sufficient if the Report states a clear thesis and provides supporting evidence. The thesis must be relevant to ICFP, but it need not be novel. The review committee will accept or reject Experience Reports based on whether they judge the evidence to be convincing. Anecdotal evidence will be acceptable provided it is well argued and the author explains what efforts were made to gather as much evidence as possible. Typically, more convincing evidence is obtained from papers which show how functional programming was used than from papers which only say that functional programming was used. The most convincing evidence often includes comparisons of situations before and after the introduction or discontinuation of functional programming. Evidence drawn from a single person's experience may be sufficient, but more weight will be given to evidence drawn from the experience of groups of people. An Experience Report should be short and to the point: it should make a claim about how well functional programming worked on a particular project and why, and produce evidence to substantiate this claim. If functional programming worked in this case in the same ways it has worked for others, the paper need only summarize the results — the main part of the paper should discuss how well it worked and in what context. Most readers will not want to know all the details of the project and its implementation, but the paper should characterize the project and its context well enough so that readers can judge to what degree this experience is relevant to their own projects. The paper should take care to highlight any unusual aspects of the project. Specifics about the project are more valuable than generalities about functional programming; for example, it is more valuable to say that the team delivered its software a month ahead of schedule than it is to say that functional programming made the team more productive. If the paper not only describes experience but also presents new technical results, or if the experience refutes cherished beliefs of the functional-programming community, it may be better off submitted it as a full paper, which will be judged by the usual criteria of novelty, originality, and relevance. The principal editor will be happy to advise on any concerns about which category to submit to. ### ICFP Organizers General Chair: Robby Findler (Northwestern University, USA) Artifact Evaluation Co-Chairs: Simon Marlow (Facebook, UK) Ryan R. Newton (Indiana University, USA) Industrial Relations Chair: Alan Jeffrey (Mozilla Research, USA) Programming Contest Organiser: Matthew Fluet (Rochester Institute of Technology, USA) Publicity and Web Chair: Lindsey Kuper (Intel Labs, USA) Student Research Competition Chair: Ilya Sergey (University College London, UK) Video Co-Chairs: Jose Calderon (Galois, Inc., USA) Nicolas Wu (University of Bristol, UK) Workshops Co-Chair: David Christiansen (Indiana University, USA) Christophe Scholliers (Universiteit Gent, Belgium) ### PACMPL Volume 2, Issue ICFP 2018 Principal Editor: Matthew Flatt (Univesity of Utah, USA) Review Committee: Sandrine Blazy (IRISA, University of Rennes 1, France) David Christiansen (Indiana University, USA) Martin Elsman (University of Copenhagen, Denmark) Marco Gaboardi (University at Buffalo, CUNY, USA) Sam Lindley (University of Edinburgh, UK) Heather Miller (Northweastern University, USA / EPFL, Switzerland) J. Garrett Morris (University of Kansas, USA) Henrik Nilsson (University of Nottingham, UK) François Pottier (Inria, France) Alejandro Russo (Chalmers University of Technology, Sweden) Ilya Sergey (University College London, UK) Michael Sperber (Active Group GmbH, Germany) Wouter Swierstra (Utrecht University, UK) Éric Tanter (University of Chile, Chile) Katsuhiro Ueno (Tohoku University, Japan) Niki Vazou (University of Maryland, USA) Jeremy Yallop (University of Cambridge, UK) External Review Committee: Michael D. Adams (University of Utah, USA) Amal Ahmed (Northeastern University, USA) Nada Amin (University of Cambridge, USA) Zena Ariola (University of Oregon) Lars Bergstrom (Mozilla Research) Lars Birkedal (Aarhus University, Denmark) Edwin Brady ( University of St. Andrews, UK) William Byrd (University of Alabama at Birmingham, USA) Giuseppe Castagna (CRNS / University of Paris Diderot, France) Sheng Chen (University of Louisiana at Lafayette, USA) Koen Claessen (Chalmers University ot Technology, Sweden) Ugo Dal Lago (University of Bologna, Italy / Inria, France) David Darais (University of Vermont, USA) Joshua Dunfield (Queen’s University, Canada) Richard Eisenberg (Bryn Mawr College, USA) Matthew Fluet (Rochester Institute of Technology, USA) Nate Foster (Cornell University, USA) Jurriaan Hage (Utrecht University, Netherlands) David Van Horn (University of Maryland, USA) Zhenjiang Hu (National Institute of Informatics, Japan) Suresh Jagannathan (Purdue University, USA) Simon Peyton Jones (Microsoft Research, UK) Naoki Kobayashi (University of Tokyo, Japan) Neelakantan Krishnaswami (University of Cambridge, UK) Kazutaka Matsuda (Tohoku University, Japan) Trevor McDonell (University of New South Wales, Australia) Hernan Melgratti (University of Buenos Aires, Argentina) Akimasa Morihata (University of Tokyo, Japan) Aleksandar Nanevski (IMDEA Software Institute, Spain) Kim Nguyễn (University of Paris-Sud, France) Cosmin Oancea (DIKU, University of Copenhagen, Denmark) Bruno C. d. S. Oliveira (University of Hong Kong, China) Tomas Petricek (University of Cambridge, UK) Benjamin Pierce (University of Pennsylvania, USA) Christine Rizkallah (University of Pennsylvania, USA) Tom Schrijvers (KU Leuven, Belgium) Manuel Serrano (Inria, France) Jeremy Siek (Indiana University, USA) Josef Svenningsson (Chalmers University of Technology, Sweden) Nicolas Tabareau (Inria, France) Dimitrios Vytiniotis (Microsoft Research, UK) Philip Wadler (University of Edinburgh, UK) Meng Wang (University of Kent, UK) From yotam2206 at gmail.com Mon Feb 5 08:55:36 2018 From: yotam2206 at gmail.com (Yotam Ohad) Date: Mon, 05 Feb 2018 08:55:36 +0000 Subject: [Haskell-cafe] Yesod with lts-10.4 In-Reply-To: References: Message-ID: Hi all, The problem was corrupted files, after removing `~/.stack` the build was successful. Thank you ‫בתאריך יום ב׳, 5 בפבר׳ 2018 ב-1:04 מאת ‪Adam Bergmark‬‏ <‪adam at bergmark.nl ‬‏>:‬ > Hi Yotam, > > My guess is that some file has been corrupted. I'd remove `~/.stack` (you > don't have to remove all of it, but i'm not sure exactly which parts need > to go) and your project's `.stack-work` to do a clean rebuild. Heavy > handed, but it should work. > > HTH, > Adam > > > > > On Sun, 4 Feb 2018 at 22:50 Sibi wrote: > >> Is there any reason why you are trying to install rather than do a build? >> >> Regards, >> >> >> On Mon, Feb 5, 2018, 1:54 AM Yotam Ohad wrote: >> >>> Hi, >>> I'm trying to install yesod using stack and lts-10.4, but I get the >>> following result: >>> stack install yesod >>> aeson-1.2.3.0: configure >>> aeson-1.2.3.0: build >>> Progress: 1/26 >>> -- While building custom Setup.hs for package aeson-1.2.3.0 using: >>> >>> /home/yotam/.stack/setup-exe-cache/i386-linux-nopie/Cabal-simple_mPHDZzAJ_2.0.1.0_ghc-8.2.2 >>> --builddir=.stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0 build >>> --ghc-options " -ddump-hi -ddump-to-file -fdiagnostics-color=always" >>> Process exited with code: ExitFailure 1 >>> Logs have been written to: >>> /home/yotam/TheMafsidan/.stack-work/logs/aeson-1.2.3.0.log >>> >>> Configuring aeson-1.2.3.0... >>> Preprocessing library for aeson-1.2.3.0.. >>> Building library for aeson-1.2.3.0.. >>> [ 1 of 24] Compiling Data.Aeson.Compat ( Data/Aeson/Compat.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Compat.o ) >>> [ 2 of 24] Compiling Data.Aeson.Internal.Functions ( >>> Data/Aeson/Internal/Functions.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Internal/Functions.o >>> ) >>> [ 3 of 24] Compiling Data.Aeson.Parser.UnescapePure ( >>> pure/Data/Aeson/Parser/UnescapePure.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/UnescapePure.o >>> ) >>> [ 4 of 24] Compiling Data.Aeson.Parser.Unescape ( >>> Data/Aeson/Parser/Unescape.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Unescape.o >>> ) >>> [ 5 of 24] Compiling Data.Aeson.Types.Generic ( >>> Data/Aeson/Types/Generic.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/Generic.o >>> ) >>> [ 6 of 24] Compiling Data.Aeson.Types.Internal ( >>> Data/Aeson/Types/Internal.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/Internal.o >>> ) >>> [ 7 of 24] Compiling Data.Aeson.Parser.Internal ( >>> Data/Aeson/Parser/Internal.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Internal.o >>> ) >>> [ 8 of 24] Compiling Data.Aeson.Parser ( Data/Aeson/Parser.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser.o ) >>> [ 9 of 24] Compiling Data.Attoparsec.Time.Internal ( >>> attoparsec-iso8601/Data/Attoparsec/Time/Internal.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Attoparsec/Time/Internal.o >>> ) >>> [10 of 24] Compiling Data.Attoparsec.Time ( >>> attoparsec-iso8601/Data/Attoparsec/Time.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Attoparsec/Time.o >>> ) >>> [11 of 24] Compiling Data.Aeson.Parser.Time ( >>> Data/Aeson/Parser/Time.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Parser/Time.o >>> ) >>> [12 of 24] Compiling Data.Aeson.Types.FromJSON ( >>> Data/Aeson/Types/FromJSON.hs, >>> .stack-work/dist/i386-linux-nopie/Cabal-2.0.1.0/build/Data/Aeson/Types/FromJSON.o >>> ) >>> >>> /tmp/stack15763/aeson-1.2.3.0/Data/Aeson/Types/FromJSON.hs:108:1: >>> error: >>> Bad interface file: >>> /home/yotam/.stack/snapshots/i386-linux-nopie/lts-10.4/8.2.2/lib/i386-linux-ghc-8.2.2/time-locale-compat-0.1.1.3-EeYCrKbfyeWLGJYmfXhrGy/Data/Time/Locale/Compat.hi >>> Data.Binary.getPrim: end of file >>> | >>> 108 | import Data.Time.Locale.Compat (defaultTimeLocale) >>> | ^^ >>> >>> Is this a matter of just waiting for packages to update to 8.2.2 or is >>> it something I can change myself? >>> >>> Yotam >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From slucas at dsic.upv.es Mon Feb 5 11:15:55 2018 From: slucas at dsic.upv.es (Salvador Lucas) Date: Mon, 5 Feb 2018 12:15:55 +0100 Subject: [Haskell-cafe] WST 2018 - 1st Call for Papers (submission: April 15, 2018) Message-ID: ==========================================================================                           WST 2018 - Call for Papers                    16th International Workshop on Termination                     July 18-19, 2017, Oxford, United Kingdom                           http://wst2018.webs.upv.es/ ========================================================================== The Workshop on Termination (WST) traditionally brings together, in an informal setting, researchers interested in all aspects of termination, whether this interest be practical or theoretical, primary or derived. The workshop also provides a ground for cross-fertilization of ideas from the different communities interested in termination (e.g., working on computational mechanisms, programming languages, software engineering, constraint solving, etc.). The friendly atmosphere enables fruitful exchanges leading to joint research and subsequent publications. The workshop is held as part of the 2018 Federated Logic Conference (FLoC 2018)           http://www.floc2018.org/ IMPORTANT DATES:  * submission deadline:  April 15, 2018  * notification:         May 15, 2018  * final version due:    May 31, 2018  * workshop:             July 18-19, 2018 TOPICS: The 16th International Workshop on Termination welcomes contributions on all aspects of termination. In particular, papers investigating applications of termination (for example in complexity analysis, program analysis and transformation, theorem proving, program correctness, modeling computational systems, etc.) are very welcome. Topics of interest include (but are not limited to):  * abstraction methods in termination analysis  * certification of termination and complexity proofs  * challenging termination problems  * comparison and classification of termination methods  * complexity analysis in any domain  * implementation of termination methods  * non-termination analysis and loop detection  * normalization and infinitary normalization  * operational termination of logic-based systems  * ordinal notation and subrecursive hierarchies  * SAT, SMT, and constraint solving for (non-)termination analysis  * scalability and modularity of termination methods  * termination analysis in any domain (lambda calculus, declarative    programming, rewriting, transition systems, etc.)  * well-founded relations and well-quasi-orders COMPETITION: Since 2003, the catalytic effect of WST to stimulate new research on termination has been enhanced by the celebration of the Termination Competition and its continuously developing problem databases containing thousands of programs as challenges for termination analysis in different categories, see    http://termination-portal.org/wiki/Termination_Competition In 2018, the Termination Competition will run in parallel with FLoC 2018. More details will be provided in a dedicated announcement on the competition. PROGRAM COMMITTEE:     Cristina Borralleras - U. de Vic     Ugo Dal Lago - U. degli Studi di Bologna     Carsten Fuhs - Birkbeck, U. of London     Samir Genaim - U. Complutense de Madrid     Juergen Giesl - RWTH Aachen     Raul Gutiérrez - U. Politecnica de València     Keiichirou Kusakari - Gifu University     Salvador Lucas (chair) - U. Politecnica de Valencia     Fred Mesnard - U. de La Reunion     Aart Middeldorp - U. of Innsbruck     Albert Rubio - U. Politecnica de Catalunya     Rene Thiemann - U. of Innsbruck     Caterina Urban - ETH Zürich INVITED SPEAKERS:     tba SUBMISSION: Submissions are short papers/extended abstracts which should not exceed 5 pages. There will be no formal reviewing. In particular, we welcome short versions of recently published articles and papers submitted elsewhere. The program committee checks relevance and provides additional feedback for each submission. The accepted papers will be made available electronically before the workshop. Papers should be submitted electronically via the submission page:     https://easychair.org/conferences/?conf=wst2018 Please, use LaTeX and the LIPIcs style file     http://drops.dagstuhl.de/styles/lipics/lipics-authors.tgz to prepare your submission. From harendra.kumar at gmail.com Mon Feb 5 15:43:53 2018 From: harendra.kumar at gmail.com (Harendra Kumar) Date: Mon, 5 Feb 2018 21:13:53 +0530 Subject: [Haskell-cafe] rolling span and groupBy for lists In-Reply-To: References: Message-ID: On 5 February 2018 at 12:22, Evan Laforge wrote: > I have my own list library with a bunch of things like this. I think > it's what most people do, and some upload them to hackage, e.g. > utility-ht or the split package, or data-ordlist. > The irony is that theoretically you can find a Haskell package or implementation of whatever you can imagine but quite often it takes more time to discover it than writing your own. And then uploading what you wrote to hackage compounds the problem. A hoogle search only shows the groupBy in base, signature search also does not yield other results, it seems hoogle does not cover those other packages. After writing my own and spending quite a bit of time I could find two other similar implementations of groupBy, one in "utility-ht" package and the other in "data-list-sequences" but they don't turn up in hoogle search. It looks like hoogle database should cover more packages, or maybe the search has some issues. This state of affairs encourages people to write their own rather than find and reuse stuff. My example in this email can be dismissed as a small one but I think it is a larger problem. > You can probably find something like this in 'split', or if not, that > might be a good place to contribute it. > Yes, that is the fallback option I was considering, split seems to be the most comprehensive of all such list related packages. > I have a bunch of grouping functions too, which I use all the time, so > if there's some kind of general list grouping package then maybe I > could put them there. > It will be a great service to other Haskell explorers if we can consolidate all such packages and make one standard package covering most use cases and deprecate the other packages. Also it may be a good idea to have a see-also or related packages kind of field in packages so that discovery is easy. > On the other hand, this sort of thing is pretty individual, so it > doesn't seem so bad for each person to have their own local library. > That way you know it fits your style. Ultimately I think that's why > none of the split functions made it into Data.List, every person has a > slightly different idea of what it should be. > I thought that rollingGroupBy would have been a better default option as it can practically subsume the purpose of groupBy. groupBy in base is not well documented, and intuitively many think it works the way rollingGroupBy works i.e. compare two successive elements rather than comparing a fixed element. See this stack overflow question https://stackoverflow.com/questions/45654216/haskell-groupby-function-how-exactly-does-it-work , I thought the same way. I guess if we compare two successive elements, by transitive equality the existing groupBy implementation will practically get covered by that, not strictly compatible but should serve all practical purposes. That was the point why I was asking to consider having it in base alongside groupBy. It seems more useful, general and intuitive than the existing groupBy. -harendra > > On Sun, Feb 4, 2018 at 7:50 PM, Harendra Kumar > wrote: > > Hi, > > > > For a small problem, I was looking for a groupBy like function that > groups > > based on a predicate on successive elements but I could not find one. I > > wrote these little functions for that purpose: > > > > -- | Like span, but with a predicate that compares two successive > elements. > > The > > -- span ends when the two successive elements do not satisfy the > predicate. > > rollingSpan :: (a -> a -> Bool) -> [a] -> ([a], [a]) > > rollingSpan _ xs@[] = (xs, xs) > > rollingSpan _ xs@[_] = (xs, []) > > rollingSpan p (x1:xs@(x2:_)) > > | p x1 x2 = > > let (ys, zs) = rollingSpan p xs > > in (x1 : ys, zs) > > | otherwise = ([x1], xs) > > > > -- | Like 'groupBy' but with a predicate that compares two successive > > elements. > > -- A group ends when two successive elements do not satisfy the > predicate. > > rollingGroupBy :: (a -> a -> Bool) -> [a] -> [[a]] > > rollingGroupBy _ [] = [] > > rollingGroupBy cmp xs = > > let (ys, zs) = rollingSpan cmp xs > > in ys : rollingGroupBy cmp zs > > > > Are there any existing functions that serve this purpose or is there any > > simpler way to achieve such functionality? If not, where is the right > place > > for these, if any. Can they be included in Data.List in base? > > > > Thanks, > > Harendra > > > > _______________________________________________ > > ghc-devs mailing list > > ghc-devs at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From sivanov at colimite.fr Mon Feb 5 16:32:22 2018 From: sivanov at colimite.fr (Sergiu Ivanov) Date: Mon, 05 Feb 2018 17:32:22 +0100 Subject: [Haskell-cafe] rolling span and groupBy for lists In-Reply-To: References: Message-ID: <87tvuvs8h5.fsf@colimite.fr> Hello Harendra, Thus quoth Harendra Kumar on Mon Feb 05 2018 at 16:43 (+0100): > > The irony is that theoretically you can find a Haskell package or > implementation of whatever you can imagine but quite often it takes more > time to discover it than writing your own. Sometimes Hayoo! helps me out in such situations: http://hayoo.fh-wedel.de/?query=groupBy utility-ht shows up. -- Sergiu -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From harendra.kumar at gmail.com Mon Feb 5 17:30:47 2018 From: harendra.kumar at gmail.com (Harendra Kumar) Date: Mon, 5 Feb 2018 23:00:47 +0530 Subject: [Haskell-cafe] rolling span and groupBy for lists In-Reply-To: <87tvuvs8h5.fsf@colimite.fr> References: <87tvuvs8h5.fsf@colimite.fr> Message-ID: Yes, Hayoo seems to be giving better results, I found more variants having the behavior I want, it seems this variant is quite popular but still not in any standard libraries. Interestingly the problem of too many choices and no standard one that can be discovered applies to search engines as well. In this case there are only two choices but still it is of the same nature. I knew about hayoo but forgot to use it in this case. How much time should one spend on finding a trivial function before giving up and making the choice to write their own? I wish there was a standard, quick, good quality way of discovering what to use. It seems the Haskell ecosystem DNA encourages more and more fragmentation rather than consolidation. I think the community/leaders should acknowledge this problem and work on making things better in the short/long run. -harendra On 5 February 2018 at 22:02, Sergiu Ivanov wrote: > Hello Harendra, > > Thus quoth Harendra Kumar on Mon Feb 05 2018 at 16:43 (+0100): > > > > The irony is that theoretically you can find a Haskell package or > > implementation of whatever you can imagine but quite often it takes more > > time to discover it than writing your own. > > Sometimes Hayoo! helps me out in such situations: > > http://hayoo.fh-wedel.de/?query=groupBy > > utility-ht shows up. > > -- > Sergiu > -------------- next part -------------- An HTML attachment was scrubbed... URL: From sivanov at colimite.fr Mon Feb 5 19:03:58 2018 From: sivanov at colimite.fr (Sergiu Ivanov) Date: Mon, 05 Feb 2018 20:03:58 +0100 Subject: [Haskell-cafe] rolling span and groupBy for lists In-Reply-To: References: <87tvuvs8h5.fsf@colimite.fr> Message-ID: <87372fuuld.fsf@colimite.fr> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 18:30 (+0100): > Yes, Hayoo seems to be giving better results, I found more variants having > the behavior I want, it seems this variant is quite popular but still not > in any standard libraries. > > Interestingly the problem of too many choices and no standard one that can > be discovered applies to search engines as well. In this case there are > only two choices but still it is of the same nature. I knew about hayoo but > forgot to use it in this case. How much time should one spend on finding a > trivial function before giving up and making the choice to write their own? > I wish there was a standard, quick, good quality way of discovering what to > use. It seems the Haskell ecosystem DNA encourages more and more > fragmentation rather than consolidation. I think the community/leaders > should acknowledge this problem and work on making things better in the > short/long run. A Single Liberal Unified Registry of Haskell Packages (SLUPR), an effort in this direction, has been recently announced: https://github.com/haskell/ecosystem-proposals/pull/4 You may want to contribute to the discussion. -- Sergiu > -harendra > > On 5 February 2018 at 22:02, Sergiu Ivanov wrote: > >> Hello Harendra, >> >> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 16:43 (+0100): >> > >> > The irony is that theoretically you can find a Haskell package or >> > implementation of whatever you can imagine but quite often it takes more >> > time to discover it than writing your own. >> >> Sometimes Hayoo! helps me out in such situations: >> >> http://hayoo.fh-wedel.de/?query=groupBy >> >> utility-ht shows up. >> >> -- >> Sergiu >> -- Sergiu -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From harendra.kumar at gmail.com Mon Feb 5 19:29:13 2018 From: harendra.kumar at gmail.com (Harendra Kumar) Date: Tue, 6 Feb 2018 00:59:13 +0530 Subject: [Haskell-cafe] rolling span and groupBy for lists In-Reply-To: <87372fuuld.fsf@colimite.fr> References: <87tvuvs8h5.fsf@colimite.fr> <87372fuuld.fsf@colimite.fr> Message-ID: On 6 February 2018 at 00:33, Sergiu Ivanov wrote: > Thus quoth Harendra Kumar on Mon Feb 05 2018 at 18:30 (+0100): > > Yes, Hayoo seems to be giving better results, I found more variants > having > > the behavior I want, it seems this variant is quite popular but still not > > in any standard libraries. > > > > Interestingly the problem of too many choices and no standard one that > can > > be discovered applies to search engines as well. In this case there are > > only two choices but still it is of the same nature. I knew about hayoo > but > > forgot to use it in this case. How much time should one spend on finding > a > > trivial function before giving up and making the choice to write their > own? > > I wish there was a standard, quick, good quality way of discovering what > to > > use. It seems the Haskell ecosystem DNA encourages more and more > > fragmentation rather than consolidation. I think the community/leaders > > should acknowledge this problem and work on making things better in the > > short/long run. > > A Single Liberal Unified Registry of Haskell Packages (SLUPR), an effort > in this direction, has been recently announced: > Unfortunately, in my opinion, SLURP is taking things exactly in the opposite direction. I was talking about the problem of choice above and SLURP is giving even more choices and therefore encouraging more fragmentation. We should have just one good choice to stop wasting time and energy finding the best choice among millions available. Everyone should focus on making that one choice better rather spending energy in creating their own alternatives. This is where the Haskell ecosystem philosophy differs, it provides many choices in all aspects, it may be good in some cases but not always. SLURP is a technology solution which exactly fits in the same DNA. Technology can help us achieve the tasks that we set out to do but technology cannot motivate and influence us in what we choose to do and therefore ti cannot make the community focus on one goal - that requires real people leadership. If we do not focus on one goal, even with the best technology we may not succeed. Just my 2 cents. -harendra > > > > -harendra > > > > On 5 February 2018 at 22:02, Sergiu Ivanov wrote: > > > >> Hello Harendra, > >> > >> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 16:43 (+0100): > >> > > >> > The irony is that theoretically you can find a Haskell package or > >> > implementation of whatever you can imagine but quite often it takes > more > >> > time to discover it than writing your own. > >> > >> Sometimes Hayoo! helps me out in such situations: > >> > >> http://hayoo.fh-wedel.de/?query=groupBy > >> > >> utility-ht shows up. > >> > >> -- > >> Sergiu > >> > > > -- > Sergiu > -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Mon Feb 5 19:34:32 2018 From: allbery.b at gmail.com (Brandon Allbery) Date: Mon, 5 Feb 2018 14:34:32 -0500 Subject: [Haskell-cafe] rolling span and groupBy for lists In-Reply-To: References: <87tvuvs8h5.fsf@colimite.fr> <87372fuuld.fsf@colimite.fr> Message-ID: We have two groups of "leaders", with partially opposing goals. This is a disaster looking for an excuse to happen. On Mon, Feb 5, 2018 at 2:29 PM, Harendra Kumar wrote: > On 6 February 2018 at 00:33, Sergiu Ivanov wrote: > >> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 18:30 (+0100): >> > Yes, Hayoo seems to be giving better results, I found more variants >> having >> > the behavior I want, it seems this variant is quite popular but still >> not >> > in any standard libraries. >> > >> > Interestingly the problem of too many choices and no standard one that >> can >> > be discovered applies to search engines as well. In this case there are >> > only two choices but still it is of the same nature. I knew about hayoo >> but >> > forgot to use it in this case. How much time should one spend on >> finding a >> > trivial function before giving up and making the choice to write their >> own? >> > I wish there was a standard, quick, good quality way of discovering >> what to >> > use. It seems the Haskell ecosystem DNA encourages more and more >> > fragmentation rather than consolidation. I think the community/leaders >> > should acknowledge this problem and work on making things better in the >> > short/long run. >> >> A Single Liberal Unified Registry of Haskell Packages (SLUPR), an effort >> in this direction, has been recently announced: >> > > Unfortunately, in my opinion, SLURP is taking things exactly in the > opposite direction. I was talking about the problem of choice above and > SLURP is giving even more choices and therefore encouraging more > fragmentation. We should have just one good choice to stop wasting time and > energy finding the best choice among millions available. Everyone should > focus on making that one choice better rather spending energy in creating > their own alternatives. This is where the Haskell ecosystem philosophy > differs, it provides many choices in all aspects, it may be good in some > cases but not always. SLURP is a technology solution which exactly fits in > the same DNA. Technology can help us achieve the tasks that we set out to > do but technology cannot motivate and influence us in what we choose to do > and therefore ti cannot make the community focus on one goal - that > requires real people leadership. If we do not focus on one goal, even with > the best technology we may not succeed. Just my 2 cents. > > -harendra > > > >> >> >> > -harendra >> > >> > On 5 February 2018 at 22:02, Sergiu Ivanov wrote: >> > >> >> Hello Harendra, >> >> >> >> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 16:43 (+0100): >> >> > >> >> > The irony is that theoretically you can find a Haskell package or >> >> > implementation of whatever you can imagine but quite often it takes >> more >> >> > time to discover it than writing your own. >> >> >> >> Sometimes Hayoo! helps me out in such situations: >> >> >> >> http://hayoo.fh-wedel.de/?query=groupBy >> >> >> >> utility-ht shows up. >> >> >> >> -- >> >> Sergiu >> >> >> >> >> -- >> Sergiu >> > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From parsonsmatt at gmail.com Mon Feb 5 20:27:16 2018 From: parsonsmatt at gmail.com (Matt) Date: Mon, 5 Feb 2018 13:27:16 -0700 Subject: [Haskell-cafe] rolling span and groupBy for lists In-Reply-To: References: <87tvuvs8h5.fsf@colimite.fr> <87372fuuld.fsf@colimite.fr> Message-ID: I disagree that this is a disaster waiting to happen. Other language communities have multiple competing ideas and implementations, and it doesn't harm them too much. Haskell is still rapidly evolving and serves many different distinct sub-communities and needs, and it would be very surprising indeed if a single solution worked for all of them. Forcing (or even requesting) people to abandon their priorities and goals for "the greater good" will not work. Infrastructure that allows for code reuse and cooperation across distinct priorities will allow these sub-communities to grow and prosper. It's best if each community solves it's needs as well as it can, and allow the good ideas to spread via cross-pollination. Any new initiative that seeks to unify disparate groups without acknowledging their differing priorities and goals will fail. I don't know what will work, but friction is rarely resolved by increasing pressure. Matt Parsons On Mon, Feb 5, 2018 at 12:34 PM, Brandon Allbery wrote: > We have two groups of "leaders", with partially opposing goals. This is a > disaster looking for an excuse to happen. > > On Mon, Feb 5, 2018 at 2:29 PM, Harendra Kumar > wrote: > >> On 6 February 2018 at 00:33, Sergiu Ivanov wrote: >> >>> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 18:30 (+0100): >>> > Yes, Hayoo seems to be giving better results, I found more variants >>> having >>> > the behavior I want, it seems this variant is quite popular but still >>> not >>> > in any standard libraries. >>> > >>> > Interestingly the problem of too many choices and no standard one that >>> can >>> > be discovered applies to search engines as well. In this case there are >>> > only two choices but still it is of the same nature. I knew about >>> hayoo but >>> > forgot to use it in this case. How much time should one spend on >>> finding a >>> > trivial function before giving up and making the choice to write their >>> own? >>> > I wish there was a standard, quick, good quality way of discovering >>> what to >>> > use. It seems the Haskell ecosystem DNA encourages more and more >>> > fragmentation rather than consolidation. I think the community/leaders >>> > should acknowledge this problem and work on making things better in the >>> > short/long run. >>> >>> A Single Liberal Unified Registry of Haskell Packages (SLUPR), an effort >>> in this direction, has been recently announced: >>> >> >> Unfortunately, in my opinion, SLURP is taking things exactly in the >> opposite direction. I was talking about the problem of choice above and >> SLURP is giving even more choices and therefore encouraging more >> fragmentation. We should have just one good choice to stop wasting time and >> energy finding the best choice among millions available. Everyone should >> focus on making that one choice better rather spending energy in creating >> their own alternatives. This is where the Haskell ecosystem philosophy >> differs, it provides many choices in all aspects, it may be good in some >> cases but not always. SLURP is a technology solution which exactly fits in >> the same DNA. Technology can help us achieve the tasks that we set out to >> do but technology cannot motivate and influence us in what we choose to do >> and therefore ti cannot make the community focus on one goal - that >> requires real people leadership. If we do not focus on one goal, even with >> the best technology we may not succeed. Just my 2 cents. >> >> -harendra >> >> >> >>> >>> >>> > -harendra >>> > >>> > On 5 February 2018 at 22:02, Sergiu Ivanov >>> wrote: >>> > >>> >> Hello Harendra, >>> >> >>> >> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 16:43 (+0100): >>> >> > >>> >> > The irony is that theoretically you can find a Haskell package or >>> >> > implementation of whatever you can imagine but quite often it takes >>> more >>> >> > time to discover it than writing your own. >>> >> >>> >> Sometimes Hayoo! helps me out in such situations: >>> >> >>> >> http://hayoo.fh-wedel.de/?query=groupBy >>> >> >>> >> utility-ht shows up. >>> >> >>> >> -- >>> >> Sergiu >>> >> >>> >>> >>> -- >>> Sergiu >>> >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > > > -- > brandon s allbery kf8nh sine nomine > associates > allbery.b at gmail.com > ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad > http://sinenomine.net > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From harendra.kumar at gmail.com Mon Feb 5 20:50:51 2018 From: harendra.kumar at gmail.com (Harendra Kumar) Date: Tue, 6 Feb 2018 02:20:51 +0530 Subject: [Haskell-cafe] rolling span and groupBy for lists In-Reply-To: References: <87tvuvs8h5.fsf@colimite.fr> <87372fuuld.fsf@colimite.fr> Message-ID: If there are genuine priorities and if we can afford the luxury to have those priorities, yes I agree with you. But Haskell is a tiny community with little resources. Our chances of survival and winning are much brighter if all of us put our efforts in one direction rather than dividing them up into tinier parts, in other words set your priorities right for success. There is no "greater good", everything boils down to our own good, if the ship sinks we all sink together with it. Most successful projects are successful because of the focused efforts driven from top. Diversity and competition is always good as long as it is driven by genuine needs. I sincerely wish that SLURP is successful and mitigates all problems plaguing the ecosystem, but I doubt that the wish will come true. -harendra On 6 February 2018 at 01:57, Matt wrote: > I disagree that this is a disaster waiting to happen. Other language > communities have multiple competing ideas and implementations, and it > doesn't harm them too much. Haskell is still rapidly evolving and serves > many different distinct sub-communities and needs, and it would be very > surprising indeed if a single solution worked for all of them. > > Forcing (or even requesting) people to abandon their priorities and goals > for "the greater good" will not work. Infrastructure that allows for code > reuse and cooperation across distinct priorities will allow these > sub-communities to grow and prosper. It's best if each community solves > it's needs as well as it can, and allow the good ideas to spread via > cross-pollination. > > Any new initiative that seeks to unify disparate groups without > acknowledging their differing priorities and goals will fail. I don't know > what will work, but friction is rarely resolved by increasing pressure. > > Matt Parsons > > On Mon, Feb 5, 2018 at 12:34 PM, Brandon Allbery > wrote: > >> We have two groups of "leaders", with partially opposing goals. This is a >> disaster looking for an excuse to happen. >> >> On Mon, Feb 5, 2018 at 2:29 PM, Harendra Kumar >> wrote: >> >>> On 6 February 2018 at 00:33, Sergiu Ivanov wrote: >>> >>>> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 18:30 (+0100): >>>> > Yes, Hayoo seems to be giving better results, I found more variants >>>> having >>>> > the behavior I want, it seems this variant is quite popular but still >>>> not >>>> > in any standard libraries. >>>> > >>>> > Interestingly the problem of too many choices and no standard one >>>> that can >>>> > be discovered applies to search engines as well. In this case there >>>> are >>>> > only two choices but still it is of the same nature. I knew about >>>> hayoo but >>>> > forgot to use it in this case. How much time should one spend on >>>> finding a >>>> > trivial function before giving up and making the choice to write >>>> their own? >>>> > I wish there was a standard, quick, good quality way of discovering >>>> what to >>>> > use. It seems the Haskell ecosystem DNA encourages more and more >>>> > fragmentation rather than consolidation. I think the community/leaders >>>> > should acknowledge this problem and work on making things better in >>>> the >>>> > short/long run. >>>> >>>> A Single Liberal Unified Registry of Haskell Packages (SLUPR), an effort >>>> in this direction, has been recently announced: >>>> >>> >>> Unfortunately, in my opinion, SLURP is taking things exactly in the >>> opposite direction. I was talking about the problem of choice above and >>> SLURP is giving even more choices and therefore encouraging more >>> fragmentation. We should have just one good choice to stop wasting time and >>> energy finding the best choice among millions available. Everyone should >>> focus on making that one choice better rather spending energy in creating >>> their own alternatives. This is where the Haskell ecosystem philosophy >>> differs, it provides many choices in all aspects, it may be good in some >>> cases but not always. SLURP is a technology solution which exactly fits in >>> the same DNA. Technology can help us achieve the tasks that we set out to >>> do but technology cannot motivate and influence us in what we choose to do >>> and therefore ti cannot make the community focus on one goal - that >>> requires real people leadership. If we do not focus on one goal, even with >>> the best technology we may not succeed. Just my 2 cents. >>> >>> -harendra >>> >>> >>> >>>> >>>> >>>> > -harendra >>>> > >>>> > On 5 February 2018 at 22:02, Sergiu Ivanov >>>> wrote: >>>> > >>>> >> Hello Harendra, >>>> >> >>>> >> Thus quoth Harendra Kumar on Mon Feb 05 2018 at 16:43 (+0100): >>>> >> > >>>> >> > The irony is that theoretically you can find a Haskell package or >>>> >> > implementation of whatever you can imagine but quite often it >>>> takes more >>>> >> > time to discover it than writing your own. >>>> >> >>>> >> Sometimes Hayoo! helps me out in such situations: >>>> >> >>>> >> http://hayoo.fh-wedel.de/?query=groupBy >>>> >> >>>> >> utility-ht shows up. >>>> >> >>>> >> -- >>>> >> Sergiu >>>> >> >>>> >>>> >>>> -- >>>> Sergiu >>>> >>> >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >>> >> >> >> >> -- >> brandon s allbery kf8nh sine nomine >> associates >> allbery.b at gmail.com >> ballbery at sinenomine.net >> unix, openafs, kerberos, infrastructure, xmonad >> http://sinenomine.net >> >> _______________________________________________ >> ghc-devs mailing list >> ghc-devs at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From johannes.waldmann at htwk-leipzig.de Tue Feb 6 14:01:20 2018 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Tue, 6 Feb 2018 15:01:20 +0100 Subject: [Haskell-cafe] avoiding parens in postfix applicative notation Message-ID: <650c1914-1097-7eda-b027-7910ca8de768@htwk-leipzig.de> Dear Cafe - operators <$> and <*> have their precedence so that this (silly example) works without parens: (,) <$> "foo" <*> "bar" Most of the time, I find that the function (the first argument) is the largest sub-expression, so I want to put it last. I can do this import Control.Lens.Lens ((<&>)) "foo" <**> ( "bar" <&> (,) ) but (even ignoring that this pulls in a library with a ton of dependencies) this needs parens, and I find this quite ugly when the closing parenthesis comes at the end of lambda expression that spans several lines. One work-around is ( "foo" <**> ) $ "bar" <&> (,) Can this be done in a less noisy way? - J.W. PS: Bike-sheddingly, shouldn't this (<&>) be defined right next to (<$>) ? There's nothing that would tie it to lenses? And, (&) right next to ($) ? From monkleyon at gmail.com Tue Feb 6 14:59:26 2018 From: monkleyon at gmail.com (MarLinn) Date: Tue, 6 Feb 2018 15:59:26 +0100 Subject: [Haskell-cafe] avoiding parens in postfix applicative notation In-Reply-To: <650c1914-1097-7eda-b027-7910ca8de768@htwk-leipzig.de> References: <650c1914-1097-7eda-b027-7910ca8de768@htwk-leipzig.de> Message-ID: > operators <$> and <*> have their precedence so that this (silly example) works without parens: > > (,) <$> "foo" <*> "bar" > > Most of the time, I find that the function (the first argument) is the largest sub-expression, so I want to put it last. I can do this > > import Control.Lens.Lens ((<&>)) > > "foo" <**> ( "bar" <&> (,) ) > > but (even ignoring that this pulls in a library with a ton of dependencies) this needs parens, and I find this quite ugly when the closing parenthesis comes at the end of lambda expression that spans several lines. Hello, what's bad about the dead simple solution?     foobar = makeTuple <$> "foo" <*> "bar" where makeTuple = (,) -- bonus: name as documentation But if you insist: (,) <$> "foo" <*> "bar" is the same as (<*> "bar") . (<$> "foo") $ (,). But that would flip the order of the arguments. So maybe flip them back:     import Control.Category ( (>>>) ) foobar = (<$> "foo") >>> (<*> "bar") $ (,) Now let's extract new functions: a >>>* b = a >>> (<*> b) ; infixl 4 >>>* a $>>>* b = (<$> a) >>>* b ; infixl 4 $>>>* foobar = "foo" $>>>* "bar" >>>* "baz" $ (,,) You might want to bike-shed these names a bit, but that sounds like the operators you want. Maybe name them (>$) and (>*)? Side note: sometimes if the function is very short I feel like using such extra operators for "infix" applicatives as well:     comma = "foo" <*< (,) >*> "bar" -- same as(,) <$> "foo" <*> "bar" But I'm still not sure if that's a good idea. I've been bitten multiple times because of my own invented operators. What was (>>?!) again? Or (^>>>&)? The more I use Haskell the more I tend to solutions like that first dead-simple one. Cheers, MarLinn From ben at well-typed.com Tue Feb 6 16:43:10 2018 From: ben at well-typed.com (Ben Gamari) Date: Tue, 06 Feb 2018 11:43:10 -0500 Subject: [Haskell-cafe] [ANNOUNCE] GHC 8.4.1-alpha3 available Message-ID: <87d11iyspz.fsf@smart-cactus.org> The GHC development team is pleased to announce the third and likely last alpha release leading up to GHC 8.4.1. The usual release artifacts are available from https://downloads.haskell.org/~ghc/8.4.1-alpha3 Due to user demand we now offer a binary distribution for 64-bit Fedora 27, which links against ncurses6. This is in contrast to the Debian 8 distribution, which links against ncurses5. Users of newer distributions (Fedora 27, Debian Sid) should use this new Fedora 27 distribution. Also due to user demand we have reintroduced compatibility with GCC 4.4, which earlier alphas had dropped due to #14244. Note that this release is still affected by #14675, wherein the compiler will segmentation fault when built with some Ubuntu toolchains. We are actively working to identify the cause and hope that this will be resolved before the final release. === Notes on release scheduling === The 8.4.1 release marks the first release where GHC will be adhering to its new, higher-cadence release schedule [1]. Under this new scheme, major releases will be made in 6-month intervals with interstitial minor releases as necessary. In order to minimize the likelihood of schedule slippage and to ensure adequate testing, each major release will be preceded by a number of regular alpha releases. We will begin issuing these releases roughly three months before the final date of the major release and will issue roughly one every two weeks during this period. This high release cadence will allow us to quickly get fixes into users' hands and more quickly identify potential issues. As always, do let us know if you encounter any trouble in the course of testing. Thanks for your help! Cheers, - Ben [1] https://ghc.haskell.org/trac/ghc/blog/2017-release-schedule -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From neil_mayhew at users.sourceforge.net Tue Feb 6 17:37:14 2018 From: neil_mayhew at users.sourceforge.net (Neil Mayhew) Date: Tue, 6 Feb 2018 10:37:14 -0700 Subject: [Haskell-cafe] avoiding parens in postfix applicative notation In-Reply-To: References: <650c1914-1097-7eda-b027-7910ca8de768@htwk-leipzig.de> Message-ID: On 2018-02-06 07:59 AM, MarLinn wrote: > I've been bitten multiple times because of my own invented operators. > What was (>>?!) again? Or (^>>>&)? The more I use Haskell the more I > tend to solutions like that first dead-simple one. I agree. Also, since func <$> "foo" <*> "bar" is the lifted equivalent of func "foo" "bar" I find it unintuitive to read or write the logic in the opposite order. Whether we like it or not, Haskell is fundamentally a right-to-left language. Or, to look at it another way, top-down corresponds to left-to-right, and bottom-up corresponds to right-to-left. Perhaps it depends on whether you're a top-down thinker (like me) or a bottom-up thinker. I much prefer `where` to `let`, for example. From jasonpshipman at gmail.com Wed Feb 7 03:39:54 2018 From: jasonpshipman at gmail.com (Jason Shipman) Date: Tue, 6 Feb 2018 22:39:54 -0500 Subject: [Haskell-cafe] avoiding parens in postfix applicative notation In-Reply-To: References: <650c1914-1097-7eda-b027-7910ca8de768@htwk-leipzig.de> Message-ID: <460E7CCF-F451-4EC1-A711-9C978E46CBDF@gmail.com> Hi Johannes, The lens library defines (<&>) with very low precedence (1), whereas (<$>) has precedence 4. If you define (<&>) yourself and specify a precedence higher than 4, or just don’t specify a precedence at all, your example will work fine: (<&>) :: Functor f => f a -> (a -> b) -> f b (<&>) = flip fmap "foo" <**> "bar" <&> (,) You can do hanging style too, with no dollar sign: "foo" <**> "bar" <&> \q r -> ..(q, r) If you don’t like defining ad-hoc versions of things like (<&>), you might find the ‘overhang’ library useful: https://hackage.haskell.org/package/overhang-1.0.0/docs/Overhang.html#v:onMap The overhang equivalent of (<&>) is ‘onMap’ and it can be used in the same way: import Overhang (onMap) "foo" <**> "bar" `onMap` (,) The code aesthetics around writing a “final" lambda that spans several lines was the driver for creating that library! Jason > On Feb 6, 2018, at 12:37 PM, Neil Mayhew wrote: > > On 2018-02-06 07:59 AM, MarLinn wrote: >> I've been bitten multiple times because of my own invented operators. What was (>>?!) again? Or (^>>>&)? The more I use Haskell the more I tend to solutions like that first dead-simple one. > > I agree. > > Also, since > > func <$> "foo" <*> "bar" > > is the lifted equivalent of > > func "foo" "bar" > > I find it unintuitive to read or write the logic in the opposite order. > > Whether we like it or not, Haskell is fundamentally a right-to-left language. Or, to look at it another way, top-down corresponds to left-to-right, and bottom-up corresponds to right-to-left. Perhaps it depends on whether you're a top-down thinker (like me) or a bottom-up thinker. I much prefer `where` to `let`, for example. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From johannes.waldmann at htwk-leipzig.de Wed Feb 7 09:02:03 2018 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Wed, 7 Feb 2018 10:02:03 +0100 Subject: [Haskell-cafe] avoiding parens in postfix applicative notation Message-ID: Thanks for comments and suggestions. > The lens library defines (<&>) with very low precedence Yes. I guess my question was: Why? > f <$> foo <*> bar where f x y = ... I avoid "where" because * it uses an identifier before it is defined * it is not as composable as "let", which is an expression, but "where" can only be attached to declarations - I can write 1 + let x = 3 in x but not 1 + ( x where x = 3 ) - J.W. From ischenkovn at gmail.com Wed Feb 7 19:14:16 2018 From: ischenkovn at gmail.com (Vladyslav Nikolayevich) Date: Wed, 7 Feb 2018 21:14:16 +0200 Subject: [Haskell-cafe] GHC/GHCi Message-ID: Hi, GHCi https://hackage.haskell.org/package/ghc-8.2.1/docs/GHCi.html doc says that: `Interacting with the interpreter, whether it is running on an external process or in the current process.` but where I can get some examples haw to “connect” to the already running ghci, do some staff and reload ghci session them? -- С уважением, Владислав Ищенко -------------- next part -------------- An HTML attachment was scrubbed... URL: From johannes.waldmann at htwk-leipzig.de Thu Feb 8 08:57:52 2018 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Thu, 8 Feb 2018 09:57:52 +0100 Subject: [Haskell-cafe] avoiding parens in postfix applicative notation Message-ID: <7b46664a-3d56-d41e-b262-597a289a15cd@htwk-leipzig.de> for reference, previous discussion at https://mail.haskell.org/pipermail/libraries/2017-February/027685.html On whether to put <&> in Data.Functor. Will this happen? - J.W. From doug at cs.dartmouth.edu Thu Feb 8 14:47:54 2018 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Thu, 08 Feb 2018 09:47:54 -0500 Subject: [Haskell-cafe] Haskell-Cafe Digest, Vol 174, Issue 9 In-Reply-To: References: Message-ID: <201802081447.w18Els2d030948@coolidge.cs.Dartmouth.EDU> Thanks for the quidk reply. Please do send info about local arrangements. All I know is the dates. I read your shell assignment (but haven't yet looked at your program). It's a very good model of real life with Unix, particularly in regard to data laundry: automate what you can, but check the results. And that often feeds back into insight about further automation. I was once doing just such a job (in this case, trying to devise pronunciation rules for a text-to-speech system) when I got tired of using an editor to scan a dictionary that was too big to fit. I asked Ken Thompson if he could extract the editor's regular-expression recognizer into a free standing program. It turned out he had already done so for his own private use. Thus did grep make its appearance among Unix tools. Incidentally, you suggest using sed to get rid of carriage returns, disguised as ^M--very confusing because as a regular expression ^M means an M at the beginning of a line. The simplest solution I know is tr -d '\r'. For another revealing shell exercise you may like http://www.cs.dartmouth.edu/~doug/sieve.pdf. The shell stuff begins on page 4. Then comes truly lovely code in Haskell. Doug From theedge456 at free.fr Thu Feb 8 19:20:03 2018 From: theedge456 at free.fr (Fabien R) Date: Thu, 8 Feb 2018 20:20:03 +0100 Subject: [Haskell-cafe] Profiling code using tagsoup Message-ID: Hello, I have troubles profiling my EPG grabber. The profile log is: -------------------------- Thu Feb 8 17:14 2018 Time and Allocation Profiling Report (Final) tv_grab_fr +RTS -pa -hc -i1 -RTS --days 1 --output-file /res.xml total time = 103.35 secs (103353 ticks @ 1000 us, 1 processor) total alloc = 7,602,130,080 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes GC GC 50.5 0.0 52166 57504 parse Text.HTML.TagSoup.Specification src/Text/HTML/TagSoup/Specification.hs:35:1-19 15.4 15.2 15879 1159030944 output Text.HTML.TagSoup.Implementation src/Text/HTML/TagSoup/Implementation.hs:(80,1)-(142,44) 13.5 22.9 14000 1743780696 expand Text.HTML.TagSoup.Implementation src/Text/HTML/TagSoup/Implementation.hs:(49,1)-(60,30) 11.6 39.0 11976 2962740856 -------------------------- Further in the log, I see: TvGrabPrograms.mySccGetProgramDetails TvGrabPrograms src/TvGrabPrograms.hs:69:1-17 5000 19 0.6 2.2 42.3 79.2 640 165979512 ~/= Text.HTML.TagSoup src/Text/HTML/TagSoup.hs:103:1-25 5543 135987 0.1 0.0 28.5 44.4 54 3263688 ~== Text.HTML.TagSoup src/Text/HTML/TagSoup.hs:(87,1)-(99,21) 5544 135987 0.5 0.3 28.4 44.3 485 19485856 parseTags Text.HTML.TagSoup.Parser src/Text/HTML/TagSoup/Parser.hs:16:1-41 5545 135987 0.0 0.0 27.9 44.1 44 0 parseTagsOptions Text.HTML.TagSoup.Parser src/Text/HTML/TagSoup/Parser.hs:25:1-39 5546 135987 0.1 0.1 27.9 44.1 138 7615272 parseTagsOptions Text.HTML.TagSoup.Manual src/Text/HTML/TagSoup/Manual.hs:12:1-54 5547 135987 0.4 0.3 27.7 44.0 422 22845912 output Text.HTML.TagSoup.Implementation src/Text/HTML/TagSoup/Implementation.hs:(80,1)-(142,44) 5548 135987 8.0 13.1 8.0 13.2 8221 994675336 -------------------------- But I see no function (~/=) calling (~==) calling parseTags in my code. The only line using parseTags is: let !tl = parseTags $ L8.unpack $ responseBody httpRsp Did I miss something ? Thanks in advance, Fabien From allbery.b at gmail.com Thu Feb 8 19:32:12 2018 From: allbery.b at gmail.com (Brandon Allbery) Date: Thu, 8 Feb 2018 14:32:12 -0500 Subject: [Haskell-cafe] Profiling code using tagsoup In-Reply-To: References: Message-ID: You would need to show your source; that line by itself is not enough. On Thu, Feb 8, 2018 at 2:20 PM, Fabien R wrote: > Hello, > I have troubles profiling my EPG grabber. > > The profile log is: > -------------------------- > Thu Feb 8 17:14 2018 Time and Allocation Profiling Report (Final) > > tv_grab_fr +RTS -pa -hc -i1 -RTS --days 1 --output-file /res.xml > > total time = 103.35 secs (103353 ticks @ 1000 us, 1 > processor) > total alloc = 7,602,130,080 bytes (excludes profiling overheads) > > COST CENTRE MODULE > SRC > %time %alloc ticks bytes > > GC GC > > 50.5 0.0 52166 57504 > parse > Text.HTML.TagSoup.Specification > src/Text/HTML/TagSoup/Specification.hs:35:1-19 > 15.4 15.2 15879 1159030944 > output > Text.HTML.TagSoup.Implementation > src/Text/HTML/TagSoup/Implementation.hs:(80,1)-(142,44) > 13.5 22.9 14000 1743780696 > expand > Text.HTML.TagSoup.Implementation > src/Text/HTML/TagSoup/Implementation.hs:(49,1)-(60,30) > 11.6 39.0 11976 2962740856 > -------------------------- > Further in the log, I see: > > TvGrabPrograms.mySccGetProgramDetails > TvGrabPrograms > src/TvGrabPrograms.hs:69:1-17 5000 > 19 0.6 2.2 42.3 79.2 640 165979512 > ~/= > Text.HTML.TagSoup > src/Text/HTML/TagSoup.hs:103:1-25 5543 > 135987 0.1 0.0 28.5 44.4 54 3263688 > ~== > Text.HTML.TagSoup > src/Text/HTML/TagSoup.hs:(87,1)-(99,21) 5544 > 135987 0.5 0.3 28.4 44.3 485 19485856 > parseTags > Text.HTML.TagSoup.Parser > src/Text/HTML/TagSoup/Parser.hs:16:1-41 5545 > 135987 0.0 0.0 27.9 44.1 44 0 > parseTagsOptions > Text.HTML.TagSoup.Parser > src/Text/HTML/TagSoup/Parser.hs:25:1-39 5546 > 135987 0.1 0.1 27.9 44.1 138 7615272 > parseTagsOptions > Text.HTML.TagSoup.Manual > src/Text/HTML/TagSoup/Manual.hs:12:1-54 5547 > 135987 0.4 0.3 27.7 44.0 422 22845912 > output > Text.HTML.TagSoup.Implementation > src/Text/HTML/TagSoup/Implementation.hs:(80,1)-(142,44) 5548 > 135987 8.0 13.1 8.0 13.2 8221 994675336 > -------------------------- > But I see no function (~/=) calling (~==) calling parseTags in my code. > > The only line using parseTags is: > let !tl = parseTags $ L8.unpack $ responseBody httpRsp > > Did I miss something ? > > Thanks in advance, > Fabien > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From doug at cs.dartmouth.edu Fri Feb 9 15:45:24 2018 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Fri, 09 Feb 2018 10:45:24 -0500 Subject: [Haskell-cafe] mistaken post Message-ID: <201802091545.w19FjORa008567@coolidge.cs.Dartmouth.EDU> Apologies for my off-topic post about shell programming yesterday. (I replied to the wrong message in my inbox.) Doug From erkokl at gmail.com Fri Feb 9 18:19:30 2018 From: erkokl at gmail.com (Levent Erkok) Date: Fri, 9 Feb 2018 10:19:30 -0800 Subject: [Haskell-cafe] [JOBS] Formal methods positions at Intel Message-ID: We have two open positions in formal methods/verification at our team at Intel: http://jobs.intel.com/ShowJob/Id/1504155/Sr.-Formal-Verification-Engineer/ While the work centers around formal-verification of Intel's microprocessor offerings, people with background in functional programming and generally interested in correctness proofs of both software and hardware would be well suited. SAT/SMT solving, BDDs, Model-checking are most commonly occurring terms you hear on a daily basis. Feel free to contact me in private for questions, or send me your CV. Cheers, -Levent. -------------- next part -------------- An HTML attachment was scrubbed... URL: From neil_mayhew at users.sourceforge.net Sat Feb 10 00:05:15 2018 From: neil_mayhew at users.sourceforge.net (Neil Mayhew) Date: Fri, 9 Feb 2018 17:05:15 -0700 Subject: [Haskell-cafe] mistaken post In-Reply-To: <201802091545.w19FjORa008567@coolidge.cs.Dartmouth.EDU> References: <201802091545.w19FjORa008567@coolidge.cs.Dartmouth.EDU> Message-ID: Doug, Although I was puzzled about the context, I loved reading your paper! So it was a happy mistake as far as I'm concerned :-) I found it fascinating to realize the equivalence between processes connected by pipes and lazy lists with function composition. And I'll definitely be adding that two-liner to my repertoire of cool examples that I use when trying to explain the virtues of lazy functional programming to others. The other one that I use is the fairly well-known recursive Fibonacci generation: fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci). By the way, for your Try It section, you might want to consider using codepad.org , "an online compiler/interpreter, and a simple collaboration tool. It's a pastebin that executes code for you. You paste your code, and codepad runs it and gives you a short URL you can use to share it." For example, through something written here a few days ago, I came across a fascinating generator of rational approximations to pi written in Haskell, and the author used codepad.org to show both the code and the results. The code is at http://codepad.org/C2IVTlCC and the explanation is at https://www.quora.com/What-is-the-best-rational-approximation-of-pi-Let-best-be-the-difference-between-the-number-of-digits-used-to-represent-the-rational-and-the-number-of-accurate-digits-in-the-decimal-expansion/answer/Anders-Kaseorg Understandably, the implementation of codepad.org is careful about setting resource limits, so it would be interesting to see how well it handles your shell and C programs, both of which are effectively fork-bombs. —Neil -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Sat Feb 10 02:14:13 2018 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Fri, 9 Feb 2018 18:14:13 -0800 Subject: [Haskell-cafe] web framework Message-ID: I'd like a recommendation for a way to write web apps in Haskell. Background: I have written code in Python, C++ and Haskell for many years. However I have done no substantial web programming. My goal is mathematics-education-themed apps to run on browsers on any device. At first I'll be happy to run the app on my laptop and connect locally with an iPad or smartphone while I sit with my students. Later I may deploy it at scale "in the cloud" (I mean anyone connected to the internet can run it, and the servers belong to the hosting provider). Why a browser app? I figure it's the best way to get a portable app that will run on phones, tablets, and computers of all OS's. Why Haskell? The goal right now is fast prototyping and experimentation, especially for some fairly complex algorithms. I spent some time with JavaScript, TypeScript, and Scala.JS. I'm just so much more comfortable in Haskell with which I can write clean & sophisticated algorithms quickly. I see lots of mentions of Haskell "platforms" and "stacks" etc. on the Haskell Wiki. But I will confess I don't really know what a "platform" or "stack" is, or which of the options will support my needs. I know close to zero about apps in the browser. Regarding my UI needs, my app will have lots of graphics and lots of things to click on, drag, etc. It will need to be touch-screen responsive. Dennis -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg7mdp at gmail.com Sat Feb 10 02:42:19 2018 From: greg7mdp at gmail.com (Gregory Popovitch) Date: Fri, 9 Feb 2018 21:42:19 -0500 Subject: [Haskell-cafe] web framework In-Reply-To: References: Message-ID: <0F9A90C6ED054E929E20475D6449DB2D@gregava> Hi Dennis, I've read lots of good things about purescript (http://www.purescript.org/). greg _____ From: Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Dennis Raddle Sent: Friday, February 09, 2018 9:14 PM To: haskell-cafe Subject: [Haskell-cafe] web framework I'd like a recommendation for a way to write web apps in Haskell. Background: I have written code in Python, C++ and Haskell for many years. However I have done no substantial web programming. My goal is mathematics-education-themed apps to run on browsers on any device. At first I'll be happy to run the app on my laptop and connect locally with an iPad or smartphone while I sit with my students. Later I may deploy it at scale "in the cloud" (I mean anyone connected to the internet can run it, and the servers belong to the hosting provider). Why a browser app? I figure it's the best way to get a portable app that will run on phones, tablets, and computers of all OS's. Why Haskell? The goal right now is fast prototyping and experimentation, especially for some fairly complex algorithms. I spent some time with JavaScript, TypeScript, and Scala.JS. I'm just so much more comfortable in Haskell with which I can write clean & sophisticated algorithms quickly. I see lots of mentions of Haskell "platforms" and "stacks" etc. on the Haskell Wiki. But I will confess I don't really know what a "platform" or "stack" is, or which of the options will support my needs. I know close to zero about apps in the browser. Regarding my UI needs, my app will have lots of graphics and lots of things to click on, drag, etc. It will need to be touch-screen responsive. Dennis -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Sat Feb 10 02:54:28 2018 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Fri, 9 Feb 2018 18:54:28 -0800 Subject: [Haskell-cafe] web framework In-Reply-To: <0F9A90C6ED054E929E20475D6449DB2D@gregava> References: <0F9A90C6ED054E929E20475D6449DB2D@gregava> Message-ID: Thanks, but what do you think the learning curve will be on PureScript? How similar to Haskell is it? I want to balance some factors here. As my initial goal is rapid prototyping and experimentation, I'd like to use a language I already know well, in other words Haskell. But of course even with a familiar language, I'm going into a quite unfamiliar situation (web programming) and there is a learning curve with that. It may be that a language other than Haskell, i.e. PureScript, although requiring a learning curve, would be more suited to my app's needs and thus save me grief. I don't know. Dennis ​ -------------- next part -------------- An HTML attachment was scrubbed... URL: From djohnson.m at gmail.com Sat Feb 10 02:55:58 2018 From: djohnson.m at gmail.com (David Johnson) Date: Fri, 9 Feb 2018 18:55:58 -0800 Subject: [Haskell-cafe] web framework In-Reply-To: <0F9A90C6ED054E929E20475D6449DB2D@gregava> References: <0F9A90C6ED054E929E20475D6449DB2D@gregava> Message-ID: Miso supports touch events, has many examples, and is fairly straightforward to get started with: https://haskell-miso.org https://github.com/dmjio/miso On Fri, Feb 9, 2018 at 6:42 PM, Gregory Popovitch wrote: > Hi Dennis, I've read lots of good things about purescript ( > http://www.purescript.org/). > > greg > > ------------------------------ > *From:* Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] *On Behalf > Of *Dennis Raddle > *Sent:* Friday, February 09, 2018 9:14 PM > *To:* haskell-cafe > *Subject:* [Haskell-cafe] web framework > > I'd like a recommendation for a way to write web apps in Haskell. > > Background: I have written code in Python, C++ and Haskell for many years. > However I have done no substantial web programming. > > My goal is mathematics-education-themed apps to run on browsers on any > device. At first I'll be happy to run the app on my laptop and connect > locally with an iPad or smartphone while I sit with my students. > > Later I may deploy it at scale "in the cloud" (I mean anyone connected to > the internet can run it, and the servers belong to the hosting provider). > > Why a browser app? I figure it's the best way to get a portable app that > will run on phones, tablets, and computers of all OS's. > > Why Haskell? The goal right now is fast prototyping and experimentation, > especially for some fairly complex algorithms. I spent some time with > JavaScript, TypeScript, and Scala.JS. I'm just so much more comfortable in > Haskell with which I can write clean & sophisticated algorithms quickly. > > I see lots of mentions of Haskell "platforms" and "stacks" etc. on the > Haskell Wiki. But I will confess I don't really know what a "platform" or > "stack" is, or which of the options will support my needs. I know close to > zero about apps in the browser. > > Regarding my UI needs, my app will have lots of graphics and lots of > things to click on, drag, etc. It will need to be touch-screen responsive. > > Dennis > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- Cell: 1.630.740.8204 -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg7mdp at gmail.com Sat Feb 10 02:59:34 2018 From: greg7mdp at gmail.com (Gregory Popovitch) Date: Fri, 9 Feb 2018 21:59:34 -0500 Subject: [Haskell-cafe] web framework In-Reply-To: References: <0F9A90C6ED054E929E20475D6449DB2D@gregava> Message-ID: <1A7797ED62EC4D0091D4D4E810E7248E@gregava> Purescript is very close to Haskell, check it out! _____ From: Dennis Raddle [mailto:dennis.raddle at gmail.com] Sent: Friday, February 09, 2018 9:54 PM To: Gregory Popovitch Cc: haskell-cafe Subject: Re: [Haskell-cafe] web framework Thanks, but what do you think the learning curve will be on PureScript? How similar to Haskell is it? I want to balance some factors here. As my initial goal is rapid prototyping and experimentation, I'd like to use a language I already know well, in other words Haskell. But of course even with a familiar language, I'm going into a quite unfamiliar situation (web programming) and there is a learning curve with that. It may be that a language other than Haskell, i.e. PureScript, although requiring a learning curve, would be more suited to my app's needs and thus save me grief. I don't know. Dennis ​ -------------- next part -------------- An HTML attachment was scrubbed... URL: From parsonsmatt at gmail.com Sat Feb 10 03:00:34 2018 From: parsonsmatt at gmail.com (Matt) Date: Fri, 9 Feb 2018 20:00:34 -0700 Subject: [Haskell-cafe] web framework In-Reply-To: References: <0F9A90C6ED054E929E20475D6449DB2D@gregava> Message-ID: If you know Haskell, then the remaining bits of PureScript will not take very long. It's like moving from C++ to Java, or Ruby to Python. Most of your experience carries over, and you can learn the differences as they arise. You can likely be productive in PureScript tomorrow. There's a lot of discussion on PureScript development on the FPChat slack, invite link here: https://fpchat-invite.herokuapp.com/ In my experience, PureScript has been much nicer to work with than GHCJS or Elm. PureScript's editor tooling is absolutely fantastic, and the language has "fixed" a number of warts in Haskell. The record system and interop with JavaScript are wonderful, as well. Matt Parsons On Fri, Feb 9, 2018 at 7:54 PM, Dennis Raddle wrote: > Thanks, but what do you think the learning curve will be on PureScript? > How similar to Haskell is it? > > I want to balance some factors here. As my initial goal is rapid > prototyping and experimentation, I'd like to use a language I already know > well, in other words Haskell. > > But of course even with a familiar language, I'm going into a quite > unfamiliar situation (web programming) and there is a learning curve with > that. > > It may be that a language other than Haskell, i.e. PureScript, although > requiring a learning curve, would be more suited to my app's needs and thus > save me grief. > > I don't know. > Dennis > ​ > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at gmail.com Sat Feb 10 05:13:28 2018 From: amindfv at gmail.com (Tom Murphy) Date: Sat, 10 Feb 2018 00:13:28 -0500 Subject: [Haskell-cafe] GHC/GHCi In-Reply-To: References: Message-ID: Maybe https://hackage.haskell.org/package/ghci (especially .Message and .RemoteTypes )? On Wed, Feb 7, 2018 at 2:14 PM, Vladyslav Nikolayevich wrote: > Hi, GHCi https://hackage.haskell.org/package/ghc-8.2.1/docs/GHCi.html doc > says that: `Interacting with the interpreter, whether it is running on an > external process or in the current process.` but where I can get some > examples haw to “connect” to the already running ghci, do some staff and > reload ghci session them? > > -- > С уважением, > Владислав Ищенко > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From alan.zimm at gmail.com Sun Feb 11 09:39:38 2018 From: alan.zimm at gmail.com (Alan & Kim Zimmerman) Date: Sun, 11 Feb 2018 11:39:38 +0200 Subject: [Haskell-cafe] Haskell future and UTF8 vs UTF-16 Message-ID: Hi all What is the current and future status of UTF8 vs UTF-16 in the haskell world? I understand that currently Text uses UTF-16, and it is used generally because of compatibility requirements in the Microsoft ecosystem, but that there are movements afoot to move to a UTF8 only environment at some unspecified future point. The question arises as I ponder a pull request on haskell-lsp to switch to a UTF-16 based library[1] Alan [1] https://github.com/alanz/haskell-lsp/pull/70 -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Sun Feb 11 10:14:07 2018 From: david.feuer at gmail.com (David Feuer) Date: Sun, 11 Feb 2018 05:14:07 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors Message-ID: Can I use reallyUnsafePtrEquality# reliably to identify whether a value is a nullary constructor of a particular type? For example, if I have data Foo = Foo Can I write isFoo :: a -> Bool isFoo !a = isTrue# (reallyUnsafePtrEquality# a Foo) instead of isFoo :: forall a. Typeable a => a -> Bool isFoo a | Just Refl <- eqTypeRep (typeRep @a) (typeRep @Foo) , Foo <- a = True | otherwise = False The reason I'm asking is because this would let me (potentially) raiseIO# a nullary constructor and then catch# it and see if it was what I was looking for rather than having to open a SomeException to get to an Exception dictionary, open that to get a TypeRep, and then peer inside that to check a Fingerprint. That is, I'd get lighter-weight exceptions that only carry the information I actually need. Thanks, David -------------- next part -------------- An HTML attachment was scrubbed... URL: From merijn at inconsistent.nl Sun Feb 11 11:29:38 2018 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Sun, 11 Feb 2018 12:29:38 +0100 Subject: [Haskell-cafe] Haskell future and UTF8 vs UTF-16 In-Reply-To: References: Message-ID: <347BFC61-3C8A-4C93-9E0F-9089EBF61551@inconsistent.nl> On 11 Feb 2018, at 10:39, Alan & Kim Zimmerman wrote: > What is the current and future status of UTF8 vs UTF-16 in the haskell world? > > I understand that currently Text uses UTF-16, and it is used generally because of compatibility requirements in the Microsoft ecosystem, but that there are movements afoot to move to a UTF8 only environment at some unspecified future point. As far as I know there was a UTF-8 fork of Text made as part of the Summer of Code a year or so ago, but it got ditched because it turned out to be slower than the UTF16 version in practice. So as far as I know, there's no real plan to adopt to UTF8, especially since the internal encoding used by Text is pretty much irrelevant by most users of Text. Cheers, Merijn -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 874 bytes Desc: Message signed with OpenPGP URL: From moritz.kiefer at purelyfunctional.org Sun Feb 11 15:50:37 2018 From: moritz.kiefer at purelyfunctional.org (Moritz Kiefer) Date: Sun, 11 Feb 2018 16:50:37 +0100 Subject: [Haskell-cafe] Haskell future and UTF8 vs UTF-16 In-Reply-To: References: Message-ID: Hi Alan, On 02/11/2018 10:39 AM, Alan & Kim Zimmerman wrote: > What is the current and future status of UTF8 vs UTF-16 in the haskell > world? The only somewhat active effort to move towards UTF-8 in `text` that I’m aware of is https://github.com/text-utf8. I’m not personally involved with that project so I can’t tell you much more but you might want to contact the authors. Cheers, Moritz -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: OpenPGP digital signature URL: From adam at bergmark.nl Sun Feb 11 17:44:52 2018 From: adam at bergmark.nl (Adam Bergmark) Date: Sun, 11 Feb 2018 17:44:52 +0000 Subject: [Haskell-cafe] Haskell future and UTF8 vs UTF-16 In-Reply-To: References: Message-ID: There is also Foundation.String which I heard people speak enthusiastically about https://hackage.haskell.org/package/foundation-0.0.19/docs/Foundation-String.html Cheers, Adam On Sun, 11 Feb 2018 at 16:52 Moritz Kiefer < moritz.kiefer at purelyfunctional.org> wrote: > Hi Alan, > > On 02/11/2018 10:39 AM, Alan & Kim Zimmerman wrote: > > What is the current and future status of UTF8 vs UTF-16 in the haskell > > world? > > The only somewhat active effort to move towards UTF-8 in `text` that I’m > aware of is https://github.com/text-utf8. I’m not personally involved > with that project so I can’t tell you much more but you might want to > contact the authors. > > Cheers, > Moritz > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From jo at durchholz.org Sun Feb 11 21:55:14 2018 From: jo at durchholz.org (Joachim Durchholz) Date: Sun, 11 Feb 2018 22:55:14 +0100 Subject: [Haskell-cafe] Haskell future and UTF8 vs UTF-16 In-Reply-To: <347BFC61-3C8A-4C93-9E0F-9089EBF61551@inconsistent.nl> References: <347BFC61-3C8A-4C93-9E0F-9089EBF61551@inconsistent.nl> Message-ID: <57a13247-31c9-13d7-72c7-e8270e7ce39d@durchholz.org> Am 11.02.2018 um 12:29 schrieb Merijn Verstraaten: > On 11 Feb 2018, at 10:39, Alan & Kim Zimmerman wrote: >> What is the current and future status of UTF8 vs UTF-16 in the haskell world? >> >> I understand that currently Text uses UTF-16, and it is used generally because of compatibility requirements in the Microsoft ecosystem, but that there are movements afoot to move to a UTF8 only environment at some unspecified future point. > > As far as I know there was a UTF-8 fork of Text made as part of the Summer of Code a year or so ago, but it got ditched because it turned out to be slower than the UTF16 version in practice. Mmm... correctness is another relevant point here. Does Text handle characters beyond the Basic Multilingual Plane (U+00000 to U+0FFFF) properly, do does one have to deal with "surrogate pairs" there? I'm curious because I am seeing this kind of trouble in the Java world. The standard libraries there have pretty weak support for characters beyond 0x0FFFF, so most Java programmers pretend that these don't exist. I'm pretty sure Chinese users hate Java for that reason... Regards, Jo From lambda.fairy at gmail.com Sun Feb 11 23:51:19 2018 From: lambda.fairy at gmail.com (Chris Wong) Date: Mon, 12 Feb 2018 12:51:19 +1300 Subject: [Haskell-cafe] Haskell future and UTF8 vs UTF-16 In-Reply-To: <57a13247-31c9-13d7-72c7-e8270e7ce39d@durchholz.org> References: <347BFC61-3C8A-4C93-9E0F-9089EBF61551@inconsistent.nl> <57a13247-31c9-13d7-72c7-e8270e7ce39d@durchholz.org> Message-ID: On Feb 12, 2018 10:57 AM, "Joachim Durchholz" wrote: Am 11.02.2018 um 12:29 schrieb Merijn Verstraaten: > On 11 Feb 2018, at 10:39, Alan & Kim Zimmerman > wrote: > >> What is the current and future status of UTF8 vs UTF-16 in the haskell >> world? >> >> I understand that currently Text uses UTF-16, and it is used generally >> because of compatibility requirements in the Microsoft ecosystem, but that >> there are movements afoot to move to a UTF8 only environment at some >> unspecified future point. >> > > As far as I know there was a UTF-8 fork of Text made as part of the Summer > of Code a year or so ago, but it got ditched because it turned out to be > slower than the UTF16 version in practice. > Mmm... correctness is another relevant point here. Does Text handle characters beyond the Basic Multilingual Plane (U+00000 to U+0FFFF) properly, do does one have to deal with "surrogate pairs" there? I'm curious because I am seeing this kind of trouble in the Java world. The standard libraries there have pretty weak support for characters beyond 0x0FFFF, so most Java programmers pretend that these don't exist. I'm pretty sure Chinese users hate Java for that reason... IIRC, the public Text interface works with code points, not 16-bit units. Length and indexing are O(n) for this reason. So there should be no issues from a correctness point of view. Chris Regards, Jo _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From vl81 at kent.ac.uk Mon Feb 12 02:30:44 2018 From: vl81 at kent.ac.uk (Vilem-Benjamin Liepelt) Date: Mon, 12 Feb 2018 02:30:44 +0000 Subject: [Haskell-cafe] Replace data constructors via meta programming Message-ID: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Hi, I am looking for a solution to get rid of this silly boilerplate: eval :: Ord var => Map var Bool -> Proposition var -> Bool eval ctx prop = evalP $ fmap (ctx Map.!) prop where evalP = \case Var b -> b Not q -> not $ evalP q And p q -> evalP p && evalP q Or p q -> evalP p || evalP q If p q -> evalP p ==> evalP q Iff p q -> evalP p == evalP q What I would like to do in essence is to replace the data constructors like so: -- Not valid Haskell!! Can't pattern match on constructor only... magic = \case Var -> id Not -> not And -> (&&) Or -> (||) If -> (==>) Iff -> (==) compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) >>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) (Not (Var 'Q')))) ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) (not (id False)))) Note how the compiled expression exactly mirrors the AST, so there should be some meta programming technique for this. Does anyone have an idea how I can achieve this? The full source code is here: https://gist.github.com/vimuel/7dcb8a9f1d2b7b72f020d66ec4157d7b I am happy to take any other comments relating to my code... Best, Vilem -------------- next part -------------- An HTML attachment was scrubbed... URL: From ekmett at gmail.com Mon Feb 12 03:37:42 2018 From: ekmett at gmail.com (Edward Kmett) Date: Sun, 11 Feb 2018 22:37:42 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: Message-ID: Keep in mind a newtype of Foo will have a different TypeRep, but will compare as equal under reallyUnsafePtrEquality#. -Edward On Sun, Feb 11, 2018 at 5:14 AM, David Feuer wrote: > Can I use reallyUnsafePtrEquality# reliably to identify whether a value is > a nullary constructor of a particular type? For example, if I have > > data Foo = Foo > > Can I write > > isFoo :: a -> Bool > isFoo !a = isTrue# (reallyUnsafePtrEquality# a Foo) > > instead of > > isFoo :: forall a. Typeable a => a -> Bool > isFoo a > | Just Refl <- eqTypeRep (typeRep @a) (typeRep @Foo) > , Foo <- a > = True > | otherwise = False > > The reason I'm asking is because this would let me (potentially) raiseIO# > a nullary constructor and then catch# it and see if it was what I was > looking for rather than having to open a SomeException to get to an > Exception dictionary, open that to get a TypeRep, and then peer inside that > to check a Fingerprint. That is, I'd get lighter-weight exceptions that > only carry the information I actually need. > > Thanks, > David > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Mon Feb 12 03:58:45 2018 From: david.feuer at gmail.com (David Feuer) Date: Sun, 11 Feb 2018 22:58:45 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: Message-ID: Sure, but that's okay, because I never need to expose the type to anyone. I'm just nervous because I haven't seen documentation saying those values are type-specific. On Feb 11, 2018 10:37 PM, "Edward Kmett" wrote: > Keep in mind a newtype of Foo will have a different TypeRep, but will > compare as equal under reallyUnsafePtrEquality#. > > -Edward > > On Sun, Feb 11, 2018 at 5:14 AM, David Feuer > wrote: > >> Can I use reallyUnsafePtrEquality# reliably to identify whether a value >> is a nullary constructor of a particular type? For example, if I have >> >> data Foo = Foo >> >> Can I write >> >> isFoo :: a -> Bool >> isFoo !a = isTrue# (reallyUnsafePtrEquality# a Foo) >> >> instead of >> >> isFoo :: forall a. Typeable a => a -> Bool >> isFoo a >> | Just Refl <- eqTypeRep (typeRep @a) (typeRep @Foo) >> , Foo <- a >> = True >> | otherwise = False >> >> The reason I'm asking is because this would let me (potentially) raiseIO# >> a nullary constructor and then catch# it and see if it was what I was >> looking for rather than having to open a SomeException to get to an >> Exception dictionary, open that to get a TypeRep, and then peer inside that >> to check a Fingerprint. That is, I'd get lighter-weight exceptions that >> only carry the information I actually need. >> >> Thanks, >> David >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From raabe at froglogic.com Mon Feb 12 09:08:24 2018 From: raabe at froglogic.com (Frerich Raabe) Date: Mon, 12 Feb 2018 10:08:24 +0100 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: On 2018-02-12 03:30, Vilem-Benjamin Liepelt wrote: > I am looking for a solution to get rid of this silly boilerplate: > > eval :: Ord var => Map var Bool -> Proposition var -> Bool > eval ctx prop = evalP $ fmap (ctx Map.!) prop > where > evalP = \case > Var b -> b > Not q -> not $ evalP q > And p q -> evalP p && evalP q > Or p q -> evalP p || evalP q > If p q -> evalP p ==> evalP q > Iff p q -> evalP p == evalP q [..] You might benefit from the 'catamorphism' package: https://hackage.haskell.org/package/catamorphism-0.5.1.0/docs/Data-Morphism-Cata.html It provides a template Haskell function which, given a data type, produces a function which reduces (folds) that data type. -- Frerich Raabe - raabe at froglogic.com www.froglogic.com - Multi-Platform GUI Testing From serg.foo at gmail.com Mon Feb 12 09:34:09 2018 From: serg.foo at gmail.com (Sergey Vinokurov) Date: Mon, 12 Feb 2018 09:34:09 +0000 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: Hi Vilem, One possible solution here is to define a fold function that captures the relationship between constructors and functions to substitute instead (please see the Logic.hs attachment). But it may be a bit error-prone to use because the relationship is captured implicitly by corresponding argument of the 'foldProposition' function. Another approach with a bit more upfront boilerplate, but hopefully less code later, would be recursion schemes. Please refer to LogicRecSchemes.hs for a sample. In order to learn more you can either read https://github.com/willtim/recursion-schemes/raw/master/slides-final.pdf or https://github.com/sergv/kievfprog-2017-november/blob/master/Talk.pdf or listen to any recent talk on the topic. Regards, Sergey On 02/12/2018 02:30 AM, Vilem-Benjamin Liepelt wrote: > Hi, > > I am looking for a solution to get rid of this silly boilerplate: > > eval :: Ord var => Map var Bool -> Proposition var -> Bool > eval ctx prop = evalP $ fmap (ctx Map.!) prop >   where >     evalP = \case >         Var b -> b >         Not q -> not $ evalP q >         And p q -> evalP p && evalP q >         Or p q -> evalP p || evalP q >         If p q -> evalP p ==> evalP q >         Iff p q -> evalP p == evalP q > > What I would like to do in essence is to replace the data constructors > like so: > > -- Not valid Haskell!! Can't pattern match on constructor only... > magic = \case >     Var -> id >     Not -> not >     And -> (&&) >     Or -> (||) >     If -> (==>) >     Iff -> (==) > > compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) > >>>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) > (Not (Var 'Q')))) >             ((==) (not ((&&) (id True) (id False))) ((||) (not (id > True)) (not (id False)))) > > Note how the compiled expression exactly mirrors the AST, so there > should be some meta programming technique for this. > > Does anyone have an idea how I can achieve this? > > The full source code is here: > https://gist.github.com/vimuel/7dcb8a9f1d2b7b72f020d66ec4157d7b > > I am happy to take any other comments relating to my code... > > Best, > > Vilem > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- A non-text attachment was scrubbed... Name: Logic.hs Type: text/x-haskell Size: 1415 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: LogicRecSchemes.hs Type: text/x-haskell Size: 1691 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 228 bytes Desc: OpenPGP digital signature URL: From simons at nospf.cryp.to Mon Feb 12 09:38:25 2018 From: simons at nospf.cryp.to (Peter Simons) Date: Mon, 12 Feb 2018 10:38:25 +0100 Subject: [Haskell-cafe] Replace data constructors via meta programming References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: <87woziy2cu.fsf@write-only.cryp.to> Frerich Raabe writes: > You might benefit from the 'catamorphism' package: > > https://hackage.haskell.org/package/catamorphism-0.5.1.0/docs/Data-Morphism-Cata.html catamorphism would be a great solution to this kind of problem, but unfortunately it does not work with any 8.x version of GHC: https://github.com/frerich/catamorphism/issues/5 That makes its use impractical for most purposes, IMHO. Best regards, Peter From raabe at froglogic.com Mon Feb 12 09:45:52 2018 From: raabe at froglogic.com (Frerich Raabe) Date: Mon, 12 Feb 2018 10:45:52 +0100 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <87woziy2cu.fsf@write-only.cryp.to> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> <87woziy2cu.fsf@write-only.cryp.to> Message-ID: <31848efb42f5b35747c979c5fa07b6b2@froglogic.com> On 2018-02-12 10:38, Peter Simons wrote: > Frerich Raabe writes: > >> You might benefit from the 'catamorphism' package: >> >> >> https://hackage.haskell.org/package/catamorphism-0.5.1.0/docs/Data-Morphism-Cata.html > > catamorphism would be a great solution to this kind of problem, but > unfortunately it does not work with any 8.x version of GHC: > > https://github.com/frerich/catamorphism/issues/5 > > That makes its use impractical for most purposes, IMHO. Oh, drat. I forgot about that issue (I'm still not on GHC 8.x, ahem). :-( -- Frerich Raabe - raabe at froglogic.com www.froglogic.com - Multi-Platform GUI Testing From 78emil at gmail.com Mon Feb 12 15:57:21 2018 From: 78emil at gmail.com (Emil Axelsson) Date: Mon, 12 Feb 2018 15:57:21 +0000 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: One option, inspired by the Syntactic package, is to factor out application from Proposition. I pasted an example here: http://lpaste.net/362410 `evalSym` is quite close to your `magic` function: evalSym :: Map Name Bool -> Sym a -> a evalSym ctx (Var v) = ctx ! v evalSym _ Not = not evalSym _ And = (&&) / Emil Den 2018-02-12 kl. 02:30, skrev Vilem-Benjamin Liepelt: > Hi, > > I am looking for a solution to get rid of this silly boilerplate: > > eval :: Ord var => Map var Bool -> Proposition var -> Bool > eval ctx prop = evalP $ fmap (ctx Map.!) prop > where > evalP = \case > Var b -> b > Not q -> not $ evalP q > And p q -> evalP p && evalP q > Or p q -> evalP p || evalP q > If p q -> evalP p ==> evalP q > Iff p q -> evalP p == evalP q > > What I would like to do in essence is to replace the data constructors like so: > > -- Not valid Haskell!! Can't pattern match on constructor only... > magic = \case > Var -> id > Not -> not > And -> (&&) > Or -> (||) > If -> (==>) > Iff -> (==) > > compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) > >>>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) (Not (Var 'Q')))) > ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) (not (id False)))) > > Note how the compiled expression exactly mirrors the AST, so there should be some meta programming technique for this. > > Does anyone have an idea how I can achieve this? > > The full source code is here: https://gist.github.com/vimuel/7dcb8a9f1d2b7b72f020d66ec4157d7b > > I am happy to take any other comments relating to my code... > > Best, > > Vilem > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > From lysxia at gmail.com Mon Feb 12 18:21:38 2018 From: lysxia at gmail.com (Li-yao Xia) Date: Mon, 12 Feb 2018 13:21:38 -0500 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: Hello, Here's a quick demo of the finally-tagless style for this kind of problem. It is an alternative to defining a data type to represent the syntax, with a fold function (or "catamorphism") to deconstruct it. For more information: http://okmij.org/ftp/tagless-final/index.html Note that although you can't redefine constructors, you can rebind variables like "not", "(&&)"... The idea is that users can construct terms using these functions abstractly, and to evaluate those terms is to provide a definition of those functions. data PropSyntax v prop = PropSyntax { var :: v -> prop, (&&) :: prop -> prop -> prop, not :: prop -> prop -- etc } propSyntax :: PropSyntax v (Proposition v) propSyntax = PropSyntax Var And Not -- etc That is boilerplate that we can derive from the Proposition data type, or we can conversely derive the Proposition type from the record definition. (A Proposition is a "free object".) An evaluator is given by another record value. boolSyntax :: Ord v => Map v Bool -> PropSyntax v Bool boolSyntax m = PropSyntax (m Map.!) (Prelude.&&) Prelude.not -- etc We represent PropSyntax with a record instead of a type class in order to define implementations that depend on other values, such as boolSyntax depending on a map. It may be possible to use type classes at the same time to make it easier to construct propositions; for simple definitions, using RecordWildCards seems sufficiently discreet. example :: PropSyntax Bool prop -> prop example PropSyntax{..} = ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) (not (id False)))) -- All variables here assumed to be bound by PropSyntax{..} An evaluator is a record, an expression is a function, evaluation is function application. evalWith :: PropSyntax v prop -> (PropSyntax v prop -> r) -> r evalWith x f = f x exampleBool :: Bool exampleBool = evalWith boolSyntax example Li-yao On 02/11/2018 09:30 PM, Vilem-Benjamin Liepelt wrote: > Hi, > > I am looking for a solution to get rid of this silly boilerplate: > > eval :: Ord var => Map var Bool -> Proposition var -> Bool > eval ctx prop = evalP $ fmap (ctx Map.!) prop >   where >     evalP = \case >         Var b -> b >         Not q -> not $ evalP q >         And p q -> evalP p && evalP q >         Or p q -> evalP p || evalP q >         If p q -> evalP p ==> evalP q >         Iff p q -> evalP p == evalP q > > What I would like to do in essence is to replace the data constructors > like so: > > -- Not valid Haskell!! Can't pattern match on constructor only... > magic = \case >     Var -> id >     Not -> not >     And -> (&&) >     Or -> (||) >     If -> (==>) >     Iff -> (==) > > compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) > > >>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) > (Not (Var 'Q')))) >             ((==) (not ((&&) (id True) (id False))) ((||) (not (id > True)) (not (id False)))) > > Note how the compiled expression exactly mirrors the AST, so there > should be some meta programming technique for this. > > Does anyone have an idea how I can achieve this? > > The full source code is here: > https://gist.github.com/vimuel/7dcb8a9f1d2b7b72f020d66ec4157d7b > > I am happy to take any other comments relating to my code... > > Best, > > Vilem > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > From raabe at froglogic.com Mon Feb 12 20:08:58 2018 From: raabe at froglogic.com (Frerich Raabe) Date: Mon, 12 Feb 2018 21:08:58 +0100 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <87woziy2cu.fsf@write-only.cryp.to> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> <87woziy2cu.fsf@write-only.cryp.to> Message-ID: <683f66b9b651217aa3f29c21f0e487fc@froglogic.com> On 2018-02-12 10:38, Peter Simons wrote: > Frerich Raabe writes: > >> You might benefit from the 'catamorphism' package: >> >> >> https://hackage.haskell.org/package/catamorphism-0.5.1.0/docs/Data-Morphism-Cata.html > > catamorphism would be a great solution to this kind of problem, but > unfortunately it does not work with any 8.x version of GHC: > > https://github.com/frerich/catamorphism/issues/5 > > That makes its use impractical for most purposes, IMHO. Thanks for the prodding - I now finally got my act together and updated the package to work with GHC 8.x (and setup Travis CI while I was at it to try different GHC versions). -- Frerich Raabe - raabe at froglogic.com www.froglogic.com - Multi-Platform GUI Testing From olf at aatal-apotheke.de Mon Feb 12 21:58:29 2018 From: olf at aatal-apotheke.de (Olaf Klinke) Date: Mon, 12 Feb 2018 22:58:29 +0100 Subject: [Haskell-cafe] Replace data constructors via meta programming Message-ID: <454ECC1C-E598-4FF0-9A54-D46F2A09C4A7@aatal-apotheke.de> Vilem, I suggest to use free monads. They reduce boilerplate a little. First, separate the variable form the rest of the syntax: data Prop v = Not v | And v v | Or v v | If v v | Iff v v -- maybe GHC can derive this instance for you, given the appropriate language extension flag. instance Functor Prop where fmap f (Not p) = Not (f p) fmap f (And p q) = And (f p) (f q) fmap f (Or p q) = Or (f p) (f q) fmap f (If p q) = If (f p) (f q) fmap f (Iff p q) = Iff (f p) (f q) Then use Control.Monad.Free from the package 'free'. It also has a template Haskell part. The function you want is called 'iter' there, and applying a context of type var -> Bool is simply fmap. Note that a Map from var to Bool does not always yield a total reduction, since your formula might contain variables that are not in the Map. data Free f var = Pure var | Free (f (Free f var)) instance Functor f => Monad (Free f) where return = Pure Pure a >>= f = f a Free m >>= f = Free (fmap ((=<<) f) m) type Proposition var = Free Prop var type Predicate = Free Prop Bool -- F-algebras for functor f class Functor f => FAlg f a where alg :: f a -> a instance FAlg Prop Bool where alg (Not b) = not b alg (And p q) = p && q alg (Or p q) = p || q alg (If p q) = not p || q alg (Iff p q) = p == q eval = iter alg :: Predicate -> Bool map_and_eval ctx = iter alg . fmap ctx If feasible, remove If and Iff from the Prop type and make them binary functions on type Proposition var instead. That reduces the boilerplate further. -- Olaf From vl81 at kent.ac.uk Mon Feb 12 23:55:15 2018 From: vl81 at kent.ac.uk (Vilem-Benjamin Liepelt) Date: Mon, 12 Feb 2018 23:55:15 +0000 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: <6F61826B-018E-4DF8-9C1C-C11A20086EFC@kent.ac.uk> Thank you for your great suggestions. The type-foo looks very cool and I will have to dig more into the different options. Generating a catamorphism using the library of the same name works like a charm and integrates well with my existing code—once I managed to get it to install (thank you Stack LTS!) it just worked out of the box and let me write a one-line evaluator and a one-line pretty-printer. Woohoo! Unfortunately It's not really viable to use this "for real" at the moment because it requires such an old version of GHC. Something I miss is the clear correspondence between data constructors and "substitutions" (like in my `magic` example), since they become entirely positional, leading to potentially brittle code (imagine reordering the data constructors). I think some of the other solutions might be better in this respect. It's a shame that the catamorphism package doesn't work for a more up-to-date version of GHC, because I think I would use this quite often. I suppose the fold that Sergey proposed is essentially what the catamorphism package generates. Although I want to avoid having to write functions by hand when really the computer should be doing them for me, I think I will use this for now as it integrates nicely with my existing code and leads to quite idiomatic Haskell. I will definitely check out the other suggestions as well though, thank you again. Best, Vilem > On 2018-02-12, at 09:08, Frerich Raabe wrote: > > On 2018-02-12 03:30, Vilem-Benjamin Liepelt wrote: >> I am looking for a solution to get rid of this silly boilerplate: >> eval :: Ord var => Map var Bool -> Proposition var -> Bool >> eval ctx prop = evalP $ fmap (ctx Map.!) prop >> where >> evalP = \case >> Var b -> b >> Not q -> not $ evalP q >> And p q -> evalP p && evalP q >> Or p q -> evalP p || evalP q >> If p q -> evalP p ==> evalP q >> Iff p q -> evalP p == evalP q > > [..] > > You might benefit from the 'catamorphism' package: > > https://hackage.haskell.org/package/catamorphism-0.5.1.0/docs/Data-Morphism-Cata.html > > It provides a template Haskell function which, given a data type, produces a function which reduces (folds) that data type. > > -- > Frerich Raabe - raabe at froglogic.com > www.froglogic.com - Multi-Platform GUI Testing From tanuki at gmail.com Tue Feb 13 00:03:06 2018 From: tanuki at gmail.com (Theodore Lief Gannon) Date: Mon, 12 Feb 2018 16:03:06 -0800 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <6F61826B-018E-4DF8-9C1C-C11A20086EFC@kent.ac.uk> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> <6F61826B-018E-4DF8-9C1C-C11A20086EFC@kent.ac.uk> Message-ID: Vilem, you may have missed the post from the catamorphisms author where he updated the library in response to this thread? :) On Feb 12, 2018 3:58 PM, "Vilem-Benjamin Liepelt" wrote: > Thank you for your great suggestions. > > The type-foo looks very cool and I will have to dig more into the > different options. > > Generating a catamorphism using the library of the same name works like a > charm and integrates well with my existing code—once I managed to get it to > install (thank you Stack LTS!) it just worked out of the box and let me > write a one-line evaluator and a one-line pretty-printer. Woohoo! > > Unfortunately It's not really viable to use this "for real" at the moment > because it requires such an old version of GHC. > > Something I miss is the clear correspondence between data constructors and > "substitutions" (like in my `magic` example), since they become entirely > positional, leading to potentially brittle code (imagine reordering the > data constructors). I think some of the other solutions might be better in > this respect. > > It's a shame that the catamorphism package doesn't work for a more > up-to-date version of GHC, because I think I would use this quite often. > > I suppose the fold that Sergey proposed is essentially what the > catamorphism package generates. Although I want to avoid having to write > functions by hand when really the computer should be doing them for me, I > think I will use this for now as it integrates nicely with my existing code > and leads to quite idiomatic Haskell. > > I will definitely check out the other suggestions as well though, thank > you again. > > Best, > > Vilem > > > On 2018-02-12, at 09:08, Frerich Raabe wrote: > > > > On 2018-02-12 03:30, Vilem-Benjamin Liepelt wrote: > >> I am looking for a solution to get rid of this silly boilerplate: > >> eval :: Ord var => Map var Bool -> Proposition var -> Bool > >> eval ctx prop = evalP $ fmap (ctx Map.!) prop > >> where > >> evalP = \case > >> Var b -> b > >> Not q -> not $ evalP q > >> And p q -> evalP p && evalP q > >> Or p q -> evalP p || evalP q > >> If p q -> evalP p ==> evalP q > >> Iff p q -> evalP p == evalP q > > > > [..] > > > > You might benefit from the 'catamorphism' package: > > > > https://hackage.haskell.org/package/catamorphism-0.5.1.0/ > docs/Data-Morphism-Cata.html > > > > It provides a template Haskell function which, given a data type, > produces a function which reduces (folds) that data type. > > > > -- > > Frerich Raabe - raabe at froglogic.com > > www.froglogic.com - Multi-Platform GUI Testing > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From vl81 at kent.ac.uk Tue Feb 13 00:08:33 2018 From: vl81 at kent.ac.uk (Vilem-Benjamin Liepelt) Date: Tue, 13 Feb 2018 00:08:33 +0000 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> <6F61826B-018E-4DF8-9C1C-C11A20086EFC@kent.ac.uk> Message-ID: <2E2390B9-3AAD-4A5A-89FE-05773F289CC9@kent.ac.uk> Oh, indeed I wasn't aware of this. That's great news—thank you, Frerich! This actually leads me to another question: what are the tradeoffs between implementing this via Template Haskell as in the case of this package vs the `deriving` mechanism as for the foldable instance? V > On 2018-02-13, at 00:03, Theodore Lief Gannon wrote: > > Vilem, you may have missed the post from the catamorphisms author where he updated the library in response to this thread? :) > > On Feb 12, 2018 3:58 PM, "Vilem-Benjamin Liepelt" > wrote: > Thank you for your great suggestions. > > The type-foo looks very cool and I will have to dig more into the different options. > > Generating a catamorphism using the library of the same name works like a charm and integrates well with my existing code—once I managed to get it to install (thank you Stack LTS!) it just worked out of the box and let me write a one-line evaluator and a one-line pretty-printer. Woohoo! > > Unfortunately It's not really viable to use this "for real" at the moment because it requires such an old version of GHC. > > Something I miss is the clear correspondence between data constructors and "substitutions" (like in my `magic` example), since they become entirely positional, leading to potentially brittle code (imagine reordering the data constructors). I think some of the other solutions might be better in this respect. > > It's a shame that the catamorphism package doesn't work for a more up-to-date version of GHC, because I think I would use this quite often. > > I suppose the fold that Sergey proposed is essentially what the catamorphism package generates. Although I want to avoid having to write functions by hand when really the computer should be doing them for me, I think I will use this for now as it integrates nicely with my existing code and leads to quite idiomatic Haskell. > > I will definitely check out the other suggestions as well though, thank you again. > > Best, > > Vilem > > > On 2018-02-12, at 09:08, Frerich Raabe > wrote: > > > > On 2018-02-12 03:30, Vilem-Benjamin Liepelt wrote: > >> I am looking for a solution to get rid of this silly boilerplate: > >> eval :: Ord var => Map var Bool -> Proposition var -> Bool > >> eval ctx prop = evalP $ fmap (ctx Map.!) prop > >> where > >> evalP = \case > >> Var b -> b > >> Not q -> not $ evalP q > >> And p q -> evalP p && evalP q > >> Or p q -> evalP p || evalP q > >> If p q -> evalP p ==> evalP q > >> Iff p q -> evalP p == evalP q > > > > [..] > > > > You might benefit from the 'catamorphism' package: > > > > https://hackage.haskell.org/package/catamorphism-0.5.1.0/docs/Data-Morphism-Cata.html > > > > It provides a template Haskell function which, given a data type, produces a function which reduces (folds) that data type. > > > > -- > > Frerich Raabe - raabe at froglogic.com > > www.froglogic.com - Multi-Platform GUI Testing > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From manpacket at gmail.com Tue Feb 13 00:38:53 2018 From: manpacket at gmail.com (Mikhail Baykov) Date: Tue, 13 Feb 2018 08:38:53 +0800 Subject: [Haskell-cafe] Haskell-Cafe Digest, Vol 174, Issue 13 In-Reply-To: References: Message-ID: recursion-schemes package might do the trick. I wrote TH for it and somebody took care of getting it merged in. It should simplify some of this boilerplate. > > I am looking for a solution to get rid of this silly boilerplate: > > eval :: Ord var => Map var Bool -> Proposition var -> Bool > eval ctx prop = evalP $ fmap (ctx Map.!) prop > where > evalP = \case > Var b -> b > Not q -> not $ evalP q > And p q -> evalP p && evalP q > Or p q -> evalP p || evalP q > If p q -> evalP p ==> evalP q > Iff p q -> evalP p == evalP q > > What I would like to do in essence is to replace the data constructors like so: > > -- Not valid Haskell!! Can't pattern match on constructor only... > magic = \case > Var -> id > Not -> not > And -> (&&) > Or -> (||) > If -> (==>) > Iff -> (==) > > compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) > >>>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) (Not (Var 'Q')))) > ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) (not (id False)))) > > Note how the compiled expression exactly mirrors the AST, so there should be some meta programming technique for this. > > Does anyone have an idea how I can achieve this? > > The full source code is here: https://gist.github.com/vimuel/7dcb8a9f1d2b7b72f020d66ec4157d7b From KAction at gnu.org Tue Feb 13 04:39:07 2018 From: KAction at gnu.org (KAction at gnu.org) Date: Tue, 13 Feb 2018 07:39:07 +0300 Subject: [Haskell-cafe] Proposal for GHC: global HasFoo classes Message-ID: Hello! I have idea for GHC to make working with lenses even more convenient. # Rationale Let us recall, that "type Lens' a b = (a -> f a) -> (b -> f b)" is about accessing some value of type `a' somewhere deep in value of type `b'. Let us consider that we have following datatypes: -- module 1 {-# LANGUAGE DisambiguateRecordFields #-} data Foo = Foo { _a :: Int, _b :: Double } data Bar = Bar { _a :: Double, _c :: Char } Since we want to be able to use 'a' as both lens into 'Foo' and into 'Bar', we would use 'makeFields' function from 'lens' package, and get something like this generated (implementation is omited): -- module 1 class HasA w p | w -> p where a :: Lens' w p class HasB w p | w -> p where b :: Lens' w p class HasC w p | w -> p where c :: Lens' w p instance HasA Foo Int instance HasA Bar Double instance HasB Foo Double instance HasC Bar Char It is all great and convenient, but what if we have another module with -- module 2 data Quiz = Quiz { _a :: Bool } In same spirit, 'makeFields' will create -- module 2 class HasA w p | w -> p where a :: Lens' w p instance HasA Quiz Bool Now, you import unqualified both modules, and you have two versions of 'a' function, one per module. From GHC's point of view, class HasA in module 1 and module 2 are different, while we, humans, understand, that they are not. To mitigate this problem, common convention is to collect all types, used in package, and their lenses in signle module. But there is no solution {as far as I know} for lenses from different packages. # Proposal Let us introduce a new extension -XGlobalLensClasses (better name is welcome). When this extension is activated in module, you can write instances like instance HasFoo Foo Int where foo = -- apporiate lens with following implicit class definition: class HasFoo w p | w -> p where foo :: Lens' w p After that, module can export 'foo'. All implicit HasFoo classes, whose instances are defined in different modules are considered the same. It eliminates problem, described in rationale if both modules in consideration used proposed extension. It should be noted, that this extension would not disrupt any existing code, although in distant future we could have it by default. # Alternative idea The proposal of making global only one particular class namespace 'Has' with very specific signature is not generic enough. Maybe we can add option to mark class definition as global instead, merging all global classes with same signature together? Sounds more complicated, but this solution will not upset those people who disagree with Lens-based HasFoo classes. Opinions? From KAction at gnu.org Tue Feb 13 04:39:10 2018 From: KAction at gnu.org (KAction at gnu.org) Date: Tue, 13 Feb 2018 07:39:10 +0300 Subject: [Haskell-cafe] Arrow laws of Netwire Message-ID: Hello! In process of adapting 'netwire-5.0.0' to my needs I discovered following strange thing. Let us consider following simple program: {-# LANGUAGE Arrows #-} import FRP.Netwire import Data.Monoid -- I almost sure this is correct, since it is copied -- from "Programming with Arrows", J. Hughes mapA :: (ArrowChoice a) => a b c -> a [b] [c] mapA f = proc input -> case input of [] -> returnA -< [] z:zs -> do y_ <- f -< z ys_ <- mapA f -< zs returnA -< y_:ys_ mconcatA :: (ArrowChoice a, Monoid m) => a b m -> a [b] m mconcatA f = mapA f >>> arr mconcat -- Note the commented line. wire :: (Monad m, HasTime t s) => Wire s () m a Double wire = pure (Sum 1.0) -- >>> arr (: []) >>> mconcatA returnA >>> arr getSum >>> integral 10 main = testWire (countSession_ 1) wire Problem is that, compiled with ghc-8.0.1 this program hangs if I uncomment second line in body of ``wire`` function[1], which is wierd, since assuming monoid and arrow laws, I believe -- (Arrow a, Monoid e) => a e e arr (: []) >>> mconcatA returnA = returnA Is it false? Any suggestions? .. [1] with that line commented program works and prints sequence of numbers, with every next over previous. From silvio.frischi at gmail.com Tue Feb 13 09:44:12 2018 From: silvio.frischi at gmail.com (Silvio Frischknecht) Date: Tue, 13 Feb 2018 10:44:12 +0100 Subject: [Haskell-cafe] Proposal for GHC: global HasFoo classes In-Reply-To: References: Message-ID: <3f6711a5-0b58-0784-5bda-67bd81676ea6@gmail.com> I don't have the time to flesh out everything, but I thought this kind of problem can usually be solved with Symbols. https://hackage.haskell.org/package/base-4.10.1.0/docs/GHC-TypeLits.html Cheers Silvio On 13.02.2018 05:39, KAction at gnu.org wrote: > Hello! > > I have idea for GHC to make working with lenses even more convenient. > > # Rationale > > Let us recall, that "type Lens' a b = (a -> f a) -> (b -> f b)" is about > accessing some value of type `a' somewhere deep in value of type `b'. > > Let us consider that we have following datatypes: > > -- module 1 > {-# LANGUAGE DisambiguateRecordFields #-} > data Foo = Foo { _a :: Int, _b :: Double } > data Bar = Bar { _a :: Double, _c :: Char } > > Since we want to be able to use 'a' as both lens into 'Foo' and into > 'Bar', we would use 'makeFields' function from 'lens' package, and get > something like this generated (implementation is omited): > > -- module 1 > class HasA w p | w -> p where a :: Lens' w p > class HasB w p | w -> p where b :: Lens' w p > class HasC w p | w -> p where c :: Lens' w p > instance HasA Foo Int > instance HasA Bar Double > instance HasB Foo Double > instance HasC Bar Char > > It is all great and convenient, but what if we have another module with > > -- module 2 > data Quiz = Quiz { _a :: Bool } > > In same spirit, 'makeFields' will create > > -- module 2 > class HasA w p | w -> p where a :: Lens' w p > instance HasA Quiz Bool > > Now, you import unqualified both modules, and you have two versions of > 'a' function, one per module. From GHC's point of view, class HasA in > module 1 and module 2 are different, while we, humans, understand, that > they are not. > > To mitigate this problem, common convention is to collect all types, > used in package, and their lenses in signle module. But there is no > solution {as far as I know} for lenses from different packages. > > # Proposal > > Let us introduce a new extension -XGlobalLensClasses (better name is > welcome). When this extension is activated in module, you can write > instances like > > instance HasFoo Foo Int where foo = -- apporiate lens > > with following implicit class definition: > > class HasFoo w p | w -> p where foo :: Lens' w p > > After that, module can export 'foo'. All implicit HasFoo classes, whose > instances are defined in different modules are considered the same. It > eliminates problem, described in rationale if both modules in > consideration used proposed extension. > > It should be noted, that this extension would not disrupt any existing > code, although in distant future we could have it by default. > > # Alternative idea > > The proposal of making global only one particular class namespace > 'Has' with very specific signature is not generic enough. Maybe we > can add option to mark class definition as global instead, merging all > global classes with same signature together? > > Sounds more complicated, but this solution will not upset those people > who disagree with Lens-based HasFoo classes. > > Opinions? > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From gale at sefer.org Tue Feb 13 10:49:35 2018 From: gale at sefer.org (Yitzchak Gale) Date: Tue, 13 Feb 2018 12:49:35 +0200 Subject: [Haskell-cafe] GHC 8.2.2 for WSL Ubuntu 16.04 Message-ID: I have made available a build of GHC 8.2.2 with the config option: --disable-large-address-space You may find this useful if you are using Ubuntu 16.04 on Windows Subsystem for Linux. https://github.com/zoominsoftware/ghc-8.2.2-wsl Although Microsoft has been making gradual progress on the large address mapping issue[1][2], and the situation is much improved, there is still an extra startup latency of about 13 secs. for applications that pre-map a large address space as GHC does by default. This makes the standard GHC 8.2.2 binary unusable for compiling projects of any non-trivial size on WSL. You may find this GHC 8.2.2 binary more usable. Regards, Yitz [1] https://ghc.haskell.org/trac/ghc/ticket/13304 [2] https://github.com/Microsoft/WSL/issues/1671 From astrohavoc at gmail.com Tue Feb 13 11:00:37 2018 From: astrohavoc at gmail.com (Shao Cheng) Date: Tue, 13 Feb 2018 11:00:37 +0000 Subject: [Haskell-cafe] GHC 8.2.2 for WSL Ubuntu 16.04 In-Reply-To: References: Message-ID: Thank you! A simpler fix for WSL ghc users is upgrading to fast ring of insider builds, the mmap overhead is much lower and ghc startup lag is barely noticable. On Tue, Feb 13, 2018, 6:52 PM Yitzchak Gale wrote: > I have made available a build of GHC 8.2.2 with the config option: > --disable-large-address-space > > You may find this useful if you are using Ubuntu 16.04 on Windows > Subsystem for Linux. > > https://github.com/zoominsoftware/ghc-8.2.2-wsl > > Although Microsoft has been making gradual progress on the large > address mapping issue[1][2], and the situation is much improved, there > is still an extra startup latency of about 13 secs. for applications > that pre-map a large address space as GHC does by default. This makes > the standard GHC 8.2.2 binary unusable for compiling projects of any > non-trivial size on WSL. You may find this GHC 8.2.2 binary more usable. > > Regards, > Yitz > > [1] https://ghc.haskell.org/trac/ghc/ticket/13304 > [2] https://github.com/Microsoft/WSL/issues/1671 > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gale at sefer.org Tue Feb 13 11:21:06 2018 From: gale at sefer.org (Yitzchak Gale) Date: Tue, 13 Feb 2018 13:21:06 +0200 Subject: [Haskell-cafe] GHC 8.2.2 for WSL Ubuntu 16.04 In-Reply-To: References: Message-ID: I wrote: >> I have made available a build of GHC 8.2.2 with the config option: >> --disable-large-address-space >> [2] https://github.com/Microsoft/WSL/issues/1671 Shao Cheng wrote: > Thank you! A simpler fix for WSL ghc users is upgrading to fast ring of > insider builds, the mmap overhead is much lower and ghc startup lag is > barely noticable. Thanks, that's good news. I can't use an insider build - I need to be on standard Windows in order to support our customers. The latest reports in the GitHub issue seemed to indicate that the slowness is still quite significant even on insider builds. I'm glad to hear you say that this is no longer true. I am looking forward to regular GHC binary tarballs working normally on regular WSL sometime in the near future. Yitz From Graham.Hutton at nottingham.ac.uk Tue Feb 13 13:24:22 2018 From: Graham.Hutton at nottingham.ac.uk (Graham Hutton) Date: Tue, 13 Feb 2018 13:24:22 +0000 Subject: [Haskell-cafe] Midlands Graduate School 2018 - registration now open! Message-ID: Dear all, Midlands Graduate School (MGS) registration is now open! Eight courses on dependently typed programming, category theory, lambda calculus, denotational semantics, and more. 9-13 April 2018, Nottingham, UK. Spaces are limited, so early registration is recommended. Please share! http://tinyurl.com/MGS18NOTT Best wishes, Graham Hutton and Henrik Nilsson ========================================================== *** CALL FOR PARTICIPATION *** Midlands Graduate School 2018 9-13 April 2018, Nottingham, UK http://tinyurl.com/MGS18NOTT BACKGROUND: The Midlands Graduate School (MGS) in the Foundations of Computing Science provides an intensive course of lectures on the mathematical foundations of computing. The MGS has been running since 1999, and is aimed at PhD students in their first or second year of study, but the school is open to everyone, and has increasingly seen participation from industry. We welcome participants from all over the world! COURSES: Eight courses will be given. Participants usually take all the introductory courses and choose additional options from the advanced courses depending on their interests. Invited course - Type-Driven Development with Idris, Edwin Brady Introductory courses - Lambda Calculus, Venanzio Capretta - Category Theory, Roy Crole - Domain Theory and Denotational Semantics, Achim Jung Advanced courses - Univalent Foundations, Benedikt Ahrens - Coalgebra, Alexander Kurz - Separation Logic, Georg Struth - Machine Learning, Michel Valstar REGISTRATION: Registration is £550 for student, academic and independent participants, and £850 for industry participants. The fee includes 5 nights single en-suite accommodation (Sun-Thu), lunch and coffee breaks, and the conference dinner. The registration deadline is Friday 16th March. Spaces are limited, so please register early to secure your place. SPONSORSHIP: We offer a range of sponsorship opportunities for industry (bronze, silver and gold), each with specific benefits. Please see the website for further details. ========================================================== This message and any attachment are intended solely for the addressee and may contain confidential information. If you have received this message in error, please contact the sender and delete the email and attachment. Any views or opinions expressed by the author of this email do not necessarily reflect the views of the University of Nottingham. Email communications with the University of Nottingham may be monitored where permitted by law. From hvriedel at gmail.com Tue Feb 13 13:35:10 2018 From: hvriedel at gmail.com (Herbert Valerio Riedel) Date: Tue, 13 Feb 2018 14:35:10 +0100 Subject: [Haskell-cafe] GHC 8.2.2 for WSL Ubuntu 16.04 In-Reply-To: References: Message-ID: Hello *, Even though WSL may eventually address this issue for good, I've setup a new WSL-optimised flavour of my PPA for Ubuntu 16.04 LTS https://launchpad.net/~hvr/+archive/ubuntu/ghc over at https://launchpad.net/~hvr/+archive/ubuntu/ghc-wsl I don't have experience myself with Ubuntu on WSL, but it should be simply a matter of using sudo add-apt-repository ppa:hvr/ghc-wsl sudo apt-get update and then sudo apt-get install ghc-8.2.2-prof cabal-install-head Then simply add `/opt/ghc/bin` to your `$PATH` (see instructions at https://launchpad.net/~hvr/+archive/ubuntu/ghc ) There are also builds of GHC 8.0.2 and GHC 8.4.1-alpha (may still be building as of writing) in this new ghc-for-wsl PPA. I'd appreciate if somebody could test whether these GHC binaries work as intended on the non-insider Windows 10 builds and let me know. Cheers, Herbert On Tue, Feb 13, 2018 at 12:21 PM, Yitzchak Gale wrote: > I wrote: >>> I have made available a build of GHC 8.2.2 with the config option: >>> --disable-large-address-space >>> [2] https://github.com/Microsoft/WSL/issues/1671 > > Shao Cheng wrote: >> Thank you! A simpler fix for WSL ghc users is upgrading to fast ring of >> insider builds, the mmap overhead is much lower and ghc startup lag is >> barely noticable. > > Thanks, that's good news. I can't use an insider build - I need to be on > standard Windows in order to support our customers. The latest reports > in the GitHub issue seemed to indicate that the slowness is still quite > significant even on insider builds. I'm glad to hear you say that this is no > longer true. I am looking forward to regular GHC binary tarballs working > normally on regular WSL sometime in the near future. > > Yitz > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From gale at sefer.org Tue Feb 13 14:21:13 2018 From: gale at sefer.org (Yitzchak Gale) Date: Tue, 13 Feb 2018 16:21:13 +0200 Subject: [Haskell-cafe] GHC 8.2.2 for WSL Ubuntu 16.04 In-Reply-To: References: Message-ID: Herbert Valerio Riedel wrote: > ...I've setup a new WSL-optimised flavour > of my PPA for Ubuntu 16.04 LTS over at > https://launchpad.net/~hvr/+archive/ubuntu/ghc-wsl This is fantastic, thanks for doing this Herbert! -Yitz From andrew.thaddeus at gmail.com Tue Feb 13 14:30:48 2018 From: andrew.thaddeus at gmail.com (Andrew Martin) Date: Tue, 13 Feb 2018 09:30:48 -0500 Subject: [Haskell-cafe] Proposal for GHC: global HasFoo classes In-Reply-To: References: Message-ID: I'm against this proposal but only because there is already a better attempt to solve this in a more general way. Here's a list of terms and hyperlinks that you will find interesting: - OverloadedLabels - IsLabel - HasField - https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/OverloadedLabels - https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/MagicClasses - https://github.com/ghc-proposals/ghc-proposals/pull/6 The last link is represents the most up-to-date thinking on the subject. I would recommend reading the proposal and, if you see anything lacking, leaving a comment there. On Mon, Feb 12, 2018 at 11:39 PM, wrote: > > Hello! > > I have idea for GHC to make working with lenses even more convenient. > > # Rationale > > Let us recall, that "type Lens' a b = (a -> f a) -> (b -> f b)" is about > accessing some value of type `a' somewhere deep in value of type `b'. > > Let us consider that we have following datatypes: > > -- module 1 > {-# LANGUAGE DisambiguateRecordFields #-} > data Foo = Foo { _a :: Int, _b :: Double } > data Bar = Bar { _a :: Double, _c :: Char } > > Since we want to be able to use 'a' as both lens into 'Foo' and into > 'Bar', we would use 'makeFields' function from 'lens' package, and get > something like this generated (implementation is omited): > > -- module 1 > class HasA w p | w -> p where a :: Lens' w p > class HasB w p | w -> p where b :: Lens' w p > class HasC w p | w -> p where c :: Lens' w p > instance HasA Foo Int > instance HasA Bar Double > instance HasB Foo Double > instance HasC Bar Char > > It is all great and convenient, but what if we have another module with > > -- module 2 > data Quiz = Quiz { _a :: Bool } > > In same spirit, 'makeFields' will create > > -- module 2 > class HasA w p | w -> p where a :: Lens' w p > instance HasA Quiz Bool > > Now, you import unqualified both modules, and you have two versions of > 'a' function, one per module. From GHC's point of view, class HasA in > module 1 and module 2 are different, while we, humans, understand, that > they are not. > > To mitigate this problem, common convention is to collect all types, > used in package, and their lenses in signle module. But there is no > solution {as far as I know} for lenses from different packages. > > # Proposal > > Let us introduce a new extension -XGlobalLensClasses (better name is > welcome). When this extension is activated in module, you can write > instances like > > instance HasFoo Foo Int where foo = -- apporiate lens > > with following implicit class definition: > > class HasFoo w p | w -> p where foo :: Lens' w p > > After that, module can export 'foo'. All implicit HasFoo classes, whose > instances are defined in different modules are considered the same. It > eliminates problem, described in rationale if both modules in > consideration used proposed extension. > > It should be noted, that this extension would not disrupt any existing > code, although in distant future we could have it by default. > > # Alternative idea > > The proposal of making global only one particular class namespace > 'Has' with very specific signature is not generic enough. Maybe we > can add option to mark class definition as global instead, merging all > global classes with same signature together? > > Sounds more complicated, but this solution will not upset those people > who disagree with Lens-based HasFoo classes. > > Opinions? > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -- -Andrew Thaddeus Martin -------------- next part -------------- An HTML attachment was scrubbed... URL: From chrisdone at gmail.com Tue Feb 13 16:15:00 2018 From: chrisdone at gmail.com (Christopher Done) Date: Tue, 13 Feb 2018 16:15:00 +0000 Subject: [Haskell-cafe] How do you turn off GHC flags? Message-ID: If I run :set -fdeferred-type-errors in GHCi, how do I turn it off again? I tried -f-deferred-type-errors and -fno-deferred-type-errors and neither are recognized. Cheers ​ -------------- next part -------------- An HTML attachment was scrubbed... URL: From chrisdone at gmail.com Tue Feb 13 16:18:00 2018 From: chrisdone at gmail.com (Christopher Done) Date: Tue, 13 Feb 2018 16:18:00 +0000 Subject: [Haskell-cafe] How do you turn off GHC flags? In-Reply-To: References: Message-ID: If I use :unset -fdeferred-type-errors it says Some flags have not been recognized: -fno-deferred-type-errors, so perhaps there is no corresponding flag to turn this feature off in GHC/GHCi’s regular interface? ​ On 13 February 2018 at 16:15, Christopher Done wrote: > If I run :set -fdeferred-type-errors in GHCi, how do I turn it off again? > > I tried -f-deferred-type-errors and -fno-deferred-type-errors and neither > are recognized. > > Cheers > ​ > -------------- next part -------------- An HTML attachment was scrubbed... URL: From chrisdone at gmail.com Tue Feb 13 16:20:21 2018 From: chrisdone at gmail.com (Christopher Done) Date: Tue, 13 Feb 2018 16:20:21 +0000 Subject: [Haskell-cafe] How do you turn off GHC flags? In-Reply-To: References: Message-ID: My bad, it’s defer-type-errors, not deferred-type-errors. I was confused due to the warning which is called -Wdeferred-type-errors: TEMP.hs:6:7: warning: [-Wdeferred-type-errors] • Couldn't match expected type ‘Int’ with actual type ‘Char’ So there’s a mismatch between these two flags. Disregard this thread. ​ On 13 February 2018 at 16:18, Christopher Done wrote: > If I use :unset -fdeferred-type-errors it says Some flags have not been > recognized: -fno-deferred-type-errors, so perhaps there is no > corresponding flag to turn this feature off in GHC/GHCi’s regular interface? > ​ > > On 13 February 2018 at 16:15, Christopher Done > wrote: > >> If I run :set -fdeferred-type-errors in GHCi, how do I turn it off again? >> >> I tried -f-deferred-type-errors and -fno-deferred-type-errors and >> neither are recognized. >> >> Cheers >> ​ >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From benjamin.peter.doyle at gmail.com Tue Feb 13 16:34:24 2018 From: benjamin.peter.doyle at gmail.com (Ben Doyle) Date: Tue, 13 Feb 2018 16:34:24 +0000 Subject: [Haskell-cafe] How do you turn off GHC flags? In-Reply-To: References: Message-ID: Proper grammar strikes again! A related useful thing that I learned of recently is :load! (and :reload!) It’s equivalent to setting defer-type-errors, loading the module, and then unsetting. :r! and :l! don’t work, alas. On Tue, Feb 13, 2018 at 11:23 AM Christopher Done wrote: > My bad, it’s defer-type-errors, not deferred-type-errors. I was confused > due to the warning which is called -Wdeferred-type-errors: > > TEMP.hs:6:7: warning: [-Wdeferred-type-errors] > • Couldn't match expected type ‘Int’ with actual type ‘Char’ > > So there’s a mismatch between these two flags. > > Disregard this thread. > ​ > > On 13 February 2018 at 16:18, Christopher Done > wrote: > >> If I use :unset -fdeferred-type-errors it says Some flags have not been >> recognized: -fno-deferred-type-errors, so perhaps there is no >> corresponding flag to turn this feature off in GHC/GHCi’s regular interface? >> ​ >> >> On 13 February 2018 at 16:15, Christopher Done >> wrote: >> >>> If I run :set -fdeferred-type-errors in GHCi, how do I turn it off >>> again? >>> >>> I tried -f-deferred-type-errors and -fno-deferred-type-errors and >>> neither are recognized. >>> >>> Cheers >>> ​ >>> >> >> > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From doaitse at swierstra.net Tue Feb 13 21:14:50 2018 From: doaitse at swierstra.net (Doaitse Swierstra) Date: Tue, 13 Feb 2018 22:14:50 +0100 Subject: [Haskell-cafe] Haskell-Cafe Digest, Vol 174, Issue 13 In-Reply-To: References: Message-ID: This pattern is quite common; even so common that over the years many systems have been constructed to support this way of programming. The original term was Attribute Grammars, a term invented by Donald Knuth. The http://hackage.haskell.org/package/uuagc system supports programming in this way in Haskell; it allows you to compose the semantics of an AST in a compositional way. The Utrecht Haskell compiler was built with it. If you do not want to use a separate system you may want to use the embedding of attribute grammars in Haskell; a bit more cumbersome, but interesting since the completeness of the attribute grammar is checked using the Haskell type system: http://hackage.haskell.org/package/AspectAG The thesis of Marcos Viera describes the underlying system in great detail: https://dspace.library.uu.nl/handle/1874/269786 Best, Doaitse > Op 13 feb. 2018, om 1:38 heeft Mikhail Baykov het volgende geschreven: > > recursion-schemes package might do the trick. I wrote TH for it and > somebody took care of getting it merged in. It should simplify some of > this boilerplate. > >> >> I am looking for a solution to get rid of this silly boilerplate: >> >> eval :: Ord var => Map var Bool -> Proposition var -> Bool >> eval ctx prop = evalP $ fmap (ctx Map.!) prop >> where >> evalP = \case >> Var b -> b >> Not q -> not $ evalP q >> And p q -> evalP p && evalP q >> Or p q -> evalP p || evalP q >> If p q -> evalP p ==> evalP q >> Iff p q -> evalP p == evalP q >> >> What I would like to do in essence is to replace the data constructors like so: >> >> -- Not valid Haskell!! Can't pattern match on constructor only... >> magic = \case >> Var -> id >> Not -> not >> And -> (&&) >> Or -> (||) >> If -> (==>) >> Iff -> (==) >> >> compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) >> >>>>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) (Not (Var 'Q')))) >> ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) (not (id False)))) >> >> Note how the compiled expression exactly mirrors the AST, so there should be some meta programming technique for this. >> >> Does anyone have an idea how I can achieve this? >> >> The full source code is here: https://gist.github.com/vimuel/7dcb8a9f1d2b7b72f020d66ec4157d7b > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From zemyla at gmail.com Tue Feb 13 22:54:36 2018 From: zemyla at gmail.com (Zemyla) Date: Tue, 13 Feb 2018 16:54:36 -0600 Subject: [Haskell-cafe] Haskell future and UTF8 vs UTF-16 In-Reply-To: References: <347BFC61-3C8A-4C93-9E0F-9089EBF61551@inconsistent.nl> <57a13247-31c9-13d7-72c7-e8270e7ce39d@durchholz.org> Message-ID: I'd actually been thinking about whether it'd be worth it to include a fingertree of character lengths in order to make length O(1) and indexing, take, and drop O(log n). However, a Text is currently three unpacked values, and putting something that can't be unboxed in there may not be such a good idea. On Sun, Feb 11, 2018 at 5:51 PM, Chris Wong wrote: > On Feb 12, 2018 10:57 AM, "Joachim Durchholz" wrote: > > Am 11.02.2018 um 12:29 schrieb Merijn Verstraaten: >> >> On 11 Feb 2018, at 10:39, Alan & Kim Zimmerman >> wrote: >>> >>> What is the current and future status of UTF8 vs UTF-16 in the haskell >>> world? >>> >>> I understand that currently Text uses UTF-16, and it is used generally >>> because of compatibility requirements in the Microsoft ecosystem, but that >>> there are movements afoot to move to a UTF8 only environment at some >>> unspecified future point. >> >> >> As far as I know there was a UTF-8 fork of Text made as part of the Summer >> of Code a year or so ago, but it got ditched because it turned out to be >> slower than the UTF16 version in practice. > > Mmm... correctness is another relevant point here. > Does Text handle characters beyond the Basic Multilingual Plane (U+00000 to > U+0FFFF) properly, do does one have to deal with "surrogate pairs" there? > > I'm curious because I am seeing this kind of trouble in the Java world. The > standard libraries there have pretty weak support for characters beyond > 0x0FFFF, so most Java programmers pretend that these don't exist. I'm pretty > sure Chinese users hate Java for that reason... > > > IIRC, the public Text interface works with code points, not 16-bit units. > Length and indexing are O(n) for this reason. > > So there should be no issues from a correctness point of view. > > Chris > > Regards, > Jo > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From m.farkasdyck at gmail.com Tue Feb 13 23:31:35 2018 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Tue, 13 Feb 2018 15:31:35 -0800 Subject: [Haskell-cafe] Haskell future and UTF8 vs UTF-16 In-Reply-To: References: <347BFC61-3C8A-4C93-9E0F-9089EBF61551@inconsistent.nl> <57a13247-31c9-13d7-72c7-e8270e7ce39d@durchholz.org> Message-ID: On 13/02/2018, Zemyla wrote: > I'd actually been thinking about whether it'd be worth it to include a > fingertree of character lengths in order to make length O(1) and > indexing, take, and drop O(log n). However, a Text is currently three > unpacked values, and putting something that can't be unboxed in there > may not be such a good idea. Yeah, whoever needs these operations likely ought to rather use `Vector Char` or such, or define a wrapper type including the character length information, lest we penalize all users for it. From carter.schonwald at gmail.com Wed Feb 14 19:02:58 2018 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Wed, 14 Feb 2018 14:02:58 -0500 Subject: [Haskell-cafe] GHC 8.2.2 for WSL Ubuntu 16.04 In-Reply-To: References: Message-ID: awesome! On Tue, Feb 13, 2018 at 9:21 AM, Yitzchak Gale wrote: > Herbert Valerio Riedel wrote: > > ...I've setup a new WSL-optimised flavour > > of my PPA for Ubuntu 16.04 LTS over at > > https://launchpad.net/~hvr/+archive/ubuntu/ghc-wsl > > This is fantastic, thanks for doing this Herbert! > > -Yitz > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dsf at seereason.com Thu Feb 15 13:51:00 2018 From: dsf at seereason.com (David Fox) Date: Thu, 15 Feb 2018 05:51:00 -0800 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: You actually can pattern match on constructor only: magic = \case Var {} -> id Not {}-> not And {} -> (&&) Or {} -> (||) If {} -> (==>) Iff {} -> (==) On Sun, Feb 11, 2018 at 6:30 PM, Vilem-Benjamin Liepelt wrote: > Hi, > > I am looking for a solution to get rid of this silly boilerplate: > > eval :: Ord var => Map var Bool -> Proposition var -> Bool > eval ctx prop = evalP $ fmap (ctx Map.!) prop > where > evalP = \case > Var b -> b > Not q -> not $ evalP q > And p q -> evalP p && evalP q > Or p q -> evalP p || evalP q > If p q -> evalP p ==> evalP q > Iff p q -> evalP p == evalP q > > What I would like to do in essence is to replace the data constructors > like so: > > -- Not valid Haskell!! Can't pattern match on constructor only... > magic = \case > Var -> id > Not -> not > And -> (&&) > Or -> (||) > If -> (==>) > Iff -> (==) > > compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) > > >>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) (Not > (Var 'Q')))) > ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) > (not (id False)))) > > Note how the compiled expression exactly mirrors the AST, so there should > be some meta programming technique for this. > > Does anyone have an idea how I can achieve this? > > The full source code is here: https://gist.github.com/vimuel/ > 7dcb8a9f1d2b7b72f020d66ec4157d7b > > I am happy to take any other comments relating to my code... > > Best, > > Vilem > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From vl81 at kent.ac.uk Thu Feb 15 14:16:50 2018 From: vl81 at kent.ac.uk (Vilem-Benjamin Liepelt) Date: Thu, 15 Feb 2018 14:16:50 +0000 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: Hi David, I don't think this is well-typed. GHC seems to infer `Proposition a -> Bool -> Bool` (by majority vote?) but obviously then complains about the cases `id` and `not`. I believe that there is a way to do this with dependent types, but not sure whether this is possible in Haskell. Best, Vilem > On 2018-02-15, at 13:51, David Fox wrote: > > You actually can pattern match on constructor only: > > magic = \case > Var {} -> id > Not {}-> not > And {} -> (&&) > Or {} -> (||) > If {} -> (==>) > Iff {} -> (==) > > On Sun, Feb 11, 2018 at 6:30 PM, Vilem-Benjamin Liepelt > wrote: > Hi, > > I am looking for a solution to get rid of this silly boilerplate: > > eval :: Ord var => Map var Bool -> Proposition var -> Bool > eval ctx prop = evalP $ fmap (ctx Map.!) prop > where > evalP = \case > Var b -> b > Not q -> not $ evalP q > And p q -> evalP p && evalP q > Or p q -> evalP p || evalP q > If p q -> evalP p ==> evalP q > Iff p q -> evalP p == evalP q > > What I would like to do in essence is to replace the data constructors like so: > > -- Not valid Haskell!! Can't pattern match on constructor only... > magic = \case > Var -> id > Not -> not > And -> (&&) > Or -> (||) > If -> (==>) > Iff -> (==) > > compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) > > >>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) (Not (Var 'Q')))) > ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) (not (id False)))) > > Note how the compiled expression exactly mirrors the AST, so there should be some meta programming technique for this. > > Does anyone have an idea how I can achieve this? > > The full source code is here: https://gist.github.com/vimuel/7dcb8a9f1d2b7b72f020d66ec4157d7b > > I am happy to take any other comments relating to my code... > > Best, > > Vilem > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From vl81 at kent.ac.uk Thu Feb 15 14:17:51 2018 From: vl81 at kent.ac.uk (Vilem-Benjamin Liepelt) Date: Thu, 15 Feb 2018 14:17:51 +0000 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: PS: I meant cases `Var {}` and `Not {}`. > On 2018-02-15, at 14:16, Vilem-Benjamin Liepelt wrote: > > Hi David, > > I don't think this is well-typed. GHC seems to infer `Proposition a -> Bool -> Bool` (by majority vote?) but obviously then complains about the cases `id` and `not`. > > I believe that there is a way to do this with dependent types, but not sure whether this is possible in Haskell. > > Best, > > Vilem > >> On 2018-02-15, at 13:51, David Fox > wrote: >> >> You actually can pattern match on constructor only: >> >> magic = \case >> Var {} -> id >> Not {}-> not >> And {} -> (&&) >> Or {} -> (||) >> If {} -> (==>) >> Iff {} -> (==) >> >> On Sun, Feb 11, 2018 at 6:30 PM, Vilem-Benjamin Liepelt > wrote: >> Hi, >> >> I am looking for a solution to get rid of this silly boilerplate: >> >> eval :: Ord var => Map var Bool -> Proposition var -> Bool >> eval ctx prop = evalP $ fmap (ctx Map.!) prop >> where >> evalP = \case >> Var b -> b >> Not q -> not $ evalP q >> And p q -> evalP p && evalP q >> Or p q -> evalP p || evalP q >> If p q -> evalP p ==> evalP q >> Iff p q -> evalP p == evalP q >> >> What I would like to do in essence is to replace the data constructors like so: >> >> -- Not valid Haskell!! Can't pattern match on constructor only... >> magic = \case >> Var -> id >> Not -> not >> And -> (&&) >> Or -> (||) >> If -> (==>) >> Iff -> (==) >> >> compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) >> >> >>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) (Not (Var 'Q')))) >> ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) (not (id False)))) >> >> Note how the compiled expression exactly mirrors the AST, so there should be some meta programming technique for this. >> >> Does anyone have an idea how I can achieve this? >> >> The full source code is here: https://gist.github.com/vimuel/7dcb8a9f1d2b7b72f020d66ec4157d7b >> >> I am happy to take any other comments relating to my code... >> >> Best, >> >> Vilem >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dsf at seereason.com Thu Feb 15 20:00:44 2018 From: dsf at seereason.com (David Fox) Date: Thu, 15 Feb 2018 12:00:44 -0800 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: True, but my point about pattern matching constructors stands.​ On Thu, Feb 15, 2018 at 6:17 AM, Vilem-Benjamin Liepelt wrote: > PS: I meant cases `Var {}` and `Not {}`. > > On 2018-02-15, at 14:16, Vilem-Benjamin Liepelt wrote: > > Hi David, > > I don't think this is well-typed. GHC seems to infer `Proposition a -> > Bool -> Bool` (by majority vote?) but obviously then complains about the > cases `id` and `not`. > > I believe that there is a way to do this with dependent types, but not > sure whether this is possible in Haskell. > > Best, > > Vilem > > On 2018-02-15, at 13:51, David Fox wrote: > > You actually can pattern match on constructor only: > > magic = \case > Var {} -> id > Not {}-> not > And {} -> (&&) > Or {} -> (||) > If {} -> (==>) > Iff {} -> (==) > > On Sun, Feb 11, 2018 at 6:30 PM, Vilem-Benjamin Liepelt > wrote: > >> Hi, >> >> I am looking for a solution to get rid of this silly boilerplate: >> >> eval :: Ord var => Map var Bool -> Proposition var -> Bool >> eval ctx prop = evalP $ fmap (ctx Map.!) prop >> where >> evalP = \case >> Var b -> b >> Not q -> not $ evalP q >> And p q -> evalP p && evalP q >> Or p q -> evalP p || evalP q >> If p q -> evalP p ==> evalP q >> Iff p q -> evalP p == evalP q >> >> What I would like to do in essence is to replace the data constructors >> like so: >> >> -- Not valid Haskell!! Can't pattern match on constructor only... >> magic = \case >> Var -> id >> Not -> not >> And -> (&&) >> Or -> (||) >> If -> (==>) >> Iff -> (==) >> >> compile = transformAST magic $ fmap (\case 'P' -> False; 'Q' -> True) >> >> >>> compile (Iff (Not (And (Var 'P') (Var 'Q'))) (Or (Not (Var 'P')) (Not >> (Var 'Q')))) >> ((==) (not ((&&) (id True) (id False))) ((||) (not (id True)) >> (not (id False)))) >> >> Note how the compiled expression exactly mirrors the AST, so there should >> be some meta programming technique for this. >> >> Does anyone have an idea how I can achieve this? >> >> The full source code is here: https://gist.github.com/vimuel >> /7dcb8a9f1d2b7b72f020d66ec4157d7b >> >> I am happy to take any other comments relating to my code... >> >> Best, >> >> Vilem >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From leiva.steven at gmail.com Fri Feb 16 17:02:52 2018 From: leiva.steven at gmail.com (Steven Leiva) Date: Fri, 16 Feb 2018 11:02:52 -0600 Subject: [Haskell-cafe] web framework In-Reply-To: References: <0F9A90C6ED054E929E20475D6449DB2D@gregava> Message-ID: On the backend, there are a lot of options for you. - Snap - Servant - Yesod - Happstack I personally love Yesod, and am very grateful for that framework getting me to the point where I am writing real-world web applications. The other frameworks have a lot ot offer, but I think Yesod will be the quickest in getting you to write your app, it has a book, there are a lot of examples, and the community is very helpful. On the front-end, I myself am very confused. Please verify everything below: - PureScript is a completely programming language; you'd use it in place of JavaScript - *Halogen*, *Pux*, *Thermit* are UI libraries written in PureScript. I believe that Pux / Thermit are wrappers around React (or follow the React paradigm). - Another popular option for the front-end is *Elm* - I didn't even know of Miso but it looks fantastic. While I strongly recommend Yesod on the back-end, I'm hesitant to recommend anything on the front-end. Gun to my head, I'd pick Elm, only because it is giving me the static type safety I value highly (they all do that), and it seems like there are more UI libraries in Elm. I'm terrible at the front-end so I really very heavily on ready-built components, and Elm seems to have more of those that the rest. On Fri, Feb 9, 2018 at 9:00 PM, Matt wrote: > If you know Haskell, then the remaining bits of PureScript will not take > very long. It's like moving from C++ to Java, or Ruby to Python. Most of > your experience carries over, and you can learn the differences as they > arise. You can likely be productive in PureScript tomorrow. > > There's a lot of discussion on PureScript development on the FPChat slack, > invite link here: https://fpchat-invite.herokuapp.com/ > > In my experience, PureScript has been much nicer to work with than GHCJS > or Elm. PureScript's editor tooling is absolutely fantastic, and the > language has "fixed" a number of warts in Haskell. The record system and > interop with JavaScript are wonderful, as well. > > Matt Parsons > > On Fri, Feb 9, 2018 at 7:54 PM, Dennis Raddle > wrote: > >> Thanks, but what do you think the learning curve will be on PureScript? >> How similar to Haskell is it? >> >> I want to balance some factors here. As my initial goal is rapid >> prototyping and experimentation, I'd like to use a language I already know >> well, in other words Haskell. >> >> But of course even with a familiar language, I'm going into a quite >> unfamiliar situation (web programming) and there is a learning curve with >> that. >> >> It may be that a language other than Haskell, i.e. PureScript, although >> requiring a learning curve, would be more suited to my app's needs and thus >> save me grief. >> >> I don't know. >> Dennis >> ​ >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- Steven Leiva 305.528.6038 leiva.steven at gmail.com http://www.linkedin.com/in/stevenleiva -------------- next part -------------- An HTML attachment was scrubbed... URL: From trebla at vex.net Sat Feb 17 07:48:57 2018 From: trebla at vex.net (Albert Y. C. Lai) Date: Sat, 17 Feb 2018 02:48:57 -0500 Subject: [Haskell-cafe] MonadComprehensions madness Message-ID: I am just starting to learn MonadComprehensions and I'm following its type rules to their logical conclusion. So I can have [ x | x <- "abc", then group by EXPR using PNT ] where EXPR is an expression of my choosing, PNT is a function of type forall a. (a -> E) -> [a] -> M (F a) where E is the type of EXPR, M is a Monad instance of my choosing, and F is a Functor instance of my choosing. (And even the [a] can be replaced by N a, as long as "abc" has type N Char.) (My freedom over M and F isn't quite documented in the GHC user's guide, but there is very little you can't discover by putting a few typed holes here and there >:) ) So I choose EXPR = ord x, E = Int, M = IO, F = IntMap, so I can have: {-# LANGUAGE MonadComprehensions, TransformListComp #-} module F where import Data.Char (chr, ord) import qualified Data.IntMap.Strict as IntMap foo :: IO (IntMap.IntMap Char) foo = [ x | x <- "a\r\n", then group by ord x using whee ] whee :: (a -> Int) -> [a] -> IO (IntMap.IntMap a) whee f xs = do print (map (chr . f) xs) return (IntMap.fromList (zip (map f xs) (reverse xs))) Warning: I have only proved that it type-checks; I have not understood what good it does. >:) From esz at posteo.de Sat Feb 17 16:43:23 2018 From: esz at posteo.de (Ertugrul =?utf-8?Q?S=C3=B6ylemez?=) Date: Sat, 17 Feb 2018 17:43:23 +0100 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: Message-ID: <87606va7o4.fsf@posteo.de> Hi, > -- I almost sure this is correct, since it is copied > -- from "Programming with Arrows", J. Hughes > mapA :: (ArrowChoice a) => a b c -> a [b] [c] > mapA f = proc input -> > case input of > [] -> returnA -< [] > z:zs -> do y_ <- f -< z > ys_ <- mapA f -< zs > returnA -< y_:ys_ Yes, this is correct. However, the ArrowChoice instance in Netwire has always been questionable. The correct (and much more efficient) way to implement mapA is as a primitive combinator much like the parallel switches in Yampa. The Netwire implementation and API has been more focussed on providing features over reasonable semantics, and that eventually led me to abandon it in favour of a more minimalistic library that is easier to reason about (wires). Please consider Netwire deprecated and I recommend you don't use it for new applications, if possible. I'm still open to reviewing and merging code contributions to support legacy applications, but other than that I would much prefer to just let it become a piece of AFRP history. =) If you must use AFRP, I recommend either my new library called wires, or the progenitor of all, Yampa. However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries. I currently recommend either: * reactive-banana: very simple and easy to learn API, plus the author runs a blog with lots of information on FRP. This is the library I recommend to FRP beginners. Or * reflex: my personal favourite, more focussed on practical concerns and efficiency, a more versatile API that easily integrates with applications with a "main loop", such as real-time games. The trade-off is far less documentation and a more complicated API. Sorry for not directly addressing your question, but I hope I convinced you to just switch to a different library. =) Greets ertes -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From ivanperezdominguez at gmail.com Sun Feb 18 09:17:36 2018 From: ivanperezdominguez at gmail.com (Ivan Perez) Date: Sun, 18 Feb 2018 04:17:36 -0500 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: <87606va7o4.fsf@posteo.de> References: <87606va7o4.fsf@posteo.de> Message-ID: Hi > However, unless you have a strong reason to use arrowized FRP I would recommend that you go with one of the first-class FRP libraries. TL;DR: Shameless self promotion ahead: we built an elementary library that seems to subsume many others, including AFRP and Classic FRP libraries, I'd like to know how it compares. Seeing what's just been said about netwire, I'd like to ask how these compare to each other. Among themselves, and also in relation to a separate construct that Manuel Bärenz and I built (note: I am the Yampa maintainer; Yampa is alive and well and more updates are coming your way :) ). In 2016 we published an article [1; mirror: 4] and a library [2] which aim at merging ideas in this field. I always thought they were pretty powerful, and so far I haven't found many limitations. (But I am biased, so maybe not the ideal judge.) It combines the CPS-based arrowized construct of Yampa with a monad, in a tiny definition: newtype MSF m a b = MSF { step :: a -> m (b, MSF m a b) } So, you provide one input sample and get, in a monadic context, an output and a continuation. Next time you provide the next input to the continuation, and so on. You can define stream as: type MStream m b = MSF m () b You can define sinks as: type MSink m a = MSF m a () They have really cool properties [3], for instance, they are arrows, and if the monad is commutative then the arrow is commutative. We have instances for many other Arrow* classes. You can also define FRP on top of it, in the time-continuous sense, by using a Reader monad: type YampaSF a b = MSF (Reader Time) a b We have a version of Yampa defined on top of this that runs full (free and commercial) games just fine. It's API compatible (for what it implements). And, you can define classic FRP signals (and sinks, a-la reactive banana and, if paired, more similar to Daniel Winograd-Cort's work or Keera Hails): type Signal a = MStream Time a So you can use applicative style: s :: Signal Double s = -- predefined somewhere biggerS :: Signal Double biggerS = (* 100) <*> s You can do extremely cool things just by altering the monad: - If the monad is Maybe, they terminate because there may not be a continuation (and an output). - If the monad is Either, they terminate with a result. This is the basis for switching, which we get "for free". - If the monad is [], they spawn. This implements parallelism with broadcasting for free. - You can use a Writer monad and some smart tricks to do continuous collision detection. - You can use state if to avoid the bottleneck issue that people criticise AFRP for. - You can use transformers to stack these effects. - You can also use IO as your monad, if you want to access mouse position and other external stuff, print a log, or sink directly from your network. So far, I've found that we can pretty much do anything we want with this. It's simple to use, classic or arrowized at will (you can combine the two). I'm investigating performance, which for the games I've tried is really good and gives us flat and low memory profiles, and I believe we can do some pretty smart things with GADTS and re-writes to make things as fast as they can theoretically be. How does this compare to other FRP and F;RP libraries around? Cheers Ivan PS. For whoever is interested, there's the FRP zoo on github that shows the same example in multiple variants. [1] https://dl.acm.org/citation.cfm?id=2976010 [2] https://hackage.haskell.org/package/dunai [3] http://www.cs.nott.ac.uk/~psxip1/papers/msfmathprops.pdf [4] http://www.cs.nott.ac.uk/~psxip1/papers/2016-HaskellSymposium-Perez-Barenz-Nilsson-FRPRefactored-short.pdf On 17 February 2018 at 11:43, Ertugrul Söylemez wrote: > Hi, > > > -- I almost sure this is correct, since it is copied > > -- from "Programming with Arrows", J. Hughes > > mapA :: (ArrowChoice a) => a b c -> a [b] [c] > > mapA f = proc input -> > > case input of > > [] -> returnA -< [] > > z:zs -> do y_ <- f -< z > > ys_ <- mapA f -< zs > > returnA -< y_:ys_ > > Yes, this is correct. However, the ArrowChoice instance in Netwire has > always been questionable. The correct (and much more efficient) way to > implement mapA is as a primitive combinator much like the parallel > switches in Yampa. > > The Netwire implementation and API has been more focussed on providing > features over reasonable semantics, and that eventually led me to > abandon it in favour of a more minimalistic library that is easier to > reason about (wires). Please consider Netwire deprecated and I > recommend you don't use it for new applications, if possible. I'm still > open to reviewing and merging code contributions to support legacy > applications, but other than that I would much prefer to just let it > become a piece of AFRP history. =) > > If you must use AFRP, I recommend either my new library called wires, or > the progenitor of all, Yampa. However, unless you have a strong reason > to use arrowized FRP I would recommend that you go with one of the > first-class FRP libraries. I currently recommend either: > > * reactive-banana: very simple and easy to learn API, plus the author > runs a blog with lots of information on FRP. This is the library I > recommend to FRP beginners. Or > > * reflex: my personal favourite, more focussed on practical concerns > and efficiency, a more versatile API that easily integrates with > applications with a "main loop", such as real-time games. The > trade-off is far less documentation and a more complicated API. > > Sorry for not directly addressing your question, but I hope I convinced > you to just switch to a different library. =) > > > Greets > ertes > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ivanperezdominguez at gmail.com Sun Feb 18 09:20:35 2018 From: ivanperezdominguez at gmail.com (Ivan Perez) Date: Sun, 18 Feb 2018 04:20:35 -0500 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: <87606va7o4.fsf@posteo.de> Message-ID: On 18 February 2018 at 04:17, Ivan Perez wrote: > [...] > > type Signal a = MStream Time a > Sorry. Made a mistake. Should be: type Signal a = MStream (Reader Time) a -------------- next part -------------- An HTML attachment was scrubbed... URL: From oleg.grenrus at iki.fi Sun Feb 18 11:10:18 2018 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Sun, 18 Feb 2018 13:10:18 +0200 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: <87606va7o4.fsf@posteo.de> Message-ID: <46338e0a-59f9-321c-8a23-937ae5b0c6ab@iki.fi> As a side comment, it's fun how this is re-invented in similar-ish contexts :) E.g. `machines` [1] newtype MealyT m a b = MealyT { runMealyT :: a -> m (b, MealyT m a b) } or `arrows` (a = Kleisli m) [2] newtype Automaton a b c = Automaton (a b (c, Automaton a b c)) [1]: http://hackage.haskell.org/package/machines-0.6.3/docs/Data-Machine-MealyT.html [2]: http://hackage.haskell.org/package/arrows-0.4.4.1/docs/Control-Arrow-Transformer-Automaton.html On 18.02.2018 11:17, Ivan Perez wrote: > Hi > > > However, unless you have a strong reason to use arrowized FRP I > would recommend that you go with one of the first-class FRP libraries.  > > TL;DR: Shameless self promotion ahead: we built an elementary library > that seems to subsume many others, including AFRP and Classic FRP > libraries, I'd like to know how it compares. > > Seeing what's just been said about netwire, I'd like to ask how these > compare to each other. Among themselves, and also in relation to a > separate construct that Manuel Bärenz and I built (note: I am the > Yampa maintainer; Yampa is alive and well and more updates are coming > your way :) ). > > In 2016 we published an article [1; mirror: 4] and a library [2] which > aim at merging ideas in this field. I always thought they were pretty > powerful, and so far I haven't found many limitations. (But I am > biased, so maybe not the ideal judge.) > > It combines the CPS-based arrowized construct of Yampa with a monad, > in a tiny definition: > > newtype MSF m a b = MSF { step :: a -> m (b, MSF m a b) } > > So, you provide one input sample and get, in a monadic context, an > output and a continuation. Next time you provide the next input to the > continuation, and so on. > > You can define stream as: > > type MStream m b = MSF m () b > > You can define sinks as: > > type MSink m a = MSF m a () > > They have really cool properties [3], for instance, they are arrows, > and if the monad is commutative then the arrow is commutative. We have > instances for many other Arrow* classes. > > You can also define FRP on top of it, in the time-continuous sense, by > using a Reader monad: > > type YampaSF a b = MSF (Reader Time) a b > > We have a version of Yampa defined on top of this that runs full (free > and commercial) games just fine. It's API compatible (for what it > implements). > > And, you can define classic FRP signals (and sinks, a-la reactive > banana and, if paired, more similar to Daniel Winograd-Cort's work or > Keera Hails): > > type Signal a = MStream Time a > > So you can use applicative style: > > s :: Signal Double > s = -- predefined somewhere > > biggerS :: Signal Double > biggerS = (* 100) <*> s > > You can do extremely cool things just by altering the monad: > - If the monad is Maybe, they terminate because there may not be a > continuation (and an output). > - If the monad is Either, they terminate with a result. This is the > basis for switching, which we get "for free". > - If the monad is [], they spawn. This implements parallelism with > broadcasting for free. > - You can use a Writer monad and some smart tricks to do continuous > collision detection. > - You can use state if to avoid the bottleneck issue that people > criticise AFRP for. > - You can use transformers to stack these effects. > - You can also use IO as your monad, if you want to access mouse > position and other external stuff, print a log, or sink directly from > your network. > > So far, I've found that we can pretty much do anything we want with > this. It's simple to use, classic or arrowized at will (you can > combine the two). I'm investigating performance, which for the games > I've tried is really good and gives us flat and low memory profiles, > and I believe we can do some pretty smart things with GADTS and > re-writes to make things as fast as they can theoretically be. > > How does this compare to other FRP and F;RP libraries around? > > Cheers > > Ivan > > PS. For whoever is interested, there's the FRP zoo on github that > shows the same example in multiple variants. > > [1] https://dl.acm.org/citation.cfm?id=2976010 > [2] https://hackage.haskell.org/package/dunai > [3] http://www.cs.nott.ac.uk/~psxip1/papers/msfmathprops.pdf > > [4] > http://www.cs.nott.ac.uk/~psxip1/papers/2016-HaskellSymposium-Perez-Barenz-Nilsson-FRPRefactored-short.pdf > > > On 17 February 2018 at 11:43, Ertugrul Söylemez > wrote: > > Hi, > > >         -- I almost sure this is correct, since it is copied > >         -- from "Programming with Arrows", J. Hughes > >       mapA :: (ArrowChoice a) => a b c -> a [b] [c] > >       mapA f = proc input -> > >         case input of > >           [] -> returnA -< [] > >           z:zs -> do y_ <- f -< z > >                      ys_ <- mapA f -< zs > >                      returnA -< y_:ys_ > > Yes, this is correct.  However, the ArrowChoice instance in > Netwire has > always been questionable.  The correct (and much more efficient) > way to > implement mapA is as a primitive combinator much like the parallel > switches in Yampa. > > The Netwire implementation and API has been more focussed on providing > features over reasonable semantics, and that eventually led me to > abandon it in favour of a more minimalistic library that is easier to > reason about (wires).  Please consider Netwire deprecated and I > recommend you don't use it for new applications, if possible.  I'm > still > open to reviewing and merging code contributions to support legacy > applications, but other than that I would much prefer to just let it > become a piece of AFRP history. =) > > If you must use AFRP, I recommend either my new library called > wires, or > the progenitor of all, Yampa.  However, unless you have a strong > reason > to use arrowized FRP I would recommend that you go with one of the > first-class FRP libraries.  I currently recommend either: > >   * reactive-banana: very simple and easy to learn API, plus the > author >     runs a blog with lots of information on FRP.  This is the > library I >     recommend to FRP beginners.  Or > >   * reflex: my personal favourite, more focussed on practical concerns >     and efficiency, a more versatile API that easily integrates with >     applications with a "main loop", such as real-time games.  The >     trade-off is far less documentation and a more complicated API. > > Sorry for not directly addressing your question, but I hope I > convinced > you to just switch to a different library. =) > > > Greets > ertes > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > Only members subscribed via the mailman list are allowed to post. > > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 18 13:09:25 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 18 Feb 2018 13:09:25 +0000 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> Message-ID: <20180218130925.GB8269@weber> > -- Not valid Haskell!! Can't pattern match on constructor only... > magic = \case > Var -> id > Not -> not > And -> (&&) > Or -> (||) > If -> (==>) > Iff -> (==) This has often seemed to me to be a natural extension of case syntax. There is a short analysis in the following Reddit post: https://www.reddit.com/r/haskell/comments/7s0ski/lambdacase_in_the_wild/dt1zzyy/ I would be strongly in favour of adding an extension to do this (unless someone can find a reason that it couldn't work). Tom From ollie at ocharles.org.uk Sun Feb 18 16:36:42 2018 From: ollie at ocharles.org.uk (Oliver Charles) Date: Sun, 18 Feb 2018 16:36:42 +0000 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: <87606va7o4.fsf@posteo.de> Message-ID: On Sun, Feb 18, 2018 at 9:17 AM, Ivan Perez wrote: > Hi > > > However, unless you have a strong reason to use arrowized FRP I would > recommend that you go with one of the first-class FRP libraries. > > TL;DR: Shameless self promotion ahead: we built an elementary library that > seems to subsume many others, including AFRP and Classic FRP libraries, I'd > like to know how it compares. > > Seeing what's just been said about netwire, I'd like to ask how these > compare to each other. Among themselves, and also in relation to a separate > construct that Manuel Bärenz and I built (note: I am the Yampa maintainer; > Yampa is alive and well and more updates are coming your way :) ). > > In 2016 we published an article [1; mirror: 4] and a library [2] which aim > at merging ideas in this field. I always thought they were pretty powerful, > and so far I haven't found many limitations. (But I am biased, so maybe not > the ideal judge.) > > It combines the CPS-based arrowized construct of Yampa with a monad, in a > tiny definition: > > newtype MSF m a b = MSF { step :: a -> m (b, MSF m a b) } > I believe this is exactly what a `Wire` is from the `wires` library: https://github.com/esoeylemez/wires/blob/master/Control/Wire/Internal.hs#L89 Ollie -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.reich at gmail.com Sun Feb 18 16:56:02 2018 From: ryan.reich at gmail.com (Ryan Reich) Date: Sun, 18 Feb 2018 08:56:02 -0800 Subject: [Haskell-cafe] Replace data constructors via meta programming In-Reply-To: <20180218130925.GB8269@weber> References: <1ADD731F-C53E-4F0C-8BA6-DED40EEE8F9D@kent.ac.uk> <20180218130925.GB8269@weber> Message-ID: Just to cheerlead Tom, as I have nothing to add but wouldn't want it to seem like no one agreed, I also think this is a great idea. The objection on the Reddit thread about dependent functions isn't prohibitive: both of these features will be GHC extensions anyway. They can be exclusive. On Feb 18, 2018 05:11, "Tom Ellis" < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > > > -- Not valid Haskell!! Can't pattern match on constructor only... > > magic = \case > > Var -> id > > Not -> not > > And -> (&&) > > Or -> (||) > > If -> (==>) > > Iff -> (==) > > This has often seemed to me to be a natural extension of case syntax. > There > is a short analysis in the following Reddit post: > > https://www.reddit.com/r/haskell/comments/7s0ski/ > lambdacase_in_the_wild/dt1zzyy/ > > I would be strongly in favour of adding an extension to do this (unless > someone can find a reason that it couldn't work). > > Tom > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From ivanperezdominguez at gmail.com Sun Feb 18 17:08:24 2018 From: ivanperezdominguez at gmail.com (Ivan Perez) Date: Sun, 18 Feb 2018 12:08:24 -0500 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: <87606va7o4.fsf@posteo.de> Message-ID: On 18 February 2018 at 11:36, Oliver Charles wrote: > On Sun, Feb 18, 2018 at 9:17 AM, Ivan Perez > wrote: > >> Hi >> >> > However, unless you have a strong reason to use arrowized FRP I would >> recommend that you go with one of the first-class FRP libraries. >> >> TL;DR: Shameless self promotion ahead: we built an elementary library >> that seems to subsume many others, including AFRP and Classic FRP >> libraries, I'd like to know how it compares. >> >> Seeing what's just been said about netwire, I'd like to ask how these >> compare to each other. Among themselves, and also in relation to a separate >> construct that Manuel Bärenz and I built (note: I am the Yampa maintainer; >> Yampa is alive and well and more updates are coming your way :) ). >> >> In 2016 we published an article [1; mirror: 4] and a library [2] which >> aim at merging ideas in this field. I always thought they were pretty >> powerful, and so far I haven't found many limitations. (But I am biased, so >> maybe not the ideal judge.) >> >> It combines the CPS-based arrowized construct of Yampa with a monad, in a >> tiny definition: >> >> newtype MSF m a b = MSF { step :: a -> m (b, MSF m a b) } >> > > I believe this is exactly what a `Wire` is from the `wires` library: > > https://github.com/esoeylemez/wires/blob/master/Control/Wire > /Internal.hs#L89 > > Ollie > This is great to know :) Given then that what I said about classic FRP and many variants of FRP should apply to wires too, how would programming in a classic FRP library be any different from using Wires, Dunai, Varying, etc., all of which are based on the same construct? (Performance aside.) Ivan [1] https://hackage.haskell.org/package/varying -------------- next part -------------- An HTML attachment was scrubbed... URL: From esz at posteo.de Sun Feb 18 22:26:01 2018 From: esz at posteo.de (Ertugrul =?utf-8?Q?S=C3=B6ylemez?=) Date: Sun, 18 Feb 2018 23:26:01 +0100 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: <87606va7o4.fsf@posteo.de> Message-ID: <87zi467x52.fsf@posteo.de> Hi Ivan, > Given then that what I said about classic FRP and many variants of FRP > should apply to wires too, how would programming in a classic FRP library > be any different from using Wires, Dunai, Varying, etc., all of which are > based on the same construct? (Performance aside.) the main difference between AFRP and first-class FRP is that in the latter behaviours and events are, well, *first-class*. For example in reflex when you construct a (Behavior t Integer), this is an actual value that is not tied to any particular monad or arrow. It can be stored in data structures and is subject to garbage-collection like every other value. Some operations still require a certain monad, but that is only necessary because those are bound to an instant in time. For example you can't 'hold' an event in a pure function, holding requires a notion of "now", which a pure function cannot provide. In AFRP all behaviours and events are "virtual" in a sense. Though arrow notation can make it look like they are actual values this is really just an illusion. That's why you can't sensibly communicate an event out of the wire/SF/MSF/MealyT/… Greets ertes -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From ivanperezdominguez at gmail.com Mon Feb 19 00:55:06 2018 From: ivanperezdominguez at gmail.com (Ivan Perez) Date: Sun, 18 Feb 2018 19:55:06 -0500 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: <87zi467x52.fsf@posteo.de> References: <87606va7o4.fsf@posteo.de> <87zi467x52.fsf@posteo.de> Message-ID: On 18 February 2018 at 17:26, Ertugrul Söylemez wrote: > [...] > > In AFRP all behaviours and events are "virtual" in a sense. Only in "pure" forms of AFRP, that is, those without a monad, and only so long as you stick to the arrow framework and/or arrow notation. Just because something supports AFRP doesn't mean that you have to use it limited to the traditional AFRP interface. > Though > arrow notation can make it look like they are actual values this is > really just an illusion. > But this is what I mean when I talk about applicatives. I'm honestly not seeing a big difference between behaviours in CFRP and signals in Dunai/Wires/Varying. For instance, you can define Behaviour as: type Beh a = MSF Identity a (Or maybe a better monad ,or even an adhoc monad that connects the external providers in a referentially transparent way.) You can then put it in a data structure (it's a first-class entity), it will be garbage collected when appropriately, you can demand new values as necessary, and you can operate with it also "as if it where a signal": myBeh = f <$> beh1 <*> beh2 You can define instances of Num if you want to write: myBeh = beh1 + beh2 Although that's not easily extensible to all functions that act on values. > That's why you can't sensibly communicate an > event out of the wire/SF/MSF/MealyT/… > But you can. That's precisely what the monad allows you to do. I suspect I may not be understanding precisely what you mean. Perhaps you can describe this in more detail or with an example? (feel free to email me personally if this is derailing the original conversation off-topic.) If you mean what I understand from your words, I'd say you can communicate events out, and I do this all the time. I even built a system to synchronize discrete games with continuous animations without having to pipe data explicitly all the way up, based on "implicit" event passing using MSFs. Cheers Ivan -------------- next part -------------- An HTML attachment was scrubbed... URL: From esz at posteo.de Mon Feb 19 08:31:51 2018 From: esz at posteo.de (Ertugrul =?utf-8?Q?S=C3=B6ylemez?=) Date: Mon, 19 Feb 2018 09:31:51 +0100 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: <87606va7o4.fsf@posteo.de> <87zi467x52.fsf@posteo.de> Message-ID: <87vaet8jns.fsf@posteo.de> > I suspect I may not be understanding precisely what you mean. Perhaps > you can describe this in more detail or with an example? The easiest way to see the difference is by looking at some of the combinators. Notice that things like 'hold', 'scan'/'accum', and 'tag' are real functions. In a first-class FRP system these would have types like the following: hold :: a -> Event a -> Moment (Behaviour a) scan :: a -> Event (a -> a) -> Moment (Event a) tag :: Behaviour (a -> b) -> Event a -> Event b The Moment monad is not inherent to the way the underlying state machine is constructed, but acts merely as a provider for the notion of "now". Since 'tag' doesn't need that notion, it's a completely pure function. You can have that function in AFRP as well: fmap :: (a -> b) -> Event a -> Event b However, unlike 'fmap', 'tag' makes sense in a pure context. You can pass an Event and a Behaviour to a different thread via an MVar, combine them there, then send the result back, and it will still work in the context of the greater application (no isolated state machines). You can hold an event in any concurrent thread, etc. Another example is that if the underlying monad is nontrivial (say IO) you can't easily split behaviours in a pure context in AFRP. This restriction does not exist in first-class FRP: unzipB :: Behavior (a, b) -> (Behavior a, Behavior b) splitE :: Event (Either a b) -> (Event a, Event b) In AFRP you always have to do it in the context of the underlying state machine, i.e. MSF/SF/Wire, which means that AFRP forces you to manage all data structures holding reactive values as part of it or, again, have isolated state machines. With first-class FRP there is nothing wrong with keeping a data structure of behaviours in an MVar and have two concurrent threads modify it: MVar (Map K (Behaviour String)) AFRP requires the following instead, and unless all changes are planned within the state machine and communicated via 'A' changes actually build up in terms of complexity (you can't just keep composing it with more and more MSF actions for free): MVar (MSF IO A (Map K String)) Let me make clear that you can express all of these things in AFRP. In fact it's easily more powerful than first-class FRP, because if the system exposes it, you get full access to the expressivity of what is basically a generic state machine. Just to provide one example: there is no first-class counterpart to 'manage' from wires, because that combinator only really makes sense in the context of the underlying state machine. But all of this comes at the expense of giving up first-class behaviours and events in the above sense. If this still doesn't convince you, I strongly suggest that you give reflex a try. It has a very similar controller interface to AFRP (stepWire/unMSF) in that it gives you control over the main loop, so it shouldn't feel too alien. As a final remark due to all these issues and more with AFRP most of my research in the past few years went into getting rid of the A while retaining most of its advantages. Reflex (by Ryan Trinkle, not me) is almost there: it has the performance, the predictability and the expressivity. The only missing component is an equivalent to 'manage', i.e. effects without the controller round-trip, or what I call "switching with effects". Greets ertes -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From mail at joachim-breitner.de Mon Feb 19 19:40:27 2018 From: mail at joachim-breitner.de (Joachim Breitner) Date: Mon, 19 Feb 2018 14:40:27 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: Message-ID: <1519069227.1066.8.camel@joachim-breitner.de> Hi David, Am Sonntag, den 11.02.2018, 05:14 -0500 schrieb David Feuer: > Can I use reallyUnsafePtrEquality# reliably to identify whether a > value is a nullary constructor of a particular type? after reading this I cam up with this idea: https://ghc.haskell.org/trac/ghc/ticket/14826 You might have an idea of whether this would be useful in practice. Cheers, Joachim -- Joachim “nomeata” Breitner mail at joachim-breitner.de https://www.joachim-breitner.de/ -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: This is a digitally signed message part URL: From manny at fpcomplete.com Tue Feb 20 00:58:51 2018 From: manny at fpcomplete.com (Emanuel Borsboom) Date: Mon, 19 Feb 2018 16:58:51 -0800 Subject: [Haskell-cafe] ANN: stack-1.6.5 Message-ID: <97B32D6E-423E-48FC-9763-1E1A30806F39@fpcomplete.com> See https://haskellstack.org for installation and upgrade instructions. This is a bug-fix release. Bug fixes: * 1.6.1 introduced a change that made some precompiled cache files use longer paths, sometimes causing builds to fail on windows. This has been fixed. See [#3649](https://github.com/commercialhaskell/stack/issues/3649) * Some unnecessary rebuilds when no files were changed are now avoided, by having a separate build cache for each component of a package. See [#3732](https://github.com/commercialhaskell/stack/issues/3732). * Correct the behavior of promoting a package from snapshot to local package. This would get triggered when version bounds conflicted in a snapshot, which could be triggered via Hackage revisions for old packages. This also should allow custom snapshots to define conflicting versions of packages without issue. See [Stackage issue #3185](https://github.com/fpco/stackage/issues/3185). * When promoting packages from snapshot to local, we were occassionally discarding the actual package location content and instead defaulting to pulling the package from the index. We now correctly retain this information. Note that if you were affected by this bug, you will likely need to delete the binary build cache associated with the relevant custom snapshot. See [#3714](https://github.com/commercialhaskell/stack/issues/3714). * `--no-rerun-tests` has been fixed. Previously, after running a test we were forgetting to record the result, which meant that all tests always ran even if they had already passed before. See [#3770](https://github.com/commercialhaskell/stack/pull/3770). * Includes a patched version of `hackage-security` which fixes both some issues around asynchronous exception handling, and moves from directory locking to file locking, making the update mechanism resilient against SIGKILL and machine failure. See [hackage-security #187](https://github.com/haskell/hackage-security/issues/187) and [#3073](https://github.com/commercialhaskell/stack/issues/3073). Thanks to all our contributors for this release: * Arnaud Spiwack * Artyom * Artyom Kazak * Charles Reilly * Dave Tapley * Emanuel Borsboom * Joshua Simmons * Luke Murphy * Michael Sloan * Michael Snoyman * Nicolas Mattia * Paolo G. Giarrusso * Samuel Lelièvre * Simon Hengel * Thomas Broadley * tswelsh From ivanperezdominguez at gmail.com Tue Feb 20 01:00:59 2018 From: ivanperezdominguez at gmail.com (Ivan Perez) Date: Mon, 19 Feb 2018 20:00:59 -0500 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: <87vaet8jns.fsf@posteo.de> References: <87606va7o4.fsf@posteo.de> <87zi467x52.fsf@posteo.de> <87vaet8jns.fsf@posteo.de> Message-ID: I'm getting a bit confused with too many low-level details. Some of my responses are educated guesses, so maybe there's implementations that manage to circumvent what I say. Please, correct me where I'm wrong. On 19 February 2018 at 03:31, Ertugrul Söylemez wrote: > > I suspect I may not be understanding precisely what you mean. Perhaps > > you can describe this in more detail or with an example? > > The easiest way to see the difference is by looking at some of the > combinators. Notice that things like 'hold', 'scan'/'accum', and 'tag' > are real functions. In a first-class FRP system these would have types > like the following: > > hold :: a -> Event a -> Moment (Behaviour a) > scan :: a -> Event (a -> a) -> Moment (Event a) > tag :: Behaviour (a -> b) -> Event a -> Event b > > The Moment monad is not inherent to the way the underlying state machine > is constructed, but acts merely as a provider for the notion of "now". > Since 'tag' doesn't need that notion, it's a completely pure function. > Well, in a way. Yes, it can be a pure function, and an event can somehow be a delayed computation of how/when it is actually produced, computed/consumed the moment you want to actually evaluate the network. Saying that they are pure would be just fine if Behaviours did not depend on the outside world (that is, if they were "calculated" from pure haskell functions). But I don't think they are. Not always. Not if you want to depend on any external user input. In Reflex (and I'm not trying to discuss the particularities of this implementation), yes, Behaviour and Event are types in a family, but the actual definitions in Spider I can seee are records of IORefs with bangs. Far from pure. > You can have that function in AFRP as well: > > fmap :: (a -> b) -> Event a -> Event b > > However, unlike 'fmap', 'tag' makes sense in a pure context. You can > pass an Event and a Behaviour to a different thread via an MVar, combine > them there, then send the result back, and it will still work in the > context of the greater application (no isolated state machines). I don't see how you cannot do that with wires. For instance, you can send a Wire m () (Event b), and a Wire m () (a -> b), and compose them in a pure context. Then you can bring that back and use it. You > can hold an event in any concurrent thread, etc. > Can you use it without doing IO and executing the computation associated to calculating/polling the behaviour? If so, it must be because the FRP evaluation method has some inherent thread-safety (I you need IO + more for that). Wouldn't you be able to put that thread safety in your monad, and then use it with MSFs/Wires? > Another example is that if the underlying monad is nontrivial (say IO) > you can't easily split behaviours in a pure context in AFRP. You can, but you need a monad such that: (,) <$> ma <*> ma == (\x -> (x,x)) <$> ma. Is this called idempotent? But to implement any form of Classic FRP or Reactive Programming on top of MSFs, you want that kind of monad. This > restriction does not exist in first-class FRP: > Well, it is not exposed to the user, but someone must have thought about it and solved it. Duplication of effects is inherent to having monadic computations associated to obtaining the values of behaviours. If you don't cache for a given timestamp, you duplicate effects. The same mechanism they used could be applicable to your monadic AFRP variant. > unzipB :: Behavior (a, b) -> (Behavior a, Behavior b) > splitE :: Event (Either a b) -> (Event a, Event b) > > In AFRP you always have to do it in the context of the underlying state > machine, i.e. MSF/SF/Wire, which means that AFRP forces you to manage > all data structures holding reactive values as part of it or, again, > have isolated state machines. With first-class FRP there is nothing > wrong with keeping a data structure of behaviours in an MVar and have > two concurrent threads modify it: > > MVar (Map K (Behaviour String)) > > AFRP requires the following instead, and unless all changes are planned > within the state machine and communicated via 'A' changes actually build > up in terms of complexity (you can't just keep composing it with more > and more MSF actions for free): > > MVar (MSF IO A (Map K String)) > I could be wrong, but I think most of your problems go away with the kind of monad I mentioned. > Let me make clear that you can express all of these things in AFRP. In > fact it's easily more powerful than first-class FRP, because if the > system exposes it, you get full access to the expressivity of what is > basically a generic state machine. Just to provide one example: there > is no first-class counterpart to 'manage' from wires, because that > combinator only really makes sense in the context of the underlying > state machine. But all of this comes at the expense of giving up > first-class behaviours and events in the above sense. > > If this still doesn't convince you, I strongly suggest that you give > reflex a try. It has a very similar controller interface to AFRP > (stepWire/unMSF) in that it gives you control over the main loop, so it > shouldn't feel too alien. > > As a final remark due to all these issues and more with AFRP most of my > research in the past few years went into getting rid of the A while > retaining most of its advantages. I cannot say I like arrow notation, or inputs based on tuples. We need more work on this. However, I decided to embrace the A and I am finding a lot of extensions and guarantees that are possible, or easier, thanks to that. > [...] > > Ivan -------------- next part -------------- An HTML attachment was scrubbed... URL: From manpacket at gmail.com Tue Feb 20 02:01:33 2018 From: manpacket at gmail.com (Mikhail Baykov) Date: Tue, 20 Feb 2018 10:01:33 +0800 Subject: [Haskell-cafe] Tsuru is hiring Message-ID: Tsuru Capital is hiring, full time and intern positions are available. Haskell knowledge is required, experience with pricing futures/options would be nice but not necessary. Located in Tokyo, company language is English. Casual environment, nice monitors and a big coffee machine. Details how to apply are on our website: http://www.tsurucapital.com/en/ Feel free to ask questions here, in email or #tsurucapital on freenode. From esz at posteo.de Tue Feb 20 04:17:32 2018 From: esz at posteo.de (Ertugrul =?utf-8?Q?S=C3=B6ylemez?=) Date: Tue, 20 Feb 2018 05:17:32 +0100 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: <87606va7o4.fsf@posteo.de> <87zi467x52.fsf@posteo.de> <87vaet8jns.fsf@posteo.de> Message-ID: <87lgfo8fc3.fsf@posteo.de> Hi Ivan, >> The easiest way to see the difference is by looking at some of the >> combinators. Notice that things like 'hold', 'scan'/'accum', and >> 'tag' are real functions. In a first-class FRP system these would >> have types like the following: >> >> hold :: a -> Event a -> Moment (Behaviour a) >> scan :: a -> Event (a -> a) -> Moment (Event a) >> tag :: Behaviour (a -> b) -> Event a -> Event b >> >> The Moment monad is not inherent to the way the underlying state >> machine is constructed, but acts merely as a provider for the notion >> of "now". Since 'tag' doesn't need that notion, it's a completely >> pure function. > > Well, in a way. Yes, it can be a pure function, and an event can > somehow be a delayed computation of how/when it is actually produced, > computed/consumed the moment you want to actually evaluate the > network. > > Saying that they are pure would be just fine if Behaviours did not > depend on the outside world (that is, if they were "calculated" from > pure haskell functions). But I don't think they are. Not always. Not > if you want to depend on any external user input. Behaviours are actually pure values. They don't really depend on time or any effects. Their values may very well be generated from effects, for example the "current cursor position", but conceptually the behaviour that represents the whole timeline of values is indeed a pure value. There is a caveat of course: We like to think of behaviours as functions of time, but that's not the whole truth, because our capability to observe the value of a behaviour is very limited, in most implementations to an abstract notion of "now". The same is true for events: we can only ever ask whether an event is happening "now". That's how effects and a pure API can be compatible. We can think of behaviours as pure timelines (or functions of time), but the API cannot possibly give us full access to it. > In Reflex (and I'm not trying to discuss the particularities of this > implementation), yes, Behaviour and Event are types in a family, but > the actual definitions in Spider I can seee are records of IORefs with > bangs. Far from pure. Yes, of course. The implementation is shockingly impure and hacky, which is why there is such a massive test suite. =) There are much less hacky ways to implement it, but unfortunately some impurity is inevitable. The reason for Spider's hacikness is efficiency: Reflex is incredibly fast, and a lot of effort went into only ever computing things that matter, and never computing them twice. In my benchmarks it comes very close to wires, which is quite impressive, if you consider what thin an abstraction layer Wire (or MSF) is. >> You can have that function in AFRP as well: >> >> fmap :: (a -> b) -> Event a -> Event b >> >> However, unlike 'fmap', 'tag' makes sense in a pure context. You can >> pass an Event and a Behaviour to a different thread via an MVar, >> combine them there, then send the result back, and it will still work >> in the context of the greater application (no isolated state >> machines). > > I don't see how you cannot do that with wires. For instance, you can > send a Wire m () (Event b), and a Wire m () (a -> b), and compose them > in a pure context. Then you can bring that back and use it. Right. The difference is that you need to be very careful about context. If you have a "main wire", you must make sure to communicate that result back into it *or* run two wires concurrently. This caution is not necessary with first-class FRP, because it does not have that context-sensitivity. >> You can hold an event in any concurrent thread, etc. > > Can you use it without doing IO and executing the computation > associated to calculating/polling the behaviour? If so, it must be > because the FRP evaluation method has some inherent thread-safety (I > you need IO + more for that). Wouldn't you be able to put that thread > safety in your monad, and then use it with MSFs/Wires? Thread safety is a different matter, and yes, the implementation must be thread-safe for that to work. This is the reason why I was investigating an FRP implementation based on STM to see how fine-grained regions would pan out, but it was so slow that i abandoned that approach. Reflex does global locking, which sucks, but I can't think of a better way. To answer your question: it depends on the controller API of the framework. For example in Reflex the frame boundary is created by 'fireEventsAndRead'. This is the only action that can "advance time". You can use it from multiple threads, and it will have a timeline-global effect (you can have multiple timelines in Reflex, but if that doesn't make sense to you, just think of "timeline-global" as "global"). In reactive-banana the frame boundery is created by registered callbacks. R-b registers callbacks for events that matter (that's where 'fromAddHandler' and 'reactimate' meet), and whenever one of them is invoked, a new frame begins. In both cases the clock ticks as events fire. >> Another example is that if the underlying monad is nontrivial (say >> IO) you can't easily split behaviours in a pure context in AFRP. > > You can, but you need a monad such that: (,) <$> ma <*> ma == (\x -> > (x,x)) <$> ma. > > Is this called idempotent? > > But to implement any form of Classic FRP or Reactive Programming on > top of MSFs, you want that kind of monad. Not sure if idempotency is the right term, but in any case you have that monad in fist-class FRP. It's called Behavio(u)r. =) Note: The Monad instance for Behavior is not implemented yet in Reflex 0.4.0, but you can easily achieve the same by using 'pull' and 'sample': pull (liftA2 (,) (sample b1) (sample b2)) The instance is implemented in the git version. >> This restriction does not exist in first-class FRP: > > Well, it is not exposed to the user, but someone must have thought > about it and solved it. Duplication of effects is inherent to having > monadic computations associated to obtaining the values of > behaviours. If you don't cache for a given timestamp, you duplicate > effects. This is only really inherent to the mealy-machine approach (i.e. "what AFRP does"). The monads involved in first-class FRP really only serve to tie reactive combinators to "now". Their implementations only control when exactly (in which frame) you hold an event, which is usually a simple matter of effect sequencing, i.e. "having a monad". In other words: moment monads are generally just IO in disguise. > I cannot say I like arrow notation, or inputs based on tuples. We need > more work on this. > > However, I decided to embrace the A and I am finding a lot of > extensions and guarantees that are possible, or easier, thanks to > that. Cale Gibbard has done some work on desugaring arrow notation in smarter ways than the tuple-based approach we have now, but ultimately the whole arrow approach was abandoned (and eventually Reflex was born). My original approach with Netwire was to provide higher-level composition capabilities to reduce the amount of "side channels" necessary, which lead to an interesting Alternative instance for Netwire's version of Wire. One of the defining features of Netwire is the ability to "inhibit", which facilitates a form of switching that eliminates most use cases of Yampa's event-based switches. The following is a string-valued wire that displays "---", but every five seconds it switches to "Ding!" temporarily for one second: ("Ding!" . holdFor 1 <|> "---") . periodic 5 However, nowadays I think first-class FRP is the superior approach. Greets ertes -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From ivanperezdominguez at gmail.com Tue Feb 20 08:33:38 2018 From: ivanperezdominguez at gmail.com (Ivan Perez) Date: Tue, 20 Feb 2018 03:33:38 -0500 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: <87lgfo8fc3.fsf@posteo.de> References: <87606va7o4.fsf@posteo.de> <87zi467x52.fsf@posteo.de> <87vaet8jns.fsf@posteo.de> <87lgfo8fc3.fsf@posteo.de> Message-ID: On 19 February 2018 at 23:17, Ertugrul Söylemez wrote: > Hi Ivan, > > >> The easiest way to see the difference is by looking at some of the > >> combinators. Notice that things like 'hold', 'scan'/'accum', and > >> 'tag' are real functions. In a first-class FRP system these would > >> have types like the following: > >> > >> hold :: a -> Event a -> Moment (Behaviour a) > >> scan :: a -> Event (a -> a) -> Moment (Event a) > >> tag :: Behaviour (a -> b) -> Event a -> Event b > >> > >> The Moment monad is not inherent to the way the underlying state > >> machine is constructed, but acts merely as a provider for the notion > >> of "now". Since 'tag' doesn't need that notion, it's a completely > >> pure function. > > > > Well, in a way. Yes, it can be a pure function, and an event can > > somehow be a delayed computation of how/when it is actually produced, > > computed/consumed the moment you want to actually evaluate the > > network. > > > > Saying that they are pure would be just fine if Behaviours did not > > depend on the outside world (that is, if they were "calculated" from > > pure haskell functions). But I don't think they are. Not always. Not > > if you want to depend on any external user input. > > Behaviours are actually pure values. They don't really depend on time > or any effects. Their values may very well be generated from effects, > for example the "current cursor position", but conceptually the > behaviour that represents the whole timeline of values is indeed a pure > value. > I know how they are conceptually defined, but I think the word pure was stretched a lot here to fit this model, not the other way around. See [6]. Are we discussing Classic FRP as a concept, or as it is normally implemented? > There is a caveat of course: We like to think of behaviours as > functions of time, but that's not the whole truth, because our > capability to observe the value of a behaviour is very limited, in most > implementations to an abstract notion of "now". The same is true for > events: we can only ever ask whether an event is happening "now". > > That's how effects and a pure API can be compatible. We can think of > behaviours as pure timelines (or functions of time), but the API cannot > possibly give us full access to it. > > > > In Reflex (and I'm not trying to discuss the particularities of this > > implementation), yes, Behaviour and Event are types in a family, but > > the actual definitions in Spider I can seee are records of IORefs with > > bangs. Far from pure. > > Yes, of course. The implementation is shockingly impure and hacky, > which is why there is such a massive test suite. =) > > There are much less hacky ways to implement it, but unfortunately some > impurity is inevitable. The reason for Spider's hacikness is > efficiency: Reflex is incredibly fast, and a lot of effort went into > only ever computing things that matter, and never computing them twice. > In my benchmarks it comes very close to wires, which is quite > impressive, if you consider what thin an abstraction layer Wire (or MSF) > is. > > > >> You can have that function in AFRP as well: > >> > >> fmap :: (a -> b) -> Event a -> Event b > >> > >> However, unlike 'fmap', 'tag' makes sense in a pure context. You can > >> pass an Event and a Behaviour to a different thread via an MVar, > >> combine them there, then send the result back, and it will still work > >> in the context of the greater application (no isolated state > >> machines). > > > > I don't see how you cannot do that with wires. For instance, you can > > send a Wire m () (Event b), and a Wire m () (a -> b), and compose them > > in a pure context. Then you can bring that back and use it. > > Right. The difference is that you need to be very careful about > context. If you have a "main wire", you must make sure to communicate > that result back into it *or* run two wires concurrently. This caution > is not necessary with first-class FRP, because it does not have that > context-sensitivity. > That is only possible if, at the time of polling or connecting to the outside world, someone has done the job of avoiding double polling. Which you can do in the monad in wires, and get the same benefit. >> You can hold an event in any concurrent thread, etc. > > > > Can you use it without doing IO and executing the computation > > associated to calculating/polling the behaviour? If so, it must be > > because the FRP evaluation method has some inherent thread-safety (I > > you need IO + more for that). Wouldn't you be able to put that thread > > safety in your monad, and then use it with MSFs/Wires? > > Thread safety is a different matter, and yes, the implementation must be > thread-safe for that to work. This is the reason why I was > investigating an FRP implementation based on STM to see how fine-grained > regions would pan out, but it was so slow that i abandoned that > approach. I've used this for F;RP (the comma important) and the results were ok. For widget-based GUIs, this is fast enough. For games, probably not (haven't tried large games). > Reflex does global locking, which sucks, but I can't think of > a better way. > > To answer your question: it depends on the controller API of the > framework. For example in Reflex the frame boundary is created by > 'fireEventsAndRead'. This is the only action that can "advance time". > You can use it from multiple threads, and it will have a timeline-global > effect (you can have multiple timelines in Reflex, but if that doesn't > make sense to you, just think of "timeline-global" as "global"). > > In reactive-banana the frame boundery is created by registered > callbacks. R-b registers callbacks for events that matter (that's where > 'fromAddHandler' and 'reactimate' meet), and whenever one of them is > invoked, a new frame begins. > > In both cases the clock ticks as events fire. > > > >> Another example is that if the underlying monad is nontrivial (say > >> IO) you can't easily split behaviours in a pure context in AFRP. > > > > You can, but you need a monad such that: (,) <$> ma <*> ma == (\x -> > > (x,x)) <$> ma. > > > > Is this called idempotent? > > > > But to implement any form of Classic FRP or Reactive Programming on > > top of MSFs, you want that kind of monad. > > Not sure if idempotency is the right term, but in any case you have that > monad in fist-class FRP. It's called Behavio(u)r. =) > A behaviour is stronger than this. What I am giving is the broadest characterisation of a monad with the property we want. > > Note: The Monad instance for Behavior is not implemented yet in Reflex > 0.4.0, but you can easily achieve the same by using 'pull' and 'sample': > > pull (liftA2 (,) (sample b1) (sample b2)) > > The instance is implemented in the git version. > > > >> This restriction does not exist in first-class FRP: > > > > Well, it is not exposed to the user, but someone must have thought > > about it and solved it. Duplication of effects is inherent to having > > monadic computations associated to obtaining the values of > > behaviours. If you don't cache for a given timestamp, you duplicate > > effects. > > This is only really inherent to the mealy-machine approach (i.e. "what > AFRP does"). The monads involved in first-class FRP really only serve > to tie reactive combinators to "now". Their implementations only > control when exactly (in which frame) you hold an event, which is > usually a simple matter of effect sequencing, i.e. "having a monad". In > other words: moment monads are generally just IO in disguise. > If I depend on the same external behaviour (e.g. mouse position) from two parts of my program at the same time, what prevents the mouse position from being polled twice? > I cannot say I like arrow notation, or inputs based on tuples. We need > > more work on this. > > > > However, I decided to embrace the A and I am finding a lot of > > extensions and guarantees that are possible, or easier, thanks to > > that. > > Cale Gibbard has done some work on desugaring arrow notation in smarter > ways than the tuple-based approach we have now, but ultimately the whole > arrow approach was abandoned (and eventually Reflex was born). > Aha! That is interesting. Do you have a pointer to find that work? > > My original approach with Netwire was to provide higher-level > composition capabilities to reduce the amount of "side channels" > necessary, which lead to an interesting Alternative instance for > Netwire's version of Wire. One of the defining features of Netwire is > the ability to "inhibit", which facilitates a form of switching that > eliminates most use cases of Yampa's event-based switches. The > following is a string-valued wire that displays "---", but every five > seconds it switches to "Ding!" temporarily for one second: > > ("Ding!" . holdFor 1 <|> "---") . periodic 5 > > However, nowadays I think first-class FRP is the superior approach. > > > Greets > ertes > [6] https://dl.acm.org/citation.cfm?id=3110246 -------------- next part -------------- An HTML attachment was scrubbed... URL: From ivanperezdominguez at gmail.com Tue Feb 20 08:40:05 2018 From: ivanperezdominguez at gmail.com (Ivan Perez) Date: Tue, 20 Feb 2018 03:40:05 -0500 Subject: [Haskell-cafe] Arrow laws of Netwire In-Reply-To: References: <87606va7o4.fsf@posteo.de> <87zi467x52.fsf@posteo.de> <87vaet8jns.fsf@posteo.de> <87lgfo8fc3.fsf@posteo.de> Message-ID: On 20 February 2018 at 03:33, Ivan Perez wrote: > > > On 19 February 2018 at 23:17, Ertugrul Söylemez wrote: > >> Hi Ivan, >> >> >> The easiest way to see the difference is by looking at some of the >> >> combinators. Notice that things like 'hold', 'scan'/'accum', and >> >> 'tag' are real functions. In a first-class FRP system these would >> >> have types like the following: >> >> >> >> hold :: a -> Event a -> Moment (Behaviour a) >> >> scan :: a -> Event (a -> a) -> Moment (Event a) >> >> tag :: Behaviour (a -> b) -> Event a -> Event b >> >> >> >> The Moment monad is not inherent to the way the underlying state >> >> machine is constructed, but acts merely as a provider for the notion >> >> of "now". Since 'tag' doesn't need that notion, it's a completely >> >> pure function. >> > >> > Well, in a way. Yes, it can be a pure function, and an event can >> > somehow be a delayed computation of how/when it is actually produced, >> > computed/consumed the moment you want to actually evaluate the >> > network. >> > >> > Saying that they are pure would be just fine if Behaviours did not >> > depend on the outside world (that is, if they were "calculated" from >> > pure haskell functions). But I don't think they are. Not always. Not >> > if you want to depend on any external user input. >> >> Behaviours are actually pure values. They don't really depend on time >> or any effects. Their values may very well be generated from effects, >> for example the "current cursor position", but conceptually the >> behaviour that represents the whole timeline of values is indeed a pure >> value. >> > > I know how they are conceptually defined, but I think the word pure was > stretched a lot here to fit this model, not the other way around. See [6]. > > Are we discussing Classic FRP as a concept, or as it is normally > implemented? > > >> There is a caveat of course: We like to think of behaviours as >> functions of time, but that's not the whole truth, because our >> capability to observe the value of a behaviour is very limited, in most >> implementations to an abstract notion of "now". The same is true for >> events: we can only ever ask whether an event is happening "now". >> > I forgot to say: this is precisely how a definition of behaviour and Monadic Stream are related. The fact that, regardless of the conceptual definition, you'll be obtaining values progressively, always now, always "towards" the future. > >> That's how effects and a pure API can be compatible. We can think of >> behaviours as pure timelines (or functions of time), but the API cannot >> possibly give us full access to it. >> >> >> > In Reflex (and I'm not trying to discuss the particularities of this >> > implementation), yes, Behaviour and Event are types in a family, but >> > the actual definitions in Spider I can seee are records of IORefs with >> > bangs. Far from pure. >> >> Yes, of course. The implementation is shockingly impure and hacky, >> which is why there is such a massive test suite. =) >> >> There are much less hacky ways to implement it, but unfortunately some >> impurity is inevitable. The reason for Spider's hacikness is >> efficiency: Reflex is incredibly fast, and a lot of effort went into >> only ever computing things that matter, and never computing them twice. >> In my benchmarks it comes very close to wires, which is quite >> impressive, if you consider what thin an abstraction layer Wire (or MSF) >> is. >> >> >> >> You can have that function in AFRP as well: >> >> >> >> fmap :: (a -> b) -> Event a -> Event b >> >> >> >> However, unlike 'fmap', 'tag' makes sense in a pure context. You can >> >> pass an Event and a Behaviour to a different thread via an MVar, >> >> combine them there, then send the result back, and it will still work >> >> in the context of the greater application (no isolated state >> >> machines). >> > >> > I don't see how you cannot do that with wires. For instance, you can >> > send a Wire m () (Event b), and a Wire m () (a -> b), and compose them >> > in a pure context. Then you can bring that back and use it. >> >> Right. The difference is that you need to be very careful about >> context. If you have a "main wire", you must make sure to communicate >> that result back into it *or* run two wires concurrently. This caution >> is not necessary with first-class FRP, because it does not have that >> context-sensitivity. >> > > That is only possible if, at the time of polling or connecting to the > outside world, someone has done the job of avoiding double polling. Which > you can do in the monad in wires, and get the same benefit. > > >> You can hold an event in any concurrent thread, etc. >> > >> > Can you use it without doing IO and executing the computation >> > associated to calculating/polling the behaviour? If so, it must be >> > because the FRP evaluation method has some inherent thread-safety (I >> > you need IO + more for that). Wouldn't you be able to put that thread >> > safety in your monad, and then use it with MSFs/Wires? >> >> Thread safety is a different matter, and yes, the implementation must be >> thread-safe for that to work. This is the reason why I was >> investigating an FRP implementation based on STM to see how fine-grained >> regions would pan out, but it was so slow that i abandoned that >> approach. > > > I've used this for F;RP (the comma important) and the results were ok. For > widget-based GUIs, this is fast enough. For games, probably not (haven't > tried large games). > > >> Reflex does global locking, which sucks, but I can't think of >> a better way. >> >> To answer your question: it depends on the controller API of the >> framework. For example in Reflex the frame boundary is created by >> 'fireEventsAndRead'. This is the only action that can "advance time". >> You can use it from multiple threads, and it will have a timeline-global >> effect (you can have multiple timelines in Reflex, but if that doesn't >> make sense to you, just think of "timeline-global" as "global"). >> >> In reactive-banana the frame boundery is created by registered >> callbacks. R-b registers callbacks for events that matter (that's where >> 'fromAddHandler' and 'reactimate' meet), and whenever one of them is >> invoked, a new frame begins. >> >> In both cases the clock ticks as events fire. >> >> >> >> Another example is that if the underlying monad is nontrivial (say >> >> IO) you can't easily split behaviours in a pure context in AFRP. >> > >> > You can, but you need a monad such that: (,) <$> ma <*> ma == (\x -> >> > (x,x)) <$> ma. >> > >> > Is this called idempotent? >> > >> > But to implement any form of Classic FRP or Reactive Programming on >> > top of MSFs, you want that kind of monad. >> >> Not sure if idempotency is the right term, but in any case you have that >> monad in fist-class FRP. It's called Behavio(u)r. =) >> > > A behaviour is stronger than this. > > What I am giving is the broadest characterisation of a monad with the > property we want. > >> >> Note: The Monad instance for Behavior is not implemented yet in Reflex >> 0.4.0, but you can easily achieve the same by using 'pull' and 'sample': >> >> pull (liftA2 (,) (sample b1) (sample b2)) >> >> The instance is implemented in the git version. >> >> >> >> This restriction does not exist in first-class FRP: >> > >> > Well, it is not exposed to the user, but someone must have thought >> > about it and solved it. Duplication of effects is inherent to having >> > monadic computations associated to obtaining the values of >> > behaviours. If you don't cache for a given timestamp, you duplicate >> > effects. >> >> This is only really inherent to the mealy-machine approach (i.e. "what >> AFRP does"). The monads involved in first-class FRP really only serve >> to tie reactive combinators to "now". Their implementations only >> control when exactly (in which frame) you hold an event, which is >> usually a simple matter of effect sequencing, i.e. "having a monad". In >> other words: moment monads are generally just IO in disguise. >> > > If I depend on the same external behaviour (e.g. mouse position) from two > parts of my program at the same time, what prevents the mouse position from > being polled twice? > > > > I cannot say I like arrow notation, or inputs based on tuples. We need >> > more work on this. >> > >> > However, I decided to embrace the A and I am finding a lot of >> > extensions and guarantees that are possible, or easier, thanks to >> > that. >> >> Cale Gibbard has done some work on desugaring arrow notation in smarter >> ways than the tuple-based approach we have now, but ultimately the whole >> arrow approach was abandoned (and eventually Reflex was born). >> > > Aha! That is interesting. Do you have a pointer to find that work? > > >> >> My original approach with Netwire was to provide higher-level >> composition capabilities to reduce the amount of "side channels" >> necessary, which lead to an interesting Alternative instance for >> Netwire's version of Wire. One of the defining features of Netwire is >> the ability to "inhibit", which facilitates a form of switching that >> eliminates most use cases of Yampa's event-based switches. The >> following is a string-valued wire that displays "---", but every five >> seconds it switches to "Ding!" temporarily for one second: >> >> ("Ding!" . holdFor 1 <|> "---") . periodic 5 >> >> However, nowadays I think first-class FRP is the superior approach. >> >> >> Greets >> ertes >> > > [6] https://dl.acm.org/citation.cfm?id=3110246 > -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg at gregorycollins.net Tue Feb 20 22:56:19 2018 From: greg at gregorycollins.net (Gregory Collins) Date: Tue, 20 Feb 2018 17:56:19 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: Message-ID: On Sun, Feb 11, 2018 at 5:14 AM, David Feuer wrote: > Can I use reallyUnsafePtrEquality# reliably to identify whether a value is > a nullary constructor of a particular type? For example, if I have > > data Foo = Foo > > Can I write > > isFoo :: a -> Bool > isFoo !a = isTrue# (reallyUnsafePtrEquality# a Foo) > You mean like this? https://github.com/gregorycollins/hashtables/blob/master/src/Data/HashTable/Internal/UnsafeTricks.hs#L72 My experience is that this works, except when doing coverage, where the compiler adds instrumentation code that breaks the technique. I #ifdef'd my way around the problem, swapping out a slower impl when I was doing code coverage. Greg -------------- next part -------------- An HTML attachment was scrubbed... URL: From mail at joachim-breitner.de Wed Feb 21 02:43:10 2018 From: mail at joachim-breitner.de (Joachim Breitner) Date: Tue, 20 Feb 2018 21:43:10 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: Message-ID: <1519180990.7779.1.camel@joachim-breitner.de> Hi, Am Dienstag, den 20.02.2018, 17:56 -0500 schrieb Gregory Collins: > You mean like this? https://github.com/gregorycollins/hashtables/blob/master/src/Data/HashTable/Internal/UnsafeTricks.hs#L72 > > My experience is that this works, except when doing coverage, where the compiler adds instrumentation code that breaks the technique. I #ifdef'd my way around the problem, swapping out a slower impl when I was doing code coverage. it seems that in this case, https://ghc.haskell.org/trac/ghc/ticket/14826 would very much apply, wouldn’t it? Cheers, Joachim -- Joachim Breitner mail at joachim-breitner.de http://www.joachim-breitner.de/ -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: This is a digitally signed message part URL: From doug at cs.dartmouth.edu Wed Feb 21 14:33:01 2018 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Wed, 21 Feb 2018 09:33:01 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors Message-ID: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> > > Can I use reallyUnsafePtrEquality# reliably to identify whether a value is > a nullary constructor of a particular type? Can this "optimization" possibly save enough time to justify nonstandard trickery? This kind of obscure brittle coding may have been OK 50 years ago. But why do it now? Doug From andrei.paskevich at lri.fr Wed Feb 21 16:10:53 2018 From: andrei.paskevich at lri.fr (Andrei Paskevich) Date: Wed, 21 Feb 2018 17:10:53 +0100 Subject: [Haskell-cafe] VerifyThis 2018: Call for Problems and First Announcement Message-ID: <20180221161053.GA24135@tikki.lri.fr> ******************************************************************************* VerifyThis Verification Competition 2018 FIRST ANNOUNCEMENT AND CALL FOR PROBLEMS Competition to be held at ETAPS 2018 http://verifythis.ethz.ch ******************************************************************************** Get involved, even if you cannot participate in the competition: provide a challenge. IMPORTANT DATES Submission deadline: March 9, 2018 Competition: April 14 and 15, 2018 CALL FOR PROBLEMS To extend the problem pool, we are now soliciting algorithms and data structures which could contribute interesting verification challenges for the VerifyThis program verification competition (itself introduced below). We encourage suggestions at any level of detail, in particular submissions without a fully worked out verification task. - a problem may contain an informal statement of the algorithm to be implemented (optionally with complete or partial pseudocode) and the requirement(s) to be verified - a problem should be suitable for a 60-90 minute time slot - submission of reference solutions is welcome but not mandatory - problems with an inherent language- or tool-specific bias should be clearly identified as such - problems that contain several subproblems or other means of difficulty scaling are especially welcome - the organizers reserve the right (but no obligation) to use the problems in the competition, either as submitted or with modifications - submissions from (potential) competition participants are allowed Problems from previous competitions can be seen at http://verifythis.ethz.ch Submissions are to be sent by email to verifythis at cs.nuim.ie by the date indicated above. PRIZES The most suitable submission for competition will receive a prize. ABOUT VerifyThis 2018 will take place as part of the European Joint Conferences on Theory and Practice of Software (ETAPS 2018) on April 14 and 15, 2018. It is the 7th event in the VerifyThis competition series. Information on previous events and participants can be found at http://verifythis.ethz.ch The aims of the competition are: - to bring together those interested in formal verification, and to provide an engaging, hands-on, and fun opportunity for discussion - to evaluate the usability of logic-based program verification tools in a controlled experiment that could be easily repeated by others. The competition will offer a number of challenges presented in natural language. Participants have to formalize the requirements, implement a solution, and formally verify the implementation for adherence to the specification. There are no restrictions on the programming language and verification technology used. The correctness properties posed in problems will have the input-output behaviour of programs in focus. Solutions will be judged for correctness, completeness and elegance. ORGANIZERS * Marieke Huisman, University of Twente, the Netherlands * Rosemary Monahan, Maynooth University, Ireland * Peter Müller, ETH Zürich, Switzerland * Andrei Paskevich, Paris-Sud University, France * Gidon Ernst, National Institute of Informatics Tokyo, Japan CONTACT Email: verifythis at cs.nuim.ie Web: http://verifythis.ethz.ch From david.feuer at gmail.com Thu Feb 22 04:21:27 2018 From: david.feuer at gmail.com (David Feuer) Date: Wed, 21 Feb 2018 23:21:27 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> References: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> Message-ID: Because sometimes the sanctioned way is inefficient. throwIO always wraps its exception argument in a SomeException constructor before calling raiseIO# on the result. That extra baggage is likely enough to make the implementation I'm considering too slow to bother with, so I care right now in 2018. I'd very much prefer to get an officially-approved way to do what I want, but barring that I'll take one that works. On Wed, Feb 21, 2018 at 9:33 AM, Doug McIlroy wrote: > >> > Can I use reallyUnsafePtrEquality# reliably to identify whether a value is >> a nullary constructor of a particular type? > > Can this "optimization" possibly save enough time to justify > nonstandard trickery? > This kind of obscure brittle coding may have been OK 50 years > ago. But why do it now? > > Doug > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From branimir.maksimovic at gmail.com Thu Feb 22 04:23:51 2018 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Thu, 22 Feb 2018 05:23:51 +0100 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> Message-ID: Hm, isn't that exceptions are exceptional? On 22.02.2018. 05:21, David Feuer wrote: > Because sometimes the sanctioned way is inefficient. throwIO always > wraps its exception argument in a SomeException constructor before > calling raiseIO# on the result. That extra baggage is likely enough to > make the implementation I'm considering too slow to bother with, so I > care right now in 2018. I'd very much prefer to get an > officially-approved way to do what I want, but barring that I'll take > one that works. > > On Wed, Feb 21, 2018 at 9:33 AM, Doug McIlroy wrote: >>>> Can I use reallyUnsafePtrEquality# reliably to identify whether a value is >>> a nullary constructor of a particular type? >> Can this "optimization" possibly save enough time to justify >> nonstandard trickery? >> This kind of obscure brittle coding may have been OK 50 years >> ago. But why do it now? >> >> Doug >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From david.feuer at gmail.com Thu Feb 22 11:15:21 2018 From: david.feuer at gmail.com (David Feuer) Date: Thu, 22 Feb 2018 06:15:21 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> Message-ID: Well, not always. They have special support in the RTS that seems worth experimenting with. setjmp/longjmp is what I'm after. On Feb 21, 2018 11:24 PM, "Branimir Maksimovic" < branimir.maksimovic at gmail.com> wrote: > Hm, isn't that exceptions are exceptional? > > > On 22.02.2018. 05:21, David Feuer wrote: > >> Because sometimes the sanctioned way is inefficient. throwIO always >> wraps its exception argument in a SomeException constructor before >> calling raiseIO# on the result. That extra baggage is likely enough to >> make the implementation I'm considering too slow to bother with, so I >> care right now in 2018. I'd very much prefer to get an >> officially-approved way to do what I want, but barring that I'll take >> one that works. >> >> On Wed, Feb 21, 2018 at 9:33 AM, Doug McIlroy >> wrote: >> >>> Can I use reallyUnsafePtrEquality# reliably to identify whether a value >>>>> is >>>>> >>>> a nullary constructor of a particular type? >>>> >>> Can this "optimization" possibly save enough time to justify >>> nonstandard trickery? >>> This kind of obscure brittle coding may have been OK 50 years >>> ago. But why do it now? >>> >>> Doug >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >>> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Thu Feb 22 11:51:09 2018 From: allbery.b at gmail.com (Brandon Allbery) Date: Thu, 22 Feb 2018 06:51:09 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> Message-ID: But in most cases exceptions are the slow path. There's a few languages that use them heavily as what one could think of as a form of out of band dynamic typing for function results, and which have specific support for fast exceptions to support that. In most, exception handling is much heavier weight than the usual code path, and needs to be because it needs to unwind the stack and free up allocated temporaries (presumably that last doesn't apply to Haskell. The pattern match stack would need the same unwind cleanup though) and otherwise clean up any unfinished business that will never finish as a result, as it propagates looking for a handler. Since they also usually contain an execution trace, that makes them even heavier (again, ghc does this differently --- one could argue worse, since the price is paid by all functions with HasCallStack context. I think only Icon of other languages I know penalize the normal path the same way --- because it's also how &fail / retry semantics is implemented). ...looking at that again, maybe I'm too tired to do this. Hopefully you can unpack that concept hairball.... On Thu, Feb 22, 2018 at 6:15 AM, David Feuer wrote: > Well, not always. They have special support in the RTS that seems worth > experimenting with. setjmp/longjmp is what I'm after. > > On Feb 21, 2018 11:24 PM, "Branimir Maksimovic" < > branimir.maksimovic at gmail.com> wrote: > >> Hm, isn't that exceptions are exceptional? >> >> >> On 22.02.2018. 05:21, David Feuer wrote: >> >>> Because sometimes the sanctioned way is inefficient. throwIO always >>> wraps its exception argument in a SomeException constructor before >>> calling raiseIO# on the result. That extra baggage is likely enough to >>> make the implementation I'm considering too slow to bother with, so I >>> care right now in 2018. I'd very much prefer to get an >>> officially-approved way to do what I want, but barring that I'll take >>> one that works. >>> >>> On Wed, Feb 21, 2018 at 9:33 AM, Doug McIlroy >>> wrote: >>> >>>> Can I use reallyUnsafePtrEquality# reliably to identify whether a value >>>>>> is >>>>>> >>>>> a nullary constructor of a particular type? >>>>> >>>> Can this "optimization" possibly save enough time to justify >>>> nonstandard trickery? >>>> This kind of obscure brittle coding may have been OK 50 years >>>> ago. But why do it now? >>>> >>>> Doug >>>> _______________________________________________ >>>> Haskell-Cafe mailing list >>>> To (un)subscribe, modify options or view archives go to: >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>> Only members subscribed via the mailman list are allowed to post. >>>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >>> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Thu Feb 22 19:54:45 2018 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Thu, 22 Feb 2018 14:54:45 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> Message-ID: David: i'm inclined to agree with Doug here. Phrased differently: what is the example change in overheads in micro or milliseconds? what is an example tiny program where those overheads are a significant part of program overhead? why woulnd't they use something like https://www.microsoft.com/en-us/research/wp-content/uploads/2007/10/compilingwithcontinuationscontinued.pdf aka the so called "double barrelled cps" transform? On Wed, Feb 21, 2018 at 11:21 PM, David Feuer wrote: > Because sometimes the sanctioned way is inefficient. throwIO always > wraps its exception argument in a SomeException constructor before > calling raiseIO# on the result. That extra baggage is likely enough to > make the implementation I'm considering too slow to bother with, so I > care right now in 2018. I'd very much prefer to get an > officially-approved way to do what I want, but barring that I'll take > one that works. > > On Wed, Feb 21, 2018 at 9:33 AM, Doug McIlroy > wrote: > > > >> > Can I use reallyUnsafePtrEquality# reliably to identify whether a > value is > >> a nullary constructor of a particular type? > > > > Can this "optimization" possibly save enough time to justify > > nonstandard trickery? > > This kind of obscure brittle coding may have been OK 50 years > > ago. But why do it now? > > > > Doug > > _______________________________________________ > > Haskell-Cafe mailing list > > To (un)subscribe, modify options or view archives go to: > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Feb 22 20:12:46 2018 From: david.feuer at gmail.com (David Feuer) Date: Thu, 22 Feb 2018 15:12:46 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> Message-ID: Double-barreled continuations don't seem to work well when you want to abort construction of a recursive structure. Think about Data.HashMap.Strict.insert. We don't really want to have to walk all the way back up to the top if we discover that the value pointer we're inserting is the same as the I've already in the map. On Feb 22, 2018 2:55 PM, "Carter Schonwald" wrote: David: i'm inclined to agree with Doug here. Phrased differently: what is the example change in overheads in micro or milliseconds? what is an example tiny program where those overheads are a significant part of program overhead? why woulnd't they use something like https://www.microsoft. com/en-us/research/wp-content/uploads/2007/10/compilingwithcontinuationscont inued.pdf aka the so called "double barrelled cps" transform? On Wed, Feb 21, 2018 at 11:21 PM, David Feuer wrote: > Because sometimes the sanctioned way is inefficient. throwIO always > wraps its exception argument in a SomeException constructor before > calling raiseIO# on the result. That extra baggage is likely enough to > make the implementation I'm considering too slow to bother with, so I > care right now in 2018. I'd very much prefer to get an > officially-approved way to do what I want, but barring that I'll take > one that works. > > On Wed, Feb 21, 2018 at 9:33 AM, Doug McIlroy > wrote: > > > >> > Can I use reallyUnsafePtrEquality# reliably to identify whether a > value is > >> a nullary constructor of a particular type? > > > > Can this "optimization" possibly save enough time to justify > > nonstandard trickery? > > This kind of obscure brittle coding may have been OK 50 years > > ago. But why do it now? > > > > Doug > > _______________________________________________ > > Haskell-Cafe mailing list > > To (un)subscribe, modify options or view archives go to: > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg at gregorycollins.net Thu Feb 22 20:32:07 2018 From: greg at gregorycollins.net (Gregory Collins) Date: Thu, 22 Feb 2018 15:32:07 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: <1519180990.7779.1.camel@joachim-breitner.de> References: <1519180990.7779.1.camel@joachim-breitner.de> Message-ID: That's a really interesting idea, thanks for linking it. On Tue, Feb 20, 2018 at 9:43 PM, Joachim Breitner wrote: > Hi, > > Am Dienstag, den 20.02.2018, 17:56 -0500 schrieb Gregory Collins: > > You mean like this? https://github.com/gregorycollins/hashtables/ > blob/master/src/Data/HashTable/Internal/UnsafeTricks.hs#L72 > > > > My experience is that this works, except when doing coverage, where the > compiler adds instrumentation code that breaks the technique. I #ifdef'd my > way around the problem, swapping out a slower impl when I was doing code > coverage. > > it seems that in this case, > https://ghc.haskell.org/trac/ghc/ticket/14826 > would very much apply, wouldn’t it? > > Cheers, > Joachim > > -- > Joachim Breitner > mail at joachim-breitner.de > http://www.joachim-breitner.de/ > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- Gregory Collins -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Feb 22 21:00:40 2018 From: david.feuer at gmail.com (David Feuer) Date: Thu, 22 Feb 2018 16:00:40 -0500 Subject: [Haskell-cafe] Pointer equality for nullary constructors In-Reply-To: References: <201802211433.w1LEX1Lp022795@coolidge.cs.Dartmouth.EDU> Message-ID: Yes, by the way, insert would be a poor use case, since the "same value pointer" case will be fairly rare. The actual use-case I have in mind is alterF, where that case is much more likely. On Feb 22, 2018 3:12 PM, "David Feuer" wrote: > Double-barreled continuations don't seem to work well when you want to > abort construction of a recursive structure. Think about > Data.HashMap.Strict.insert. We don't really want to have to walk all the > way back up to the top if we discover that the value pointer we're > inserting is the same as the I've already in the map. > > On Feb 22, 2018 2:55 PM, "Carter Schonwald" > wrote: > > David: > i'm inclined to agree with Doug here. > > Phrased differently: what is the example change in overheads in micro or > milliseconds? > what is an example tiny program where those overheads are a significant > part of program overhead? > > why woulnd't they use something like https://www.microsoft.com > /en-us/research/wp-content/uploads/2007/10/compilingwithcont > inuationscontinued.pdf aka the so called "double barrelled cps" > transform? > > On Wed, Feb 21, 2018 at 11:21 PM, David Feuer > wrote: > >> Because sometimes the sanctioned way is inefficient. throwIO always >> wraps its exception argument in a SomeException constructor before >> calling raiseIO# on the result. That extra baggage is likely enough to >> make the implementation I'm considering too slow to bother with, so I >> care right now in 2018. I'd very much prefer to get an >> officially-approved way to do what I want, but barring that I'll take >> one that works. >> >> On Wed, Feb 21, 2018 at 9:33 AM, Doug McIlroy >> wrote: >> > >> >> > Can I use reallyUnsafePtrEquality# reliably to identify whether a >> value is >> >> a nullary constructor of a particular type? >> > >> > Can this "optimization" possibly save enough time to justify >> > nonstandard trickery? >> > This kind of obscure brittle coding may have been OK 50 years >> > ago. But why do it now? >> > >> > Doug >> > _______________________________________________ >> > Haskell-Cafe mailing list >> > To (un)subscribe, modify options or view archives go to: >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > Only members subscribed via the mailman list are allowed to post. >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Thu Feb 22 22:39:59 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Thu, 22 Feb 2018 22:39:59 +0000 Subject: [Haskell-cafe] No instance - but it could just put one in the context Message-ID: <20180222223959.GA21187@weber> I'm puzzled by GHC's behaviour in the following program. 'baz = bar . foo' does not work because there is "no instance for ...". But if I manually assume those instances in the context all is fine. Why can GHC not infer that context? Is there any extension or clever trick I can use to get this to infer like I want? Thanks, Tom {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} class Foo a b class Bar a b type family Quux a foo :: ( Foo a b , b ~ Quux a ) => a -> Quux a foo = undefined bar :: Bar a b => a -> b bar = undefined -- Doesn't work -- No instance for (Bar (Quux a0) c0) arising from a use of ‘bar’ -- No instance for (Foo a0 (Quux a0)) arising from a use of ‘foo’ --baz = bar . foo baz' :: ( Foo a (Quux a) , Bar (Quux a) b ) => a -> b baz' = bar . foo From gershomb at gmail.com Thu Feb 22 22:54:33 2018 From: gershomb at gmail.com (Gershom B) Date: Thu, 22 Feb 2018 17:54:33 -0500 Subject: [Haskell-cafe] ANN: Hackage Account Registration Changes Message-ID: As some people have seen, a spammer has started to create accounts on hackage to upload fake packages, in order to use their package-descriptions for linkspam. We'll be working to clean-up the package-index from this spam, and the accounts have been disabled. Further, we'll need to decide on some long-term changes going forward to make this sort of abuse more difficult. In the meantime, as a short term measure, we have changed new account registration policies on hackage. Users can still register as before, but new users do _not_ have upload rights until they explicitly request them and are granted them by a human being. (This is actually how we had configured hackage to work on initial deployment -- we loosened things up for some years as the extra step seemed unnecessary). Apologies for the inconvenience, but this seemed the most direct way to stop the current influx of spam. Users with existing hackage accounts should encounter no differences in behavior. Best, Gershom From adam at bergmark.nl Thu Feb 22 23:11:18 2018 From: adam at bergmark.nl (Adam Bergmark) Date: Thu, 22 Feb 2018 23:11:18 +0000 Subject: [Haskell-cafe] No instance - but it could just put one in the context In-Reply-To: <20180222223959.GA21187@weber> References: <20180222223959.GA21187@weber> Message-ID: This works if you enable NoMonomorphismRestriction. Cheers, Adam On Thu, 22 Feb 2018 at 23:41 Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > I'm puzzled by GHC's behaviour in the following program. > > 'baz = bar . foo' does not work because there is "no instance for ...". > But > if I manually assume those instances in the context all is fine. Why can > GHC not infer that context? Is there any extension or clever trick I can > use to get this to infer like I want? > > Thanks, > > Tom > > > > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE FlexibleContexts #-} > > class Foo a b > class Bar a b > type family Quux a > > foo :: ( Foo a b > , b ~ Quux a ) > => a > -> Quux a > foo = undefined > > bar :: Bar a b > => a > -> b > bar = undefined > > -- Doesn't work > -- No instance for (Bar (Quux a0) c0) arising from a use of ‘bar’ > -- No instance for (Foo a0 (Quux a0)) arising from a use of ‘foo’ > --baz = bar . foo > > baz' :: ( Foo a (Quux a) > , Bar (Quux a) b ) > => a > -> b > baz' = bar . foo > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Thu Feb 22 23:16:35 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Thu, 22 Feb 2018 23:16:35 +0000 Subject: [Haskell-cafe] No instance - but it could just put one in the context In-Reply-To: References: <20180222223959.GA21187@weber> Message-ID: <20180222231635.GB21187@weber> That's amazing! How many times have I been tripped up by that ... Thanks a lot, Adam. On Thu, Feb 22, 2018 at 11:11:18PM +0000, Adam Bergmark wrote: > This works if you enable NoMonomorphismRestriction. > > On Thu, 22 Feb 2018 at 23:41 Tom Ellis < > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > > > I'm puzzled by GHC's behaviour in the following program. > > > > 'baz = bar . foo' does not work because there is "no instance for ...". > > But > > if I manually assume those instances in the context all is fine. Why can > > GHC not infer that context? Is there any extension or clever trick I can > > use to get this to infer like I want? > > > > Thanks, > > > > Tom > > > > > > > > {-# LANGUAGE MultiParamTypeClasses #-} > > {-# LANGUAGE TypeFamilies #-} > > {-# LANGUAGE FlexibleContexts #-} > > > > class Foo a b > > class Bar a b > > type family Quux a > > > > foo :: ( Foo a b > > , b ~ Quux a ) > > => a > > -> Quux a > > foo = undefined > > > > bar :: Bar a b > > => a > > -> b > > bar = undefined > > > > -- Doesn't work > > -- No instance for (Bar (Quux a0) c0) arising from a use of ‘bar’ > > -- No instance for (Foo a0 (Quux a0)) arising from a use of ‘foo’ > > --baz = bar . foo > > > > baz' :: ( Foo a (Quux a) > > , Bar (Quux a) b ) > > => a > > -> b > > baz' = bar . foo From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Thu Feb 22 23:25:29 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Thu, 22 Feb 2018 23:25:29 +0000 Subject: [Haskell-cafe] No instance - but it could just put one in the context In-Reply-To: <20180222231635.GB21187@weber> References: <20180222223959.GA21187@weber> <20180222231635.GB21187@weber> Message-ID: <20180222232529.GC21187@weber> My next question is, could GHC suggest NoMonomorphismRestriction when it comes across such code? (In the same way it suggests FlexibleContexts, etc.) On Thu, Feb 22, 2018 at 11:16:35PM +0000, Tom Ellis wrote: > That's amazing! How many times have I been tripped up by that ... Thanks a > lot, Adam. > > On Thu, Feb 22, 2018 at 11:11:18PM +0000, Adam Bergmark wrote: > > This works if you enable NoMonomorphismRestriction. > > > > On Thu, 22 Feb 2018 at 23:41 Tom Ellis < > > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > > > > > I'm puzzled by GHC's behaviour in the following program. > > > > > > 'baz = bar . foo' does not work because there is "no instance for ...". > > > But > > > if I manually assume those instances in the context all is fine. Why can > > > GHC not infer that context? Is there any extension or clever trick I can > > > use to get this to infer like I want? > > > > > > Thanks, > > > > > > Tom > > > > > > > > > > > > {-# LANGUAGE MultiParamTypeClasses #-} > > > {-# LANGUAGE TypeFamilies #-} > > > {-# LANGUAGE FlexibleContexts #-} > > > > > > class Foo a b > > > class Bar a b > > > type family Quux a > > > > > > foo :: ( Foo a b > > > , b ~ Quux a ) > > > => a > > > -> Quux a > > > foo = undefined > > > > > > bar :: Bar a b > > > => a > > > -> b > > > bar = undefined > > > > > > -- Doesn't work > > > -- No instance for (Bar (Quux a0) c0) arising from a use of ‘bar’ > > > -- No instance for (Foo a0 (Quux a0)) arising from a use of ‘foo’ > > > --baz = bar . foo > > > > > > baz' :: ( Foo a (Quux a) > > > , Bar (Quux a) b ) > > > => a > > > -> b > > > baz' = bar . foo > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From gershomb at gmail.com Fri Feb 23 00:53:19 2018 From: gershomb at gmail.com (Gershom B) Date: Thu, 22 Feb 2018 19:53:19 -0500 Subject: [Haskell-cafe] [Haskell] ANN: Hackage Account Registration Changes In-Reply-To: References: <20180222232719.GA83277@nutty.outback.escape.de> Message-ID: (Replying just on -cafe. The other cc's shouldn't be included in the follow-on discussion to this announcement). A PR to augment links with nofollow tags would be welcome. Note that for completeness this would have to be done in the markdown engine, the package-description rendering engine, _and_ the haddock generation, which are three distinct codepaths. That said, I think that does not suffice, as I do not think the intent of the spam is _just_ to perform search engine optimization. And further, I have seen other cases as well where people are undeterred by SEO-prevention measures. For example, we require manual approval of wiki.haskell.org accounts despite the addition of nofollow tags, as those did not deter spammers in that case. The current policy is not a "direction" we are taking -- it is an interim measure until a better fix can be put in place. There is some discussion of what a "better fix" might look like on an issue on hackage-server: https://github.com/haskell/hackage-server/issues/685 -g On Thu, Feb 22, 2018 at 7:26 PM, Geoffrey Huntley wrote: > I feel that this is the wrong direction to take and will add more burden on > people that we shouldn't be adding additional burden to. It's also the wrong > "optics". > > I just had a quick squizz at Hackage with a simple PR you'll be able to > remove the incentives for this behaviour. > > Add "nofollow" to any links supplied by the user or that are rendered as > part of parsing user input. > > https://support.google.com/webmasters/answer/96569?hl=en > > The .NET ecosystem recently went through these same notions for the same > reasons - here's the PR > > https://github.com/NuGet/NuGetGallery/pull/4841/files > > On Fri., 23 Feb. 2018, 10:38 am Matthias Kilian, > wrote: >> >> Hi, >> >> On Thu, Feb 22, 2018 at 05:54:33PM -0500, Gershom B wrote: >> > In the meantime, as a short term measure, we have changed new account >> > registration policies on hackage. >> > >> > Users can still register as before, but new users do _not_ have upload >> > rights until they explicitly request them and are granted them by a >> > human being. >> > >> > (This is actually how we had configured hackage to work on initial >> > deployment -- we loosened things up for some years as the extra step >> > seemed unnecessary). >> >> Does this mean that before the todays change, anyone (or anything) >> could register and upload packages without any review and without >> any acknowledgement for trustfulness by another person? Does it >> maen that one can't trust *any* package on hackage.haskell.org at >> least a little bit (based on trust between acknowledging persons >> and reputation) without reviewing the package's source code? >> >> Ciao, >> Kili >> _______________________________________________ >> Haskell mailing list >> Haskell at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell From brucker at spamfence.net Fri Feb 23 14:05:58 2018 From: brucker at spamfence.net (Achim D. Brucker) Date: Fri, 23 Feb 2018 14:05:58 +0000 Subject: [Haskell-cafe] ThEdu'18: Call for Extended Abstracts & Demonstrations Message-ID: <20180223140558.n4wuguhrl34ywvbh@kandagawa.home.brucker.ch> (Apologies for duplicates) Call for Extended Abstracts & Demonstrations ************************************************************************** ThEdu'18 Theorem proving components for Educational software 18 July 2018 http://www.uc.pt/en/congressos/thedu/thedu18 ************************************************************************** at FLoC 2018 Federated Logic Conference 2018 6-19 July 2018 Oxford, UK http://www.floc2018.org/ ************************************************************************** THedu'18 Scope: Computer Theorem Proving is becoming a paradigm as well as a technological base for a new generation of educational software in science, technology, engineering and mathematics. The workshop brings together experts in automated deduction with experts in education in order to further clarify the shape of the new software generation and to discuss existing systems. Invited Talk Julien Narboux, University of Strasbourg, France Important Dates * Extended Abstracts: 15th April 2018 * Author Notification: 15th May 2018 * Workshop Day: 18 July 2018 Topics of interest include: * methods of automated deduction applied to checking students' input; * methods of automated deduction applied to prove post-conditions for particular problem solutions; * combinations of deduction and computation enabling systems to propose next steps; * automated provers specific for dynamic geometry systems; * proof and proving in mathematics education. Submission We welcome submission of extended abstracts and demonstration proposals presenting original unpublished work which is not been submitted for publication elsewhere. All accepted extended abstracts and demonstrations will be presented at the workshop. The extended abstracts will be made available online. Extended abstracts and demonstration proposals should be submitted via easychair, https://easychair.org/conferences/?conf=thedu18 formatted according to http://www.easychair.org/publications/easychair.zip Extended abstracts and demonstration proposals should be approximately 5 pages in length and are to be submitted in PDF format. At least one author of each accepted extended abstract/demonstration proposal is expected to attend THedu'18 and presents his/her extended abstract/demonstration. Program Committee Francisco Botana, University of Vigo at Pontevedra, Spain Roman Hašek, University of South Bohemia, Czech Republic Filip Maric, University of Belgrade, Serbia Walther Neuper, Graz University of Technology, Austria (co-chair) Pavel Pech, University of South Bohemia, Czech Republic Pedro Quaresma, University of Coimbra, Portugal (co-chair) Vanda Santos, CISUC, Portugal Wolfgang Schreiner, Johannes Kepler University, Austria Burkhart Wolff, University Paris-Sud, France Proceedings The extended abstracts and system descriptions will be available in ThEdu'18 Web-page. After presentation at the conference, selected authors will be invited to submit a substantially revised version, extended to 14--20 pages, for publication by the Electronic Proceedings in Theoretical Computer Science (EPTCS). -- Dr. Achim D. Brucker | Software Assurance & Security | University of Sheffield https://www.brucker.ch | https://logicalhacking.com/blog @adbrucker | @logicalhacking From mail at nh2.me Fri Feb 23 14:42:11 2018 From: mail at nh2.me (=?UTF-8?Q?Niklas_Hamb=c3=bcchen?=) Date: Fri, 23 Feb 2018 15:42:11 +0100 Subject: [Haskell-cafe] [Haskell] ANN: Hackage Account Registration Changes In-Reply-To: <20180222232719.GA83277@nutty.outback.escape.de> References: <20180222232719.GA83277@nutty.outback.escape.de> Message-ID: <0c2670e2-1c6c-cd25-38bc-35887a84d4ba@nh2.me> On 23/02/2018 00.27, Matthias Kilian wrote: > Does it > maen that one can't trust *any* package on hackage.haskell.org at > least a little bit (based on trust between acknowledging persons > and reputation) without reviewing the package's source code? Yes, in fact you cannot trust any random code you download from the Internet, Hackage is no exception. Anybody could register and upload a package that runs some `runIO` TemplateHaskell which deletes your entire home directory upon compilation, no matter if they are verified as a human or not. Other programming languages' ecosystems don't solve this problems either; if we want it solved, we should layer a trusted curated package repository on top where all code is reviewed by a set of trusted experts. From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Feb 23 15:55:32 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 23 Feb 2018 15:55:32 +0000 Subject: [Haskell-cafe] Occurs check: cannot construct the infinite type - but it doesn't need to Message-ID: <20180223155532.GA23818@weber> I have run into a similar problem to my last question which is not resolved with NoMonomorphismRestriction. 'foo2' has a partial type signature and I get an occurs check. 'foo3' is exactly the same except it has no signature, and it works! Why can't 'foo2' be inferred like 'foo3'? {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE NoMonomorphismRestriction #-} type family Quux a type family Corge a foo :: ( b ~ Quux a , a ~ Corge b ) => a -> b foo = undefined -- Occurs check: cannot construct the infinite type: -- t0 ~ Corge (Quux t0) -- arising from a use of ‘foo’ -- The type variable ‘t0’ is ambiguous -- foo2 :: _ foo2 = foo foo3 = foo From quentin.liu.0415 at gmail.com Fri Feb 23 15:59:51 2018 From: quentin.liu.0415 at gmail.com (Quentin Liu) Date: Fri, 23 Feb 2018 10:59:51 -0500 Subject: [Haskell-cafe] runGet exits prematurely Message-ID: <89cb0787-2a42-4e79-99fd-2c28000fc8dd@Spark> Hi, I am using Data.Binary to decode binary files and found that the `runGet` function would throw an exception “not enough bytes” even though it has not consumed all the input. Specifically, in the loop I am repeatedly trying to parse the binary file until it has consumed all the input  parsePPackets xs = do   empty <- isEmpty   if empty    then return xs    else do p <- parseB6034         parsePPackets (p:xs) When I try to run this function with `runGet`, the exception “Data.Binary.Get.runGet at position 3293603: not enough bytes” would be thrown, while the total length of input is 5864230, a number significantly larger. The function `parseB6034` consumes no more than 250 bytes in each round. In addition, the `parsePPackets` works well when fed with a small amount of data. Is it the problem of my code or an error with the package binary? The ByteString fed into `runGet` is lazy ByteString, as required by `runGet` function. Best Regards, Qingbo Liu -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Feb 23 16:12:31 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 23 Feb 2018 16:12:31 +0000 Subject: [Haskell-cafe] No instance - but it could just put one in the context In-Reply-To: <20180222232529.GC21187@weber> References: <20180222223959.GA21187@weber> <20180222231635.GB21187@weber> <20180222232529.GC21187@weber> Message-ID: <20180223161231.GB23818@weber> Oh, it does already seem to mention this, which is great! On Thu, Feb 22, 2018 at 11:25:29PM +0000, Tom Ellis wrote: > My next question is, could GHC suggest NoMonomorphismRestriction when it > comes across such code? > > (In the same way it suggests FlexibleContexts, etc.) > > On Thu, Feb 22, 2018 at 11:16:35PM +0000, Tom Ellis wrote: > > That's amazing! How many times have I been tripped up by that ... Thanks a > > lot, Adam. > > > > On Thu, Feb 22, 2018 at 11:11:18PM +0000, Adam Bergmark wrote: > > > This works if you enable NoMonomorphismRestriction. > > > > > > On Thu, 22 Feb 2018 at 23:41 Tom Ellis < > > > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > > > > > > > I'm puzzled by GHC's behaviour in the following program. > > > > > > > > 'baz = bar . foo' does not work because there is "no instance for ...". > > > > But > > > > if I manually assume those instances in the context all is fine. Why can > > > > GHC not infer that context? Is there any extension or clever trick I can > > > > use to get this to infer like I want? > > > > > > > > Thanks, > > > > > > > > Tom > > > > > > > > > > > > > > > > {-# LANGUAGE MultiParamTypeClasses #-} > > > > {-# LANGUAGE TypeFamilies #-} > > > > {-# LANGUAGE FlexibleContexts #-} > > > > > > > > class Foo a b > > > > class Bar a b > > > > type family Quux a > > > > > > > > foo :: ( Foo a b > > > > , b ~ Quux a ) > > > > => a > > > > -> Quux a > > > > foo = undefined > > > > > > > > bar :: Bar a b > > > > => a > > > > -> b > > > > bar = undefined > > > > > > > > -- Doesn't work > > > > -- No instance for (Bar (Quux a0) c0) arising from a use of ‘bar’ > > > > -- No instance for (Foo a0 (Quux a0)) arising from a use of ‘foo’ > > > > --baz = bar . foo > > > > > > > > baz' :: ( Foo a (Quux a) > > > > , Bar (Quux a) b ) > > > > => a > > > > -> b > > > > baz' = bar . foo > > _______________________________________________ > > Haskell-Cafe mailing list > > To (un)subscribe, modify options or view archives go to: > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From fr33domlover at riseup.net Sun Feb 25 07:47:35 2018 From: fr33domlover at riseup.net (fr33domlover) Date: Sun, 25 Feb 2018 09:47:35 +0200 Subject: [Haskell-cafe] HsOpenSSL doesn't build Message-ID: <20180225094735.6b5c340a@kaved> Hello Haskellers, For a long time I did my Haskell coding on a laptop running Trisquel 7 GNU/Linux, 64-bit. I had stack installed from FPComplete's debian repo, and GHC 7.10.3 installed from hvr's PPA. I was working, among other things, on a program that I built last time with LTS 6.5 and everything was okay. Then I moved to a new laptop, now I run Devuan Jessie (which is basically the same as Debian 8 Jessie), 64-bit, and I have stack installed using the script provided by the stack website, and GHC installed using `stack setup`. I'm trying to build the very same program, and I get this: Configuring HsOpenSSL-0.11.1.1... Cabal-simple_mPHDZzAJ_2.0.1.1_ghc-7.10.3: Missing dependencies on foreign libraries: * Missing C libraries: crypto, ssl This problem can usually be solved by installing the system packages that provide these libraries (you may need the "-dev" versions). If the libraries are already installed but in a non-standard location then you can use the flags --extra-include-dirs= and --extra-lib-dirs= to specify where they are. I thought maybe my OpenSSL version is too old. That's a bit weird because it seems to be more recent than the Trisquel one (well, basically same version, just some micro version being a bit higher), but still, I decided to try a few things: - I installed OpenSSL 1.1 using Guix and used the flags mentioned above to point to Guix's include and dir paths - I downloaded OpenSSL 1.1 release tarball, built from source, installed, pointed stack to that location - In those extra dirs I listed all the system ones like /lib and /usr/lib just in case - I updated stack to the latest release, and did stack setup --upgrade-cabal and installed alex and happy because stack complained no package was providing them - I deleted .stack-work and ~/.stack and did a totally clean build But nothing works, I'm still getting this error. On the older laptop everything works. How do I go about solving this? I don't know what else to try or how to make `stack build` look in the paths I provide and see the OpenSSL library there and use it. Thanks in advance for any clues!!! -- fr33 From fr33domlover at riseup.net Sun Feb 25 08:49:10 2018 From: fr33domlover at riseup.net (fr33domlover) Date: Sun, 25 Feb 2018 10:49:10 +0200 Subject: [Haskell-cafe] HsOpenSSL doesn't build In-Reply-To: <20180225094735.6b5c340a@kaved> References: <20180225094735.6b5c340a@kaved> Message-ID: <20180225104910.5807d975@kaved> Oh and I do have `libssl-dev` installed from distro package. On Sun, 25 Feb 2018 09:47:35 +0200 fr33domlover wrote: > Hello Haskellers, > > > For a long time I did my Haskell coding on a laptop running Trisquel 7 > GNU/Linux, 64-bit. I had stack installed from FPComplete's debian > repo, and GHC 7.10.3 installed from hvr's PPA. I was working, among > other things, on a program that I built last time with LTS 6.5 and > everything was okay. > > Then I moved to a new laptop, now I run Devuan Jessie (which is > basically the same as Debian 8 Jessie), 64-bit, and I have stack > installed using the script provided by the stack website, and GHC > installed using `stack setup`. I'm trying to build the very same > program, and I get this: > > Configuring HsOpenSSL-0.11.1.1... > Cabal-simple_mPHDZzAJ_2.0.1.1_ghc-7.10.3: Missing dependencies on > foreign libraries: > * Missing C libraries: crypto, ssl > This problem can usually be solved by installing the system > packages that provide these libraries (you may need the "-dev" > versions). If the libraries are already installed but in a > non-standard location then you can use the flags > --extra-include-dirs= and --extra-lib-dirs= to specify where they > are. > > I thought maybe my OpenSSL version is too old. That's a bit weird > because it seems to be more recent than the Trisquel one (well, > basically same version, just some micro version being a bit higher), > but still, I decided to try a few things: > > - I installed OpenSSL 1.1 using Guix and used the flags mentioned > above to point to Guix's include and dir paths > - I downloaded OpenSSL 1.1 release tarball, built from source, > installed, pointed stack to that location > - In those extra dirs I listed all the system ones like /lib > and /usr/lib just in case > - I updated stack to the latest release, and did stack setup > --upgrade-cabal and installed alex and happy because stack > complained no package was providing them > - I deleted .stack-work and ~/.stack and did a totally clean build > > But nothing works, I'm still getting this error. On the older laptop > everything works. > > How do I go about solving this? I don't know what else to try or how > to make `stack build` look in the paths I provide and see the OpenSSL > library there and use it. > > Thanks in advance for any clues!!! > > -- > fr33 > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From ivan.miljenovic at gmail.com Sun Feb 25 08:58:52 2018 From: ivan.miljenovic at gmail.com (Ivan Lazar Miljenovic) Date: Sun, 25 Feb 2018 19:58:52 +1100 Subject: [Haskell-cafe] HsOpenSSL doesn't build In-Reply-To: <20180225104910.5807d975@kaved> References: <20180225094735.6b5c340a@kaved> <20180225104910.5807d975@kaved> Message-ID: On 25 February 2018 at 19:49, fr33domlover wrote: > Oh and I do have `libssl-dev` installed from distro package. Do you have libcrypto-dev or something similar installed? > > > On Sun, 25 Feb 2018 09:47:35 +0200 > fr33domlover wrote: > >> Hello Haskellers, >> >> >> For a long time I did my Haskell coding on a laptop running Trisquel 7 >> GNU/Linux, 64-bit. I had stack installed from FPComplete's debian >> repo, and GHC 7.10.3 installed from hvr's PPA. I was working, among >> other things, on a program that I built last time with LTS 6.5 and >> everything was okay. >> >> Then I moved to a new laptop, now I run Devuan Jessie (which is >> basically the same as Debian 8 Jessie), 64-bit, and I have stack >> installed using the script provided by the stack website, and GHC >> installed using `stack setup`. I'm trying to build the very same >> program, and I get this: >> >> Configuring HsOpenSSL-0.11.1.1... >> Cabal-simple_mPHDZzAJ_2.0.1.1_ghc-7.10.3: Missing dependencies on >> foreign libraries: >> * Missing C libraries: crypto, ssl >> This problem can usually be solved by installing the system >> packages that provide these libraries (you may need the "-dev" >> versions). If the libraries are already installed but in a >> non-standard location then you can use the flags >> --extra-include-dirs= and --extra-lib-dirs= to specify where they >> are. >> >> I thought maybe my OpenSSL version is too old. That's a bit weird >> because it seems to be more recent than the Trisquel one (well, >> basically same version, just some micro version being a bit higher), >> but still, I decided to try a few things: >> >> - I installed OpenSSL 1.1 using Guix and used the flags mentioned >> above to point to Guix's include and dir paths >> - I downloaded OpenSSL 1.1 release tarball, built from source, >> installed, pointed stack to that location >> - In those extra dirs I listed all the system ones like /lib >> and /usr/lib just in case >> - I updated stack to the latest release, and did stack setup >> --upgrade-cabal and installed alex and happy because stack >> complained no package was providing them >> - I deleted .stack-work and ~/.stack and did a totally clean build >> >> But nothing works, I'm still getting this error. On the older laptop >> everything works. >> >> How do I go about solving this? I don't know what else to try or how >> to make `stack build` look in the paths I provide and see the OpenSSL >> library there and use it. >> >> Thanks in advance for any clues!!! >> >> -- >> fr33 >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -- Ivan Lazar Miljenovic Ivan.Miljenovic at gmail.com http://IvanMiljenovic.wordpress.com From falsandtru at gmail.com Sun Feb 25 09:11:36 2018 From: falsandtru at gmail.com (=?UTF-8?B?5aeT5ZCN?=) Date: Sun, 25 Feb 2018 18:11:36 +0900 Subject: [Haskell-cafe] How to control emitting other-modules with hpack Message-ID: Hi there, I don't want to refer some (test) files defined at other-modules section but hpack emits that automatically. How can I control that emitting from package.yaml? -------------- next part -------------- An HTML attachment was scrubbed... URL: From falsandtru at gmail.com Sun Feb 25 10:33:36 2018 From: falsandtru at gmail.com (=?UTF-8?B?5aeT5ZCN?=) Date: Sun, 25 Feb 2018 19:33:36 +0900 Subject: [Haskell-cafe] How to control emitting other-modules with hpack In-Reply-To: References: Message-ID: Resolved: https://github.com/sol/hpack/issues/188 2018-02-25 18:11 GMT+09:00 姓名 : > Hi there, > > I don't want to refer some (test) files defined at other-modules section > but hpack emits that automatically. How can I control that emitting from > package.yaml? > -------------- next part -------------- An HTML attachment was scrubbed... URL: From chneukirchen at gmail.com Sun Feb 25 12:16:14 2018 From: chneukirchen at gmail.com (Christian Neukirchen) Date: Sun, 25 Feb 2018 13:16:14 +0100 Subject: [Haskell-cafe] Munich Haskell Meeting, 2018-02-27 @ 19:30 Message-ID: <877er1qn75.fsf@gmail.com> Dear all, Next week, our monthly Munich Haskell Meeting will take place again on Tuesday, Feburary 27, this time at Schiller Bräu (Schillerstr. 23) at 19h30. For details see here: http://muenchen.haskell.bayern/dates.html If you plan to join, please add yourself to this dudle so we can reserve enough seats! It is OK to add yourself to the dudle anonymously or pseudonymously. https://dudle.inf.tu-dresden.de/haskell-munich-feb-2018/ Everybody is welcome! cu, -- Christian Neukirchen http://chneukirchen.org From zemyla at gmail.com Sun Feb 25 16:42:48 2018 From: zemyla at gmail.com (Zemyla) Date: Sun, 25 Feb 2018 10:42:48 -0600 Subject: [Haskell-cafe] Proposal: Add Eq1 and Ord1 instances in GHC.Generics, and synchronize with Data.Functor.* types In-Reply-To: <764de1a0-dd06-f1ca-24ca-b3c8554aa200@gmail.com> References: <764de1a0-dd06-f1ca-24ca-b3c8554aa200@gmail.com> Message-ID: I definitely agree with adding Eq1 and Ord1 instances. We probably should have Show1 and Read1 as well, since we have normal Show and Read instances, but it should say they can't be used for deriving like Eq1 and Ord1 can. On Sun, Feb 25, 2018 at 9:10 AM, Li-yao Xia wrote: > Eq1 and Ord1 are two more useful classes to implement in GHC.Generics, and > would be useful to derive Eq1 and Ord1 generically. Note that we can > currently use transformers-compat to derive these. > > Moreover, most of the GHC.Generics types are equivalent to types in the > Data.Functor.* modules. Would it be a good idea for them to have the same > instances? Concretely, the current differences are: > > - GHC.Generics is missing Eq1, Ord1, Show1, Read1 instances > - Data.Functor.* is missing Semigroup and Monoid instances (that my previous > proposal would add to GHC.Generics) > > Li-yao > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From ben at well-typed.com Sun Feb 25 17:42:15 2018 From: ben at well-typed.com (Ben Gamari) Date: Sun, 25 Feb 2018 12:42:15 -0500 Subject: [Haskell-cafe] [ANNOUNCE] GHC 8.4.1-rc1 available Message-ID: <87po4trmr3.fsf@smart-cactus.org> The GHC development team is pleased to announce the first (and likely final) release candidate of GHC 8.4.1. The usual release artifacts are available from https://downloads.haskell.org/~ghc/8.4.1-rc1 This release will likely be the last release before the final 8.4.1 release, which, if things go well, will be released one week from today. Due to user demand we now offer a binary distribution for 64-bit Fedora 27, which links against ncurses6. This is in contrast to the Debian 8 distribution, which links against ncurses5. Users of newer distributions (Fedora 27, Debian Sid) should use this new Fedora 27 distribution. Also due to user demand we have reintroduced compatibility with GCC 4.4, which earlier alphas had dropped due to #14244. Note that this release candidate is still affected by #14705, although this will certainly be resolved before the final release is made. === Notes on release scheduling === The 8.4.1 release marks the first release where GHC will be adhering to its new, higher-cadence release schedule [1]. Under this new scheme, major releases will be made in 6-month intervals with interstitial minor releases as necessary. In order to minimize the likelihood of schedule slippage and to ensure adequate testing, each major release will be preceded by a number of regular alpha releases. We will begin issuing these releases roughly three months before the final date of the major release and will issue roughly one every two weeks during this period. This high release cadence will allow us to quickly get fixes into users' hands and more quickly identify potential issues. As always, do let us know if you encounter any trouble in the course of testing. Thanks for your help! Cheers, - Ben [1] https://ghc.haskell.org/trac/ghc/blog/2017-release-schedule -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From ben at well-typed.com Sun Feb 25 19:57:58 2018 From: ben at well-typed.com (Ben Gamari) Date: Sun, 25 Feb 2018 14:57:58 -0500 Subject: [Haskell-cafe] [ANNOUNCE] GHC 8.4.1-rc1 available In-Reply-To: <87po4trmr3.fsf@smart-cactus.org> References: <87po4trmr3.fsf@smart-cactus.org> Message-ID: <87k1v0suyk.fsf@smart-cactus.org> Ben Gamari writes: > The GHC development team is pleased to announce the first (and likely > final) release candidate of GHC 8.4.1. The usual release artifacts are > available from > > https://downloads.haskell.org/~ghc/8.4.1-rc1 > > This release will likely be the last release before the final 8.4.1 > release, which, if things go well, will be released one week from today. > It has come to my attention that the fix for #14675 has broken `configure`'s `--disable-ld-override` flag. I have a fix [1] which will be applied to the final release. In the meantime, if you need to use this flag please define the `LD_NO_GOLD` environment variable to point to a non-gold linker when invoking `configure`. For instance, ./configure --disable-ld-override LD_NO_GOLD=ld.bfd Cheers, - Ben [1] https://phabricator.haskell.org/D4448 -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From lysxia at gmail.com Sun Feb 25 20:28:44 2018 From: lysxia at gmail.com (Li-yao Xia) Date: Sun, 25 Feb 2018 15:28:44 -0500 Subject: [Haskell-cafe] [ANN] show-combinators: a minimal pretty-printing library for Show instances Message-ID: Hello, Sometimes it is necessary to handwrite instances for Show, Show1, Show2, or some other simple pretty-printer for ADT-like structures (because they might not be easily derived via existing means). base has a few combinators in Prelude, Text.Show, and Data.Functor.Classes. But they require explicit handling of spacing and precedence levels, which is generally error-prone and repetitive, since ADTs all look the same. This new library, show-combinators, contains just a dozen of functions to encapsulate all of those details, so the code left to write can more closely match the structure of the type to show. http://hackage.haskell.org/package/show-combinators I hope you will also find it useful. Cheers, Li-yao From tab at snarc.org Mon Feb 26 15:02:07 2018 From: tab at snarc.org (Vincent Hanquez) Date: Mon, 26 Feb 2018 15:02:07 +0000 Subject: [Haskell-cafe] [ANNOUNCE] GHC 8.4.1-rc1 available In-Reply-To: <87po4trmr3.fsf@smart-cactus.org> References: <87po4trmr3.fsf@smart-cactus.org> Message-ID: <881c4581-eaae-009a-626b-024f29d0a010@snarc.org> On 25/02/18 17:42, Ben Gamari wrote: > The GHC development team is pleased to announce the first (and likely > final) release candidate of GHC 8.4.1. The usual release artifacts are > available from > > https://downloads.haskell.org/~ghc/8.4.1-rc1 > Hi Ben, Looks like both SHA1SUM and SHA256SUM are missing the fedora27 variant Cheers, Vincent From quentin.liu.0415 at gmail.com Mon Feb 26 15:17:33 2018 From: quentin.liu.0415 at gmail.com (Quentin Liu) Date: Mon, 26 Feb 2018 10:17:33 -0500 Subject: [Haskell-cafe] runGet exits prematurely In-Reply-To: References: <89cb0787-2a42-4e79-99fd-2c28000fc8dd@Spark> Message-ID: Thank you for the suggestion! I am still not sure about the correct way to communicate on mailing-list. But I have figured out the problem which is caused by arithmetic overflow. I was using Word8 to parse the packet length and presumed the packet length would be larger than 46. The subtraction of 47 from the Word8 packet length gave the largest number Word8 could represent, which definitely exceeds the length of the whole file. Regards, Qingbo Liu On Feb 26, 2018, 02:41 -0500, Robin Palotai , wrote: > [-list] > > FYI Given the lack of responses, I think more context would help. For example github / gist link to code, minimal case to reproduce. > > > 2018-02-23 16:59 GMT+01:00 Quentin Liu : > > > Hi, > > > > > > I am using Data.Binary to decode binary files and found that the `runGet` function would throw an exception “not enough bytes” even though it has not consumed all the input. > > > > > > Specifically, in the loop I am repeatedly trying to parse the binary file until it has consumed all the input > > > > > >  parsePPackets xs = do > > >   empty <- isEmpty > > >   if empty > > >    then return xs > > >    else do p <- parseB6034 > > >         parsePPackets (p:xs) > > > > > > When I try to run this function with `runGet`, the exception “Data.Binary.Get.runGet at position 3293603: not enough bytes” would be thrown, while the total length of input is 5864230, a number significantly larger. The function `parseB6034` consumes no more than 250 bytes in each round. In addition, the `parsePPackets` works well when fed with a small amount of data. > > > > > > Is it the problem of my code or an error with the package binary? The ByteString fed into `runGet` is lazy ByteString, as required by `runGet` function. > > > > > > Best Regards, > > > Qingbo Liu > > > > > > _______________________________________________ > > > Haskell-Cafe mailing list > > > To (un)subscribe, modify options or view archives go to: > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeroen at chordify.net Mon Feb 26 15:53:45 2018 From: jeroen at chordify.net (Jeroen Bransen) Date: Mon, 26 Feb 2018 16:53:45 +0100 Subject: [Haskell-cafe] Partial instance of a class Message-ID: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> Hi Haskell cafe, Is there any standard or guideline for making a "partial" instance of a class, by which I mean implementing some methods of a class, but not all of them? In my concrete case I've got some type X which is almost an Arrow, except that I cannot lift any function a -> b to my type (of course I can for some a and b), so I cannot give a sensible implementation for arr. I can however give sensible implementations for the other methods in the Arrow class, and I'd like to use them (and possibly derived combinators) in other places. I see three possible solutions for this situation, I think I've seen at least the first two being used in well-known packages, but I couldn't find them anymore: 1. Make a class instance, and for the methods you don't implement put an 'error' call 2. Create functions with names from the class and with types specialised to your type, so that you can use it as if the instance was there. I.e. provide a function first :: X a b -> X (a, c) (b, c), which should be imported qualified to avoid name conflicts with the real Arrow class. The drawback of this is of course the conflicting names, but also the fact that derived combinators cannot be used. 3. Create functions with different names, to also avoid name clashes, i.e. firstX :: X a b -> X (a, c) (b, c). My preference would be to pick 1., but it feels quite bad in the same time. Any suggestions? Jeroen From ben at well-typed.com Mon Feb 26 16:01:59 2018 From: ben at well-typed.com (Ben Gamari) Date: Mon, 26 Feb 2018 11:01:59 -0500 Subject: [Haskell-cafe] [ANNOUNCE] GHC 8.4.1-rc1 available In-Reply-To: <881c4581-eaae-009a-626b-024f29d0a010@snarc.org> References: <87po4trmr3.fsf@smart-cactus.org> <881c4581-eaae-009a-626b-024f29d0a010@snarc.org> Message-ID: <87a7vvspsc.fsf@smart-cactus.org> Vincent Hanquez writes: > On 25/02/18 17:42, Ben Gamari wrote: >> The GHC development team is pleased to announce the first (and likely >> final) release candidate of GHC 8.4.1. The usual release artifacts are >> available from >> >> https://downloads.haskell.org/~ghc/8.4.1-rc1 >> > Hi Ben, > > Looks like both SHA1SUM and SHA256SUM are missing the fedora27 variant > Good catch; it looks like I neglected to regenerate them after fixing the name of the the Fedora vairant. Fixed. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From monkleyon at gmail.com Mon Feb 26 17:36:27 2018 From: monkleyon at gmail.com (MarLinn) Date: Mon, 26 Feb 2018 18:36:27 +0100 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> Message-ID: Hi, > Is there any standard or guideline for making a "partial" instance of > a class, by which I mean implementing some methods of a class, but not > all of them? In my concrete case I've got some type X which is almost > an Arrow, except that I cannot lift any function a -> b to my type (of > course I can for some a and b), so I cannot give a sensible > implementation for arr. I can however give sensible implementations > for the other methods in the Arrow class, and I'd like to use them > (and possibly derived combinators) in other places. this might not be the general answer you're looking for, but related to this special case: Note that arrow syntax (both proc-do-notation and banana brackets) uses arr extensively under the hood. The same goes for many of the derived combinators. So you can not simply leave it out. But maybe there's no need to reinvent the wheel either. What you have probably is something like a /profunctor/ or a /braided category/, so you might be in luck finding some better suited library instead. For the former, probably the /profunctors/ library. For the latter, maybe the /subhask/ prelude, but more likely the /categories/ library. If nothing else looking at them might help you better understand what structure you're dealing with. I personally don't use subhask, but the hierarchy diagrams and code snippets alone have been enlightening in the past. They might give you new search terms on the hunt for a better library. Or maybe it's enough to make it an /Applicative/? As a sidenote, I've seen this exact problem mentioned several times. Many nice things are almost arrows without an arr. But the arrow machinery pre-dates our current hierarchies and understanding, and it's never really been revised. From a more modern point of view there's little reason for its prominent place in base, except as an honorary member. There has also been discussion if/how the notation might be generalized. But it seems the pain was never strong enough, no one knows of a golden way forward, and there's always been ways around this. Oh well. Cheers, MarLinn -------------- next part -------------- An HTML attachment was scrubbed... URL: From oskar.wickstrom at gmail.com Mon Feb 26 20:18:02 2018 From: oskar.wickstrom at gmail.com (=?UTF-8?Q?Oskar_Wickstr=C3=B6m?=) Date: Mon, 26 Feb 2018 21:18:02 +0100 Subject: [Haskell-cafe] Haskell at Work screencasts Message-ID: Hi fellow Haskellers! I just wanted to announce a project of mine that might be of interest. Since the beginning of this year I've been producing freely available Haskell screencasts, named "Haskell at Work". They focus on practical industry use of Haskell, and are primarily geared towards rookie and intermediate Haskellers. You'll find the videos, including show notes, here: https://haskell-at-work.com/ If you like my videos and think more people should see them, please help me spread the word! There's also a Patreon page where you or others can help out by donating: https://www.patreon.com/haskellatwork So far I've had a great time making screencasts, even if it's a lot of work. The warm feedback and many viewers is highly motivating! Best, Oskar -------------- next part -------------- An HTML attachment was scrubbed... URL: From rick at owensmurray.com Mon Feb 26 20:58:59 2018 From: rick at owensmurray.com (Rick Owens) Date: Mon, 26 Feb 2018 14:58:59 -0600 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> Message-ID: I would also like to register interest in what the community thinks about this problem, and add a couple of more motivating examples that I face regularly in my work: 1) `Bounded`, for things that have a minBound but no maxBound (like String). I often resort to Default in this case to avoid the use of `error`, but am unhappy with this because it doesn't "mean" the same thing, nor can it use derived combinators, as Jeroen mentions. 2) `Enum`, when used with types with more than 2^64 values (i.e. a sha-256 derived "keyspace", with 2^256 values). The `fromEnum` documentation claims "It is implementation-dependent what fromEnum returns when applied to a value that is too large to fit in an Int", but since approximately zero percent of 2^256 values will fit in an Int, I typically resort to `error` for all cases just to make it clear that toEnum/fromEnum are not going to work for any meaningful fraction of possible values. Thanks! -Rick On Mon, Feb 26, 2018 at 11:36 AM, MarLinn wrote: > Hi, > > Is there any standard or guideline for making a "partial" instance of a > class, by which I mean implementing some methods of a class, but not all of > them? In my concrete case I've got some type X which is almost an Arrow, > except that I cannot lift any function a -> b to my type (of course I can > for some a and b), so I cannot give a sensible implementation for arr. I > can however give sensible implementations for the other methods in the > Arrow class, and I'd like to use them (and possibly derived combinators) in > other places. > > > this might not be the general answer you're looking for, but related to > this special case: > > Note that arrow syntax (both proc-do-notation and banana brackets) uses > arr extensively under the hood. The same goes for many of the derived > combinators. So you can not simply leave it out. But maybe there's no need > to reinvent the wheel either. What you have probably is something like a > *profunctor* or a *braided category*, so you might be in luck finding > some better suited library instead. For the former, probably the > *profunctors* library. > For the latter, maybe the *subhask* > prelude, but more likely the > *categories* library. If > nothing else looking at them might help you better understand what > structure you're dealing with. I personally don't use subhask, but the > hierarchy diagrams and code snippets alone have been enlightening in the > past. They might give you new search terms on the hunt for a better library. > > Or maybe it's enough to make it an *Applicative*? > > As a sidenote, I've seen this exact problem mentioned several times. Many > nice things are almost arrows without an arr. But the arrow machinery > pre-dates our current hierarchies and understanding, and it's never really > been revised. From a more modern point of view there's little reason for > its prominent place in base, except as an honorary member. There has also > been discussion if/how the notation might be generalized. But it seems the > pain was never strong enough, no one knows of a golden way forward, and > there's always been ways around this. Oh well. > > Cheers, > MarLinn > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From will.yager at gmail.com Mon Feb 26 21:11:26 2018 From: will.yager at gmail.com (Will Yager) Date: Mon, 26 Feb 2018 16:11:26 -0500 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> Message-ID: <860EE9A6-4C4E-417B-BE63-9DC8DD60BA94@gmail.com> To avoid the hellish nightmare of Java’s UnsupportedOperationException-riddled ecosystem, I think we should *very strongly* discourage partial implementations of typeclasses as much as humanly possible. If a type doesn’t fit the typeclass, please don’t pretend it does. If it turns out that our typeclasses are divided along bad semantic boundaries (which they clearly are in some cases), we should fix that instead of turning the typeclass landscape into a minefield. —Will From clintonmead at gmail.com Mon Feb 26 21:20:45 2018 From: clintonmead at gmail.com (Clinton Mead) Date: Mon, 26 Feb 2018 21:20:45 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <860EE9A6-4C4E-417B-BE63-9DC8DD60BA94@gmail.com> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <860EE9A6-4C4E-417B-BE63-9DC8DD60BA94@gmail.com> Message-ID: I’ve implemented a drop in replacement enum class here, which solves your issue among other things: https://hackage.haskell.org/package/generic-enum If it doesn’t have some of the instances you require feel free to send me a pull request. On Tue, 27 Feb 2018 at 8:12 am, Will Yager wrote: > To avoid the hellish nightmare of Java’s > UnsupportedOperationException-riddled ecosystem, I think we should *very > strongly* discourage partial implementations of typeclasses as much as > humanly possible. If a type doesn’t fit the typeclass, please don’t pretend > it does. > > If it turns out that our typeclasses are divided along bad semantic > boundaries (which they clearly are in some cases), we should fix that > instead of turning the typeclass landscape into a minefield. > > —Will > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From pumpkingod at gmail.com Tue Feb 27 03:49:13 2018 From: pumpkingod at gmail.com (Daniel Peebles) Date: Mon, 26 Feb 2018 22:49:13 -0500 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <860EE9A6-4C4E-417B-BE63-9DC8DD60BA94@gmail.com> Message-ID: Also possibly interesting and relevant is Adam Megacz's fascinating (but sadly abandoned) work on generalized arrows and hetmet programming: http://www.megacz.com/berkeley/garrows/ On Mon, Feb 26, 2018 at 4:20 PM, Clinton Mead wrote: > I’ve implemented a drop in replacement enum class here, which solves your > issue among other things: > > https://hackage.haskell.org/package/generic-enum > > If it doesn’t have some of the instances you require feel free to send me > a pull request. > > On Tue, 27 Feb 2018 at 8:12 am, Will Yager wrote: > >> To avoid the hellish nightmare of Java’s UnsupportedOperationException-riddled >> ecosystem, I think we should *very strongly* discourage partial >> implementations of typeclasses as much as humanly possible. If a type >> doesn’t fit the typeclass, please don’t pretend it does. >> >> If it turns out that our typeclasses are divided along bad semantic >> boundaries (which they clearly are in some cases), we should fix that >> instead of turning the typeclass landscape into a minefield. >> >> —Will >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From clintonmead at gmail.com Tue Feb 27 04:07:21 2018 From: clintonmead at gmail.com (Clinton Mead) Date: Tue, 27 Feb 2018 04:07:21 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <860EE9A6-4C4E-417B-BE63-9DC8DD60BA94@gmail.com> Message-ID: Also check out my Freelude package which allows for the definition of restricted arrows like you’ve mentioned: https://hackage.haskell.org/package/freelude On Tue, 27 Feb 2018 at 2:49 pm, Daniel Peebles wrote: > Also possibly interesting and relevant is Adam Megacz's fascinating (but > sadly abandoned) work on generalized arrows and hetmet programming: > http://www.megacz.com/berkeley/garrows/ > > On Mon, Feb 26, 2018 at 4:20 PM, Clinton Mead > wrote: > >> I’ve implemented a drop in replacement enum class here, which solves your >> issue among other things: >> >> https://hackage.haskell.org/package/generic-enum >> >> If it doesn’t have some of the instances you require feel free to send me >> a pull request. >> >> On Tue, 27 Feb 2018 at 8:12 am, Will Yager wrote: >> >>> To avoid the hellish nightmare of Java’s >>> UnsupportedOperationException-riddled ecosystem, I think we should *very >>> strongly* discourage partial implementations of typeclasses as much as >>> humanly possible. If a type doesn’t fit the typeclass, please don’t pretend >>> it does. >>> >>> If it turns out that our typeclasses are divided along bad semantic >>> boundaries (which they clearly are in some cases), we should fix that >>> instead of turning the typeclass landscape into a minefield. >>> >>> —Will >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeroen at chordify.net Tue Feb 27 10:38:21 2018 From: jeroen at chordify.net (Jeroen Bransen) Date: Tue, 27 Feb 2018 11:38:21 +0100 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> Message-ID: <8d7913d6-bb7a-12d7-8bc7-ecf3b3296ab9@chordify.net> > Hi, > >> Is there any standard or guideline for making a "partial" instance of >> a class, by which I mean implementing some methods of a class, but >> not all of them? In my concrete case I've got some type X which is >> almost an Arrow, except that I cannot lift any function a -> b to my >> type (of course I can for some a and b), so I cannot give a sensible >> implementation for arr. I can however give sensible implementations >> for the other methods in the Arrow class, and I'd like to use them >> (and possibly derived combinators) in other places. > > this might not be the general answer you're looking for, but related > to this special case: > > Note that arrow syntax (both proc-do-notation and banana brackets) > uses arr extensively under the hood. The same goes for many of the > derived combinators. So you can not simply leave it out. But maybe > there's no need to reinvent the wheel either. What you have probably > is something like a /profunctor/ or a /braided category/, so you might > be in luck finding some better suited library instead. For the former, > probably the /profunctors/ > library. For the > latter, maybe the /subhask/ > prelude, but more likely the /categories/ > library. If nothing > else looking at them might help you better understand what structure > you're dealing with. I personally don't use subhask, but the hierarchy > diagrams and code snippets alone have been enlightening in the past. > They might give you new search terms on the hunt for a better library. > Perfect. In my concrete case I think a profunctor is indeed the thing I was looking for, and based on the other replies it seems that in general there are usually other classes that do match the set of functions you'd like. This of course doesn't completely solve the problem of the desire to use certain combinators, but I do agree that using error to partially implement a class isn't satisfactory either, and is very likely to lead to more problems. Jeroen -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 27 10:52:32 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 27 Feb 2018 10:52:32 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> Message-ID: <20180227105232.GH27273@weber> On Mon, Feb 26, 2018 at 06:36:27PM +0100, MarLinn wrote: > >I've got some type X which is almost an Arrow, except that I cannot lift > >any function a -> b to my type (of course I can for some a and b), so I > >cannot give a sensible implementation for arr. I can however give > >sensible implementations for the other methods in the Arrow class, and > >I'd like to use them (and possibly derived combinators) in other places. > [...] > ... I've seen this exact problem mentioned several times. > Many nice things are almost arrows without an arr. But the arrow > machinery pre-dates our current hierarchies and understanding, and > it's never really been revised. There's a myth floating around that "Arrow is much less useful because it forces you to implement arr". In fact, Arrow without arr would be as useless as Applicative without fmap. In almost all situations where you are stymied by arr a small redesign will solve the whole problem. In fact, you need to get into the realm of linear-types-like things before arr is too much (and even then a *linear* arr would be fine). I designed a library for constructing Postgres queries and it uses an Arrow interface. https://hackage.haskell.org/package/opaleye-0.5.3.0/docs/Opaleye-Internal-QueryArr.html Naturally there is no way to run an arbitrary Haskell function "in the database". This is not an impediment because everything that the database acts on inside the arrow type (QueryArr) is wrapped in an abstract type (Column). This means the only way that arbitrary Haskell functions can be used inside the arrow is as a sort of "partial compilation". There is, in effect, a staging restriction. Haskell functions a -> b run at "query compile time" and Postgres functions run at "query run time". This observation was made in an ICFP '13 paper in the context of our beloved monads so nothing that I'm saying here is particular to those inscrutable arrows. http://www.cse.chalmers.se/~joels/writing/bb.pdf I would be sad to think that Haskell programmers are avoiding using Arrow because of this myth[1]. If Jeroen Bransen or anyone else would like more details about this approach please get in touch either via this list or personally. I'm happy to help out. Tom [1] On the other hand, avoiding using Arrow because the type in question is actually a Monad is a perfectly good reason. From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 27 10:55:48 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 27 Feb 2018 10:55:48 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <8d7913d6-bb7a-12d7-8bc7-ecf3b3296ab9@chordify.net> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <8d7913d6-bb7a-12d7-8bc7-ecf3b3296ab9@chordify.net> Message-ID: <20180227105548.GI27273@weber> On Tue, Feb 27, 2018 at 11:38:21AM +0100, Jeroen Bransen wrote: > In my concrete case I think a profunctor is indeed the thing I was looking > for If you're willing to share your datatype I may be able to help determine exactly what sort of thing it is. I have extensively explored the place of profunctors :) From jeroen at chordify.net Tue Feb 27 11:02:49 2018 From: jeroen at chordify.net (Jeroen Bransen) Date: Tue, 27 Feb 2018 12:02:49 +0100 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <20180227105548.GI27273@weber> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <8d7913d6-bb7a-12d7-8bc7-ecf3b3296ab9@chordify.net> <20180227105548.GI27273@weber> Message-ID: <054fe015-77a4-8d90-ea73-2d33b0366e10@chordify.net> >> In my concrete case I think a profunctor is indeed the thing I was looking >> for > If you're willing to share your datatype I may be able to help determine > exactly what sort of thing it is. I have extensively explored the place of > profunctors :) http://hackage.haskell.org/package/progress-reporting-1.1.0/docs/Control-Monad-Progress.html It's a class of functions (that may run in some monadic context) for which we can report progress. I can lift certain types of functions to this space (those that construct items of a list, or those that report their own progress in some way), and then these compose in several ways. Obviously having the first and second combinators from arrows comes in handy. From allbery.b at gmail.com Tue Feb 27 11:08:06 2018 From: allbery.b at gmail.com (Brandon Allbery) Date: Tue, 27 Feb 2018 06:08:06 -0500 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <20180227105232.GH27273@weber> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <20180227105232.GH27273@weber> Message-ID: I was under the impression most programmers avoid Arrows because they've seen HXT. >.> Which really wants to be Applicative, not Arrow, so it's not the best example of Arrows out there. On Tue, Feb 27, 2018 at 5:52 AM, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Mon, Feb 26, 2018 at 06:36:27PM +0100, MarLinn wrote: > > >I've got some type X which is almost an Arrow, except that I cannot lift > > >any function a -> b to my type (of course I can for some a and b), so I > > >cannot give a sensible implementation for arr. I can however give > > >sensible implementations for the other methods in the Arrow class, and > > >I'd like to use them (and possibly derived combinators) in other places. > > > [...] > > ... I've seen this exact problem mentioned several times. > > Many nice things are almost arrows without an arr. But the arrow > > machinery pre-dates our current hierarchies and understanding, and > > it's never really been revised. > > There's a myth floating around that "Arrow is much less useful because it > forces you to implement arr". In fact, Arrow without arr would be as > useless as Applicative without fmap. In almost all situations where you > are > stymied by arr a small redesign will solve the whole problem. In fact, you > need to get into the realm of linear-types-like things before arr is too > much (and even then a *linear* arr would be fine). > > I designed a library for constructing Postgres queries and it uses an Arrow > interface. > > https://hackage.haskell.org/package/opaleye-0.5.3.0/docs/ > Opaleye-Internal-QueryArr.html > > Naturally there is no way to run an arbitrary Haskell function "in the > database". This is not an impediment because everything that the database > acts on inside the arrow type (QueryArr) is wrapped in an abstract type > (Column). This means the only way that arbitrary Haskell functions can be > used inside the arrow is as a sort of "partial compilation". There is, in > effect, a staging restriction. Haskell functions a -> b run at "query > compile time" and Postgres functions run at "query run time". > > This observation was made in an ICFP '13 paper in the context of our > beloved > monads so nothing that I'm saying here is particular to those inscrutable > arrows. > > http://www.cse.chalmers.se/~joels/writing/bb.pdf > > I would be sad to think that Haskell programmers are avoiding using Arrow > because of this myth[1]. If Jeroen Bransen or anyone else would like more > details about this approach please get in touch either via this list or > personally. I'm happy to help out. > > Tom > > > > [1] On the other hand, avoiding using Arrow because the type in question is > actually a Monad is a perfectly good reason. > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 27 11:21:51 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 27 Feb 2018 11:21:51 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <054fe015-77a4-8d90-ea73-2d33b0366e10@chordify.net> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <8d7913d6-bb7a-12d7-8bc7-ecf3b3296ab9@chordify.net> <20180227105548.GI27273@weber> <054fe015-77a4-8d90-ea73-2d33b0366e10@chordify.net> Message-ID: <20180227112151.GJ27273@weber> On Tue, Feb 27, 2018 at 12:02:49PM +0100, Jeroen Bransen wrote: > >>In my concrete case I think a profunctor is indeed the thing I was looking > >>for > >If you're willing to share your datatype I may be able to help determine > >exactly what sort of thing it is. I have extensively explored the place of > >profunctors :) > http://hackage.haskell.org/package/progress-reporting-1.1.0/docs/Control-Monad-Progress.html > > It's a class of functions (that may run in some monadic context) for > which we can report progress. I can lift certain types of functions > to this space (those that construct items of a list, or those that > report their own progress in some way), and then these compose in > several ways. Obviously having the first and second combinators from > arrows comes in handy. The type in question is WithProgress data WithProgress m a b where Id :: WithProgress m a a WithProgressM :: ((Double -> m ()) -> a -> m b) -> WithProgress m a b Combine :: WithProgress m b c -> WithProgress m a b -> WithProgress m a c SetWeight :: Double -> WithProgress m a b -> WithProgress m a b Is this definition of arr somehow unsatisfactory? arr :: Applicative m => (a -> b) -> WithProgress m a b arr f = WithProgressM (\_ a -> pure (f a)) NB that if you implement Category and Profunctor then you automatically get arr (\f -> lmap f id). Tom From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 27 11:27:27 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 27 Feb 2018 11:27:27 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <20180227112151.GJ27273@weber> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <8d7913d6-bb7a-12d7-8bc7-ecf3b3296ab9@chordify.net> <20180227105548.GI27273@weber> <054fe015-77a4-8d90-ea73-2d33b0366e10@chordify.net> <20180227112151.GJ27273@weber> Message-ID: <20180227112727.GK27273@weber> On Tue, Feb 27, 2018 at 11:21:51AM +0000, Tom Ellis wrote: > NB that if you implement Category and Profunctor then you automatically get > arr (\f -> lmap f id). Or perhaps put more simply, you have no hope of making something an Arrow if you can't make it a Functor, but if you *do* have Functor and Category then you automatically get arr f = fmap f id Tom From monkleyon at gmail.com Tue Feb 27 13:28:31 2018 From: monkleyon at gmail.com (MarLinn) Date: Tue, 27 Feb 2018 14:28:31 +0100 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <20180227105232.GH27273@weber> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <20180227105232.GH27273@weber> Message-ID: <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> Hi, > There's a myth floating around that "Arrow is much less useful because it > forces you to implement arr". In fact, Arrow without arr would be as > useless as Applicative without fmap. In almost all situations where you are > stymied by arr a small redesign will solve the whole problem. In fact, you > need to get into the realm of linear-types-like things before arr is too > much (and even then a *linear* arr would be fine). > > I designed a library for constructing Postgres queries and it uses an Arrow > interface. > > https://hackage.haskell.org/package/opaleye-0.5.3.0/docs/Opaleye-Internal-QueryArr.html > > Naturally there is no way to run an arbitrary Haskell function "in the > database". This is not an impediment because everything that the database > acts on inside the arrow type (QueryArr) is wrapped in an abstract type > (Column). This means the only way that arbitrary Haskell functions can be > used inside the arrow is as a sort of "partial compilation". There is, in > effect, a staging restriction. Haskell functions a -> b run at "query > compile time" and Postgres functions run at "query run time". Hm. Interesting point. And a nice coincidence that you call Applicative without fmap "useless". I just recently saw one of those. It *did* feel like there might be a better structure, but I couldn't pin it down. Maybe your technique works in that context as well? Would you mind having a look? I'd like to have my eyes opened in that direction. The structure in question are XML-Picklers, i.e. tools to convert to and from XML. The original types are from HXT , but for the purpose of discussion we can simplify them to data PU a = PU { appPickle :: a -> XmlState -> XmlState -- turn a value into XML , appUnPickle :: XmlState -> (Either UnpickleErr a, XmlState) -- turn XML into a value } -- "pure" xpLift :: a -> PU a xpLift x = PU { appPickle = const id , appUnPickle = purex }-- Combine two picklers sequentially -- If the first fails during unpickling, the whole unpickler failsxpSeq :: (b -> a) -> PU a -> (a -> PU b) -> PU b xpSeq f pa k = PU { appPickle = ( \ b -> let a = f b in appPickle pa a . appPickle (k a) b ) , appUnPickle = appUnPickle pa >>= (appUnPickle . k) }-- Pickle a pair of values sequentially xpPair :: PU a -> PU b -> PU (a, b) xpPair pa pb = ( xpSeq fst pa (\ a -> xpSeq snd pb (\ b ->xpLift (a,b))) ) -- The closest equivalent to "fmap" xpWrap :: (a -> b, b -> a) -> PU a -> PU b Now: This is not exactly an Applicative. If it where a functor, it would be a (lax) monoidal functor. Taking syntax from the Typeclassopedia , xpPair would be Monoidal's (**). And a (lax) monoidal functor is exactly an Applicative. If I'm not mistaken this structure satisfies all the laws of Monoidal – except that it is not a functor. Obviously there's no way to implement fmap because you always need to provide functions for both directions, as seen in xpWrap. So how would you change this structure to make it possible? It feels like the underlying problem is the same as with arr: At first there seems to be no way to lift functions into the structure. And we don't want to create two separate types because the whole idea of PU is to make pairs of related picklers and unpicklers composable. Do I have a blind eye, nourished by that myth that often lifting is not possible? Or did I stumble upon that one usecase where there IS a useful Applicative-without-fmap? MarLinn -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 27 13:46:49 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 27 Feb 2018 13:46:49 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <20180227105232.GH27273@weber> <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> Message-ID: <20180227134649.GL27273@weber> On Tue, Feb 27, 2018 at 02:28:31PM +0100, MarLinn wrote: > >There's a myth floating around that "Arrow is much less useful because it > >forces you to implement arr". In fact, Arrow without arr would be as > >useless as Applicative without fmap. > > a nice coincidence that you call Applicative without fmap "useless". I > just recently saw one of those. It *did* feel like there might be a > better structure, but I couldn't pin it down. Maybe your technique works > in that context as well? ... > > The structure in question are XML-Picklers, i.e. tools to convert to > and from XML. The original types are from HXT > > > > Obviously there's no way to implement fmap because you always need > to provide functions for both directions .... So how > would you change this structure to make it possible? Observe the definition from the HXT source data PU a = PU { appPickle :: Pickler a , appUnPickle :: Unpickler a , theSchema :: Schema } type Pickler a = a -> St -> St newtype Unpickler a = UP { runUP :: St -> (UnpickleVal a, St) } type UnpickleVal a = Either UnpickleErr a Pickler is contravariant (Contravariant) and Unpickler is covariant (Functor) so if we slighly augment PU we get a Profunctor. data PU' a b = PU { appPickle :: Pickler a , appUnPickle :: Unpickler b , theSchema :: Schema } In fact Unpickler is a Monad (isomorphic to an EitherT of a State) so "PU' a" is an Applicative and PU is what I call a "product profunctor". https://hackage.haskell.org/package/product-profunctors This little augumentation in the definition of PU gets you a whole host of free functionality from the libaries for profunctors, applicatives and product profunctors. (By the way, this observation is completely different from the "compiling languages for different targets" technique that I mentioned in the previous post.) Tom From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 27 14:00:49 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 27 Feb 2018 14:00:49 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <20180227134649.GL27273@weber> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <20180227105232.GH27273@weber> <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> <20180227134649.GL27273@weber> Message-ID: <20180227140049.GM27273@weber> On Tue, Feb 27, 2018 at 01:46:49PM +0000, Tom Ellis wrote: > In fact Unpickler is a Monad (isomorphic to an EitherT of a State) so "PU' a" > is an Applicative and PU is what I call a "product profunctor". > > https://hackage.haskell.org/package/product-profunctors (Oh, we also need Pickler to be Data.Functor.Contravariant.Divisible, which it indeed is.) From mike at barrucadu.co.uk Tue Feb 27 14:06:03 2018 From: mike at barrucadu.co.uk (Michael Walker) Date: Tue, 27 Feb 2018 14:06:03 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <20180227105232.GH27273@weber> <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> Message-ID: Hi, On 27 February 2018 at 13:28, MarLinn wrote: > > It feels like the underlying problem is the same as with arr: At first there > seems to be no way to lift functions into the structure. And we don't want > to create two separate types because the whole idea of PU is to make pairs > of related picklers and unpicklers composable. For my own learning, a while ago I implemented a little encoding/decoding library, with the encoders based on contravariant functors. I started with a type which I called `Codec a`, which contained both an encoding and a decoding function. As you did, I quickly found that this makes many typeclass instances impossible. So, like in Tom's reply, I instead added a more generic `Codec' a b` type, which separates the encoding and decoding parameters. I kept `Codec a` as a type synonym for `Codec' a a`. I found the change to make the resulting code much nicer to implement and to use, even though it would be possible for a user to construct an encoder/decoder pair which decodes to a different type than what they started with. In fact, after another round of type parameter introduction (abstracting over the concrete type of the encoded value: bytestrings and bytestring builders in `Codec'`, but type parameters in the yet more general type), I discovered a very natural separation between my "codecs" and combinators for composing them. So in this case, I suppose the moral of the story is that having a type parameter which is both covariant and contravariant is not that useful, and you can always just constrain the type variables to be the same where you need to anyway. The code is here: https://github.com/barrucadu/wheat -- Michael Walker (http://www.barrucadu.co.uk) From monkleyon at gmail.com Tue Feb 27 14:19:54 2018 From: monkleyon at gmail.com (MarLinn) Date: Tue, 27 Feb 2018 15:19:54 +0100 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <20180227134649.GL27273@weber> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <20180227105232.GH27273@weber> <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> <20180227134649.GL27273@weber> Message-ID: <9a74acc2-7a5b-33b9-cca6-b221a1f21609@gmail.com> > In fact Unpickler is a Monad (isomorphic to an EitherT of a State) so "PU' a" > is an Applicative and PU is what I call a "product profunctor". > > https://hackage.haskell.org/package/product-profunctors > > This little augumentation in the definition of PU gets you a whole host of > free functionality from the libaries for profunctors, applicatives and > product profunctors. > > (By the way, this observation is completely different from the "compiling > languages for different targets" technique that I mentioned in the previous > post.) > I did see that I could turn PU into a profunctor, but not that that would make it an Applicative. Huh. Thanks for the tip! (I may have been distracted by looking for an arr to turn that profunctor into an arrow though.) It seems that while the particular observation is quite different, the more general approach is similar. Which nicely brings us back to the original question: If something "almost" fits a class, there's probably a better one around the corner. One might just be blind right now. Cheers, MarLinn From bhurt at spnz.org Tue Feb 27 14:53:33 2018 From: bhurt at spnz.org (Brian Hurt) Date: Tue, 27 Feb 2018 14:53:33 +0000 Subject: [Haskell-cafe] Type level variants Message-ID: I'm looking for pointers on how to do something. What I'm trying to do: I want to define a newtype wrapper for database connections with a phantom type to control whether the connection is read-only or read-write. So I have: newtype Conn a = Conn { unConn :: Connection } data ReadOnly = ReadOnly data ReadWrite = ReadWrite -- Simplifying here openConn :: MonadIO m => a -> Conn a query :: (MonadIO m, ToRow r, FromRow s) => Conn a -> Query -> r -> m [s] execute :: (MonadIO m, ToRow r) => Conn a -> Query -> r -> m Int64 But I want to be able to restrict the type a to be either ReadOnly or ReadWrite. Solutions I've come up with so far are: - Don't bother. Later function calls put enough of constraint on the types that it isn't really necessary. Or rather, ReadWrite is necessary, but ReadOnly isn't. - Define some type class that ReadWrite and ReadOnly implement, but don't export the body of the typeclass from the module, preventing other people from implementing it for other types. - Some sort of trickiness with closed type families that I haven't worked out yet. Are their alternatives I haven't considered yet? Thanks. Brian -------------- next part -------------- An HTML attachment was scrubbed... URL: From kolar at fit.vut.cz Tue Feb 27 15:06:33 2018 From: kolar at fit.vut.cz (=?utf-8?B?RHXFoWFuIEtvbMOhxZk=?=) Date: Tue, 27 Feb 2018 16:06:33 +0100 Subject: [Haskell-cafe] Optimization demonstration Message-ID: <1546108.5pW7Zzn0Q7@pckolar> Dear Café, I'm trying to do very small, but impressive example about optimizations possible during Haskell compilation. So far, I can demonstrate that the following two programs (if compiled) perform computation in the same time: 1) main = putStrLn $ show $ sum $ map (*(2::Int)) [(1::Int)..(100000000::Int)] 2) main = putStrLn $! show $! sumup 1 0 sumup :: Int -> Int -> Int sumup n total = if n<=(100000000::Int) then sumup (n+1) $! total+(2*n) else total Nevertheless, I expect a question on comparison with C: 3) #include int main(void) { long sum, i; sum = 0; for (i=1; i <= 100000000L; ++i) { sum += 2*i; } printf("%ld\n",sum); return 0; } Unfortunately, in this case the C is much more faster (it prints the result immediately), at least on my machine. Is it due to a fact that C compiler does a brutal optimization leading to compile-time evaluation, while ghc is not able to do that? I'm using -O2 -dynamic --make ghc compiler flags. For gcc for C compilation just -O2, running Arch Linux. Is there any option, how to force compile time evaluation? The reason, why I think it works this way is the fact, that when running out of long type values in C a code is generated that computes the values regularly (providing misleading value as a result) taking its time. Best regards, Dušan -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 27 15:10:32 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 27 Feb 2018 15:10:32 +0000 Subject: [Haskell-cafe] Type level variants In-Reply-To: References: Message-ID: <20180227151032.GN27273@weber> On Tue, Feb 27, 2018 at 02:53:33PM +0000, Brian Hurt wrote: > I'm looking for pointers on how to do something. What I'm trying to do: I > want to define a newtype wrapper for database connections with a phantom > type to control whether the connection is read-only or read-write. So I > have: > > newtype Conn a = Conn { unConn :: Connection } > > data ReadOnly = ReadOnly > > data ReadWrite = ReadWrite > > -- Simplifying here > openConn :: MonadIO m => a -> Conn a > > query :: (MonadIO m, ToRow r, FromRow s) => Conn a -> Query -> r -> m > [s] > > execute :: (MonadIO m, ToRow r) => Conn a -> Query -> r -> m Int64 > > But I want to be able to restrict the type a to be either ReadOnly or > ReadWrite. Solutions I've come up with so far are: [...] > Are their alternatives I haven't considered yet? Have you considered {-# LANGUAGE DataKinds #-} data Read = ReadOnly | ReadWrite ? From astrohavoc at gmail.com Tue Feb 27 15:12:55 2018 From: astrohavoc at gmail.com (Shao Cheng) Date: Tue, 27 Feb 2018 15:12:55 +0000 Subject: [Haskell-cafe] Type level variants In-Reply-To: References: Message-ID: You can use DataKinds extension and define a singleton type for ReadOnly/WriteOnly. The code roughly looks like: data ReadWrite = ReadOnly | WriteOnly newtype Conn (a :: ReadWrite) = ... openConn :: MonadIO m => Sing a -> m (Conn a) In the implementation of openConn you can pattern match on Sing a and recover ReadOnly/WriteOnly both on term/type level. The singletons package provide utilities to ease writing this style of code. On Tue, Feb 27, 2018, 10:56 PM Brian Hurt wrote: > I'm looking for pointers on how to do something. What I'm trying to do: I > want to define a newtype wrapper for database connections with a phantom > type to control whether the connection is read-only or read-write. So I > have: > > newtype Conn a = Conn { unConn :: Connection } > > data ReadOnly = ReadOnly > > data ReadWrite = ReadWrite > > -- Simplifying here > openConn :: MonadIO m => a -> Conn a > > query :: (MonadIO m, ToRow r, FromRow s) => Conn a -> Query -> r -> m > [s] > > execute :: (MonadIO m, ToRow r) => Conn a -> Query -> r -> m Int64 > > But I want to be able to restrict the type a to be either ReadOnly or > ReadWrite. Solutions I've come up with so far are: > > - Don't bother. Later function calls put enough of constraint on the > types that it isn't really necessary. Or rather, ReadWrite is necessary, > but ReadOnly isn't. > > - Define some type class that ReadWrite and ReadOnly implement, but don't > export the body of the typeclass from the module, preventing other people > from implementing it for other types. > > - Some sort of trickiness with closed type families that I haven't worked > out yet. > > Are their alternatives I haven't considered yet? > > Thanks. > > Brian > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From pumpkingod at gmail.com Tue Feb 27 15:15:04 2018 From: pumpkingod at gmail.com (Daniel Peebles) Date: Tue, 27 Feb 2018 10:15:04 -0500 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: <9a74acc2-7a5b-33b9-cca6-b221a1f21609@gmail.com> References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <20180227105232.GH27273@weber> <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> <20180227134649.GL27273@weber> <9a74acc2-7a5b-33b9-cca6-b221a1f21609@gmail.com> Message-ID: Not sure if everyone just missed my earlier link, but this talk of "Arrow without arr is useless" seems odd in the face of significant academic work (with Coq proofs, GHC extension, real-world use case for heterogeneous metaprogramming, etc.) going into exactly that abstraction. Here it is again, if you did miss it: http://www.megacz.com/berkeley/garrows/ On Tue, Feb 27, 2018 at 9:19 AM, MarLinn wrote: > > In fact Unpickler is a Monad (isomorphic to an EitherT of a State) so "PU' >> a" >> is an Applicative and PU is what I call a "product profunctor". >> >> https://hackage.haskell.org/package/product-profunctors >> >> This little augumentation in the definition of PU gets you a whole host of >> free functionality from the libaries for profunctors, applicatives and >> product profunctors. >> >> (By the way, this observation is completely different from the "compiling >> languages for different targets" technique that I mentioned in the >> previous >> post.) >> >> > I did see that I could turn PU into a profunctor, but not that that would > make it an Applicative. Huh. Thanks for the tip! > (I may have been distracted by looking for an arr to turn that profunctor > into an arrow though.) > > It seems that while the particular observation is quite different, the > more general approach is similar. Which nicely brings us back to the > original question: If something "almost" fits a class, there's probably a > better one around the corner. One might just be blind right now. > > Cheers, > MarLinn > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From astrohavoc at gmail.com Tue Feb 27 15:19:24 2018 From: astrohavoc at gmail.com (Shao Cheng) Date: Tue, 27 Feb 2018 15:19:24 +0000 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: <1546108.5pW7Zzn0Q7@pckolar> References: <1546108.5pW7Zzn0Q7@pckolar> Message-ID: You can use Template Haskell to perform arbitrary computation at compile-time (even if it requires IO!), and then `lift` the result into a Haskell literal. This works for any type with a `Lift` instance (or with a bit of trick, any serializable type). Coming back to your use case, you may try avoid using raw lists and switch to unboxed vectors, turn on -O2 and rely on stream fusion of the vector package. That will result in a considerable speedup. On Tue, Feb 27, 2018, 11:09 PM Dušan Kolář wrote: > Dear Café, > > > > I'm trying to do very small, but impressive example about optimizations > possible during Haskell compilation. So far, I can demonstrate that the > following two programs (if compiled) perform computation in the same time: > > > > 1) > > > > main = > > putStrLn $ show $ sum $ map (*(2::Int)) [(1::Int)..(100000000::Int)] > > > > > > 2) > > > > main = > > putStrLn $! show $! sumup 1 0 > > > > sumup :: Int -> Int -> Int > > sumup n total = > > if n<=(100000000::Int) then sumup (n+1) $! total+(2*n) > > else total > > > > > > Nevertheless, I expect a question on comparison with C: > > > > 3) > > > > #include > > > > int main(void) { > > long sum, i; > > sum = 0; > > for (i=1; i <= 100000000L; ++i) { > > sum += 2*i; > > } > > printf("%ld\n",sum); > > return 0; > > } > > > > > > Unfortunately, in this case the C is much more faster (it prints the > result immediately), at least on my machine. Is it due to a fact that C > compiler does a brutal optimization leading to compile-time evaluation, > while ghc is not able to do that? > > > > I'm using -O2 -dynamic --make ghc compiler flags. For gcc for C > compilation just -O2, running Arch Linux. > > > > Is there any option, how to force compile time evaluation? The reason, why > I think it works this way is the fact, that when running out of long type > values in C a code is generated that computes the values regularly > (providing misleading value as a result) taking its time. > > > > Best regards, > > > > Dušan > > > > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.reich at gmail.com Tue Feb 27 15:37:42 2018 From: ryan.reich at gmail.com (Ryan Reich) Date: Tue, 27 Feb 2018 07:37:42 -0800 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: References: <1546108.5pW7Zzn0Q7@pckolar> Message-ID: I thought fusion might be the answer, but don't the standard list functions have rewrite rules for that too? Build/consume; this should apply directly to this example (version 1). On Feb 27, 2018 07:30, "Shao Cheng" wrote: You can use Template Haskell to perform arbitrary computation at compile-time (even if it requires IO!), and then `lift` the result into a Haskell literal. This works for any type with a `Lift` instance (or with a bit of trick, any serializable type). Coming back to your use case, you may try avoid using raw lists and switch to unboxed vectors, turn on -O2 and rely on stream fusion of the vector package. That will result in a considerable speedup. On Tue, Feb 27, 2018, 11:09 PM Dušan Kolář wrote: > Dear Café, > > > > I'm trying to do very small, but impressive example about optimizations > possible during Haskell compilation. So far, I can demonstrate that the > following two programs (if compiled) perform computation in the same time: > > > > 1) > > > > main = > > putStrLn $ show $ sum $ map (*(2::Int)) [(1::Int)..(100000000::Int)] > > > > > > 2) > > > > main = > > putStrLn $! show $! sumup 1 0 > > > > sumup :: Int -> Int -> Int > > sumup n total = > > if n<=(100000000::Int) then sumup (n+1) $! total+(2*n) > > else total > > > > > > Nevertheless, I expect a question on comparison with C: > > > > 3) > > > > #include > > > > int main(void) { > > long sum, i; > > sum = 0; > > for (i=1; i <= 100000000L; ++i) { > > sum += 2*i; > > } > > printf("%ld\n",sum); > > return 0; > > } > > > > > > Unfortunately, in this case the C is much more faster (it prints the > result immediately), at least on my machine. Is it due to a fact that C > compiler does a brutal optimization leading to compile-time evaluation, > while ghc is not able to do that? > > > > I'm using -O2 -dynamic --make ghc compiler flags. For gcc for C > compilation just -O2, running Arch Linux. > > > > Is there any option, how to force compile time evaluation? The reason, why > I think it works this way is the fact, that when running out of long type > values in C a code is generated that computes the values regularly > (providing misleading value as a result) taking its time. > > > > Best regards, > > > > Dušan > > > > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Tue Feb 27 15:38:00 2018 From: allbery.b at gmail.com (Brandon Allbery) Date: Tue, 27 Feb 2018 10:38:00 -0500 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: <1546108.5pW7Zzn0Q7@pckolar> References: <1546108.5pW7Zzn0Q7@pckolar> Message-ID: On Tue, Feb 27, 2018 at 10:06 AM, Dušan Kolář wrote: > Unfortunately, in this case the C is much more faster (it prints the > result immediately), at least on my machine. Is it due to a fact that C > compiler does a brutal optimization leading to compile-time evaluation, > while ghc is not able to do that? > > ghc is less prone to invoke that kind of optimization, but sometimes can do so. And yes, gcc is decidedly "brutal" with -O2: inspect the generated assembler and you'll find that it just prints a constant. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 27 17:25:25 2018 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 27 Feb 2018 17:25:25 +0000 Subject: [Haskell-cafe] Partial instance of a class In-Reply-To: References: <22c3b2b1-04b9-073f-5e57-63902489fa3d@chordify.net> <20180227105232.GH27273@weber> <1ed3bfd8-1a09-e3b7-9887-dc17500e9abc@gmail.com> <20180227134649.GL27273@weber> <9a74acc2-7a5b-33b9-cca6-b221a1f21609@gmail.com> Message-ID: <20180227172525.GO27273@weber> On Tue, Feb 27, 2018 at 10:15:04AM -0500, Daniel Peebles wrote: > Not sure if everyone just missed my earlier link, but this talk of "Arrow > without arr is useless" seems odd in the face of significant academic work > (with Coq proofs, GHC extension, real-world use case for heterogeneous > metaprogramming, etc.) going into exactly that abstraction. > > Here it is again, if you did miss it: > http://www.megacz.com/berkeley/garrows/ I didn't say that "Arrow without arr is useless" I said it would be "as useless as Applicative without fmap". 99% of Haskell programmers would never consider complaining about Applicative because it requires fmap and the same ought to be true about Arrow and arr. The page you link to documents research which I'm sure has great merit. Unfortunately it also promotes the myth that I was trying to dispel. It claims Haskell Arrows support metaprogramming only when the guest language is a superset of Haskell, because every Haskell function can be promoted to a guest language expression using arr. but as both my Postgres library Opaleye and the paper I linked demonstrate this is not correct. Arrow can target languages that have no connection to Haskell. For the two concrete examples that have appeared on this list since my first message GArrow is not the appropriate solution. I invite readers to submit their own examples where it is. Tom From ryan.reich at gmail.com Tue Feb 27 17:26:07 2018 From: ryan.reich at gmail.com (Ryan Reich) Date: Tue, 27 Feb 2018 09:26:07 -0800 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: References: <1546108.5pW7Zzn0Q7@pckolar> Message-ID: In other words, it's not competition with the language C but with its popular compiler. Choose an example that doesn't simplify and you'll get a fairer contest. On Feb 27, 2018 07:52, "Brandon Allbery" wrote: > On Tue, Feb 27, 2018 at 10:06 AM, Dušan Kolář wrote: > >> Unfortunately, in this case the C is much more faster (it prints the >> result immediately), at least on my machine. Is it due to a fact that C >> compiler does a brutal optimization leading to compile-time evaluation, >> while ghc is not able to do that? >> >> > ghc is less prone to invoke that kind of optimization, but sometimes can > do so. And yes, gcc is decidedly "brutal" with -O2: inspect the generated > assembler and you'll find that it just prints a constant. > > -- > brandon s allbery kf8nh sine nomine > associates > allbery.b at gmail.com > ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad > http://sinenomine.net > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From vale.cofershabica at gmail.com Tue Feb 27 18:14:01 2018 From: vale.cofershabica at gmail.com (Vale Cofer-Shabica) Date: Tue, 27 Feb 2018 13:14:01 -0500 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: References: <1546108.5pW7Zzn0Q7@pckolar> Message-ID: You can prevent this particular optimization-to-constant by declaring sum ' volatile ' as below: #include int main(void) { volatile long sum = 0; for (long i = 1; i <= 100000000L; ++i) { sum += i; } printf("%ld\n",sum); return 0; } I don't know if this provides the comparison you're looking for, but it does force the compiler to emit assembly to do the summation. -- vale cofer-shabica 401.267.8253 On Tue, Feb 27, 2018 at 12:26 PM, Ryan Reich wrote: > In other words, it's not competition with the language C but with its > popular compiler. Choose an example that doesn't simplify and you'll get a > fairer contest. > > On Feb 27, 2018 07:52, "Brandon Allbery" wrote: > >> On Tue, Feb 27, 2018 at 10:06 AM, Dušan Kolář wrote: >> >>> Unfortunately, in this case the C is much more faster (it prints the >>> result immediately), at least on my machine. Is it due to a fact that C >>> compiler does a brutal optimization leading to compile-time evaluation, >>> while ghc is not able to do that? >>> >>> >> ghc is less prone to invoke that kind of optimization, but sometimes can >> do so. And yes, gcc is decidedly "brutal" with -O2: inspect the generated >> assembler and you'll find that it just prints a constant. >> >> -- >> brandon s allbery kf8nh sine nomine >> associates >> allbery.b at gmail.com >> ballbery at sinenomine.net >> unix, openafs, kerberos, infrastructure, xmonad >> http://sinenomine.net >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From bhurt at spnz.org Tue Feb 27 18:32:10 2018 From: bhurt at spnz.org (Brian Hurt) Date: Tue, 27 Feb 2018 18:32:10 +0000 Subject: [Haskell-cafe] Type level variants In-Reply-To: <20180227151032.GN27273@weber> References: <20180227151032.GN27273@weber> Message-ID: No, and thank you and astrohavoc at gmail.com for pointing it out. I was going "There *has to be* a better solution to this". On Tue, Feb 27, 2018 at 3:10 PM, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Tue, Feb 27, 2018 at 02:53:33PM +0000, Brian Hurt wrote: > > I'm looking for pointers on how to do something. What I'm trying to do: > I > > want to define a newtype wrapper for database connections with a phantom > > type to control whether the connection is read-only or read-write. So I > > have: > > > > newtype Conn a = Conn { unConn :: Connection } > > > > data ReadOnly = ReadOnly > > > > data ReadWrite = ReadWrite > > > > -- Simplifying here > > openConn :: MonadIO m => a -> Conn a > > > > query :: (MonadIO m, ToRow r, FromRow s) => Conn a -> Query -> r -> m > > [s] > > > > execute :: (MonadIO m, ToRow r) => Conn a -> Query -> r -> m Int64 > > > > But I want to be able to restrict the type a to be either ReadOnly or > > ReadWrite. Solutions I've come up with so far are: > [...] > > Are their alternatives I haven't considered yet? > > Have you considered > > {-# LANGUAGE DataKinds #-} > > data Read = ReadOnly | ReadWrite > > ? > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From neil_mayhew at users.sourceforge.net Tue Feb 27 18:51:17 2018 From: neil_mayhew at users.sourceforge.net (Neil Mayhew) Date: Tue, 27 Feb 2018 11:51:17 -0700 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: References: <1546108.5pW7Zzn0Q7@pckolar> Message-ID: <22c847c8-0630-9e78-dc89-a968b1058a34@users.sourceforge.net> On 2018-02-27 08:19 AM, Shao Cheng wrote: Coming back to your use case, you may try avoid using raw lists and switch to unboxed vectors, turn on -O2 and rely on stream fusion of the vector package. That will result in a considerable speedup. I looked at the core that’s generated, and there’s no need for vectors. Fusion happens, there’s no use of lists at all and unboxed types are used. The code boils down to a single recursive function: |let go i sum = case i of 100000000 -> sum + 200000000 _ -> go (i + 1) (sum + i * 2) in go 1 0 | except that the types are unboxed. The following complete program compiles down to almost identical core when compiled without optimization: |{-# LANGUAGE MagicHash #-} import GHC.Exts main = print $ I# value where value = let go :: Int# -> Int# -> Int# go i sum = case i of 100000000# -> sum +# 200000000# _ -> go (i +# 1#) (sum +# i *# 2#) in go 1# 0# | I think that’s impressive even if it’s not a single number. Execution time on my lowly i5 is only 50ms. BTW, GHC 8 seems to have removed the option for exporting core (|-fext-core|) but there’s a wonderful plugin package called |dump-core| that produces HTML output with colouring and interactivity. You just install it from Hackage and use the extra options it provides. It seems to me that gcc’s compile-time evaluation of this loop is a special-case that matches the kind of thing that often crops up in C. I assume it’s not capable of doing that for every expression that could be evaluated at compile time, so a more complicated and realistic example would probably defeat it. After all, ghc could in theory evaluate any pure value (CAF) at compile time if it chose to, but that’s usually not what you want. Also, it’s worth noting that due to Haskell’s lazy evaluation, a pure value (CAF) will never be evaluated more than once at runtime, which isn’t something you get with C. ​ -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Wed Feb 28 04:55:11 2018 From: allbery.b at gmail.com (Brandon Allbery) Date: Tue, 27 Feb 2018 23:55:11 -0500 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: <22c847c8-0630-9e78-dc89-a968b1058a34@users.sourceforge.net> References: <1546108.5pW7Zzn0Q7@pckolar> <22c847c8-0630-9e78-dc89-a968b1058a34@users.sourceforge.net> Message-ID: -fext-core wasn't about exporting it, but about accepting core as *source* ("external core"). Which was always tricky and was broken for years before the option was removed. On Tue, Feb 27, 2018 at 1:51 PM, Neil Mayhew < neil_mayhew at users.sourceforge.net> wrote: > On 2018-02-27 08:19 AM, Shao Cheng wrote: > > Coming back to your use case, you may try avoid using raw lists and switch > to unboxed vectors, turn on -O2 and rely on stream fusion of the vector > package. That will result in a considerable speedup. > > I looked at the core that’s generated, and there’s no need for vectors. > Fusion happens, there’s no use of lists at all and unboxed types are used. > The code boils down to a single recursive function: > > let go i sum = case i of > 100000000 -> sum + 200000000 > _ -> go (i + 1) (sum + i * 2)in go 1 0 > > except that the types are unboxed. The following complete program compiles > down to almost identical core when compiled without optimization: > > {-# LANGUAGE MagicHash #-} > import GHC.Exts > main = print $ I# value > where > value = > let go :: Int# -> Int# -> Int# > go i sum = case i of > 100000000# -> sum +# 200000000# > _ -> go (i +# 1#) (sum +# i *# 2#) > in go 1# 0# > > I think that’s impressive even if it’s not a single number. Execution time > on my lowly i5 is only 50ms. > > BTW, GHC 8 seems to have removed the option for exporting core (-fext-core) > but there’s a wonderful plugin package called dump-core > that produces HTML output with > colouring and interactivity. You just install it from Hackage and use the > extra options it provides. > > It seems to me that gcc’s compile-time evaluation of this loop is a > special-case that matches the kind of thing that often crops up in C. I > assume it’s not capable of doing that for every expression that could be > evaluated at compile time, so a more complicated and realistic example > would probably defeat it. After all, ghc could in theory evaluate any pure > value (CAF) at compile time if it chose to, but that’s usually not what you > want. > > Also, it’s worth noting that due to Haskell’s lazy evaluation, a pure > value (CAF) will never be evaluated more than once at runtime, which isn’t > something you get with C. > ​ > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From juhpetersen at gmail.com Wed Feb 28 07:37:13 2018 From: juhpetersen at gmail.com (Jens Petersen) Date: Wed, 28 Feb 2018 16:37:13 +0900 Subject: [Haskell-cafe] [ANNOUNCE] GHC 8.4.1-rc1 available In-Reply-To: <87po4trmr3.fsf@smart-cactus.org> References: <87po4trmr3.fsf@smart-cactus.org> Message-ID: On 26 February 2018 at 02:42, Ben Gamari wrote: > https://downloads.haskell.org/~ghc/8.4.1-rc1 I'd like to ask: what BuildFlavour are these builds? Perf or something else? Is there a build.mk file for them? (If so would it make sense to include it in the binary tarballs?) I started https://copr.fedorainfracloud.org/coprs/petersen/ghc-8.4.1/ for Fedora testing. Thanks, Jens From kolar at fit.vut.cz Wed Feb 28 14:03:44 2018 From: kolar at fit.vut.cz (=?utf-8?B?RHXFoWFuIEtvbMOhxZk=?=) Date: Wed, 28 Feb 2018 15:03:44 +0100 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: References: <1546108.5pW7Zzn0Q7@pckolar> Message-ID: <8587870.mZgDzjWCmG@pckolar> Many thanks all for replies, yes, that's what I assumed/wrote. C compiler does compile- time evaluation, while ghc does another transformation. And, well, yes, declaring upper bound in loop in extra file breaks the optimization for C compiler and, thus, both evaluation times for C and Haskell binaries are the same thus. Thank you once, again, Dušan P.S. If anyone can point me to resource, where examples on demonstration of Haskell optimization are, I'll be very glad. D. On úterý 27. února 2018 23:06:38 CET Richard O'Keefe wrote: > In order to optimise array indexing and to automatically vectorise > your code, high performance compilers for imperative languages > like C and Fortran analyse counted loops like you wouldn't believe. > You can find out what the C compiler does with your code by using > the -S command line option. gcc 7.2 optimised the whole loop away. > > Split your C program into two files. > One contains > long bound = 100000000L, incr = 1L; > The other is a version of your existing code with > extern long bound, incr; > ... > for (i = 1L; i <= bound; i += incr) { ... } > ... > gcc 7.2 isn't quite smart enough to optimise this away. Yet. > > The polyhedral optimisations going on are described in the > open literature and are valuable for imperative array- > crunching code. You are not likely to see them in GHC any > time soon, just as you're not likely to see deforestation > in gcc any time soon. > > On 28 February 2018 at 04:06, Dušan Kolář wrote: > > Dear Café, > > > > > > > > I'm trying to do very small, but impressive example about optimizations > > possible during Haskell compilation. So far, I can demonstrate that the > > following two programs (if compiled) perform computation in the same time: > > > > > > > > 1) > > > > > > > > main = > > > > putStrLn $ show $ sum $ map (*(2::Int)) [(1::Int)..(100000000::Int)] > > > > > > > > > > > > 2) > > > > > > > > main = > > > > putStrLn $! show $! sumup 1 0 > > > > > > > > sumup :: Int -> Int -> Int > > > > sumup n total = > > > > if n<=(100000000::Int) then sumup (n+1) $! total+(2*n) > > > > else total > > > > > > > > > > > > Nevertheless, I expect a question on comparison with C: > > > > > > > > 3) > > > > > > > > #include > > > > > > > > int main(void) { > > > > long sum, i; > > > > sum = 0; > > > > for (i=1; i <= 100000000L; ++i) { > > > > sum += 2*i; > > > > } > > > > printf("%ld\n",sum); > > > > return 0; > > > > } > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From neil_mayhew at users.sourceforge.net Wed Feb 28 15:02:54 2018 From: neil_mayhew at users.sourceforge.net (Neil Mayhew) Date: Wed, 28 Feb 2018 08:02:54 -0700 Subject: [Haskell-cafe] Optimization demonstration In-Reply-To: References: <1546108.5pW7Zzn0Q7@pckolar> <22c847c8-0630-9e78-dc89-a968b1058a34@users.sourceforge.net> Message-ID: <9e553a48-2ea9-f4e7-3ba1-f5f38d6cc3c0@users.sourceforge.net> On 2018-02-27 09:55 PM, Brandon Allbery wrote: > -fext-core wasn't about exporting it, but about accepting core as > *source* ("external core"). Which was always tricky and was broken for > years before the option was removed. > Thanks. I see I should have been using `-ddump-simpl` instead. -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben at well-typed.com Wed Feb 28 15:15:54 2018 From: ben at well-typed.com (Ben Gamari) Date: Wed, 28 Feb 2018 10:15:54 -0500 Subject: [Haskell-cafe] [ANNOUNCE] GHC 8.4.1-rc1 available In-Reply-To: References: <87po4trmr3.fsf@smart-cactus.org> Message-ID: <87muztqh5m.fsf@smart-cactus.org> Jens Petersen writes: > On 26 February 2018 at 02:42, Ben Gamari wrote: >> https://downloads.haskell.org/~ghc/8.4.1-rc1 > > I'd like to ask: what BuildFlavour are these builds? Perf or something else? > Is there a build.mk file for them? (If so would it make sense to > include it in the binary tarballs?) > > > I started https://copr.fedorainfracloud.org/coprs/petersen/ghc-8.4.1/ > for Fedora testing. > All of the binary distributions since 7.10.3 have been produced using this script [1]. It uses `BuildFlavour=` which is essentially equivalent to `BuildFlavour=perf`. Cheers, - Ben [1] https://github.com/bgamari/ghc-utils/blob/master/rel-eng/bin-release.sh -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From rrnewton at gmail.com Wed Feb 28 16:22:09 2018 From: rrnewton at gmail.com (Ryan Newton) Date: Wed, 28 Feb 2018 11:22:09 -0500 Subject: [Haskell-cafe] Software engineer job situated in a PL research group Message-ID: Hi all, This posting is for a potentially long term position with the department. In the short term the work will be largely about sandboxing, containerization, and other low level systems stuff, but *all* the high-level software in the group is written in Haskell: https://iujobs.peopleadmin.com/postings/44056 The OOPSLA17 paper, "Monadic Composition for Deterministic, Parallel Batch Processing ", should give an idea of what this initial project is about. The engineer would be co-located with a large Programming Languages group (6 faculty and a couple dozen Ph.D. students). University benefits are good and our college town combines culture and beautiful surroundings with convenience and affordability. Best regards, -Ryan -------------- next part -------------- An HTML attachment was scrubbed... URL: