Skip to content

Instantly share code, notes, and snippets.

@Profpatsch
Created January 16, 2023 08:07
Show Gist options
  • Save Profpatsch/0ef4b72aa6891ad5132ff8f54a6a63fd to your computer and use it in GitHub Desktop.
Save Profpatsch/0ef4b72aa6891ad5132ff8f54a6a63fd to your computer and use it in GitHub Desktop.
cabal-version: 3.0
name: foldl-repro
version: 0.1.0.0
-- synopsis:
-- description:
license: MIT
license-file: LICENSE
-- author:
-- maintainer:
-- copyright:
build-type: Simple
extra-doc-files: CHANGELOG.md
-- extra-source-files:
common warnings
ghc-options: -Wall
executable foldl-repro
import: warnings
main-is: Main.hs
-- other-modules:
-- other-extensions:
build-depends:
base ^>=4.15.1.0
, profunctors
, semigroupoids
, foldl
hs-source-dirs: .
default-language: Haskell2010
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE DerivingVia #-}
module Main where
import Control.Foldl (Fold)
import Control.Foldl qualified as Fold
import Data.Function ((&))
import Data.Profunctor
import Data.Semigroup
import Data.Semigroupoid
data Sub = Sub {subSum :: Sum Int}
deriving stock (Show)
data Result = Result {finalInt :: Int}
deriving stock (Show)
newtype Event = Event {unEvent :: (Sum Int)}
deriving stock (Show, Eq, Ord)
deriving (Num) via (Int)
-- > Fold.fold foldResult [Event 2, Event 4, Event 1, Event 0, Event 1]
-- Result {finalInt = 77}
--
-- THIS SHOULD BE @Result {finalInt = 8}@!!
main :: IO ()
main = print $ Fold.fold foldResult [Event 2, Event 4, Event 1, Event 0, Event 1]
-- | Fold a section into a sub
foldSub :: Fold Event Sub
foldSub = Sub <$> lmap unEvent Fold.mconcat
-- | split into section, then fold each section
foldResult :: Fold Event Result
foldResult =
foldIntoSections
&>> Fold.handles traverse (Fold.handles traverse foldSub)
&>> Fold.foldMap subSum (\s -> s & getSum & Result)
-- | Split into sections, if an event is smaller than the previous one, start a new section.
--
-- > Fold.fold foldIntoSubs [Event 2, Event 4, Event 1, Event 0, Event 1]
-- [ [ Event
-- { unEvent = Sum {getSum = 2}
-- },
-- Event {unEvent = Sum {getSum = 4}}
-- ],
-- [Event {unEvent = Sum {getSum = 1}}],
-- [Event {unEvent = Sum {getSum = 0}}, Event {unEvent = Sum {getSum = 1}}]
-- ]
foldIntoSections :: Fold Event [[Event]]
foldIntoSections = Fold.Fold step [] (reverse . fmap reverse)
where
step xs el = case xs & headMay >>= headMay of
Nothing -> [el] : xs
Just el' -> case xs of
[] -> [el] : xs
(xs' : xss) ->
if el > el'
then (el : xs') : xss
else [el] : xs' : xss
headMay [] = Nothing
headMay (x : _) = Just x
(&>>) :: Semigroupoid s => s a b -> s b c -> s a c
(&>>) = flip Data.Semigroupoid.o
-- like >>>
infixr 1 &>>
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment