Things I can only dream of: an -XRecordUpdateDo that would let someone write:
section { do
lessons <- for (lessons section) $ \lesson -> do ...
sposition <- use sectionCounter
}
as sugar for
do
lessons' <- for (lessons section) $ \lesson -> do ...
sposition' <- use sectionCounter
pure section { lessons = lessons', sposition = sposition' }
How about doing it without using any accumulator at all? 
No folds, just map, filter and zip.
{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
import Data.Text (Text)
import Data.Traversable (mapAccumL)
import Data.List (groupBy)
import Control.Arrow ((>>>))
data SimplifiedData a
= MkSimplifiedData
{ renumber :: Bool
, lessons :: [a]
} deriving (Functor, Foldable, Traversable, Show)
data Lesson = MkLesson {lessonName :: Text} deriving Show
data AnnotatedLesson = MkAnnotatedLesson Text Int deriving Show
annotate :: [SimplifiedData Lesson] -> [SimplifiedData AnnotatedLesson]
annotate = groupBy (\_ new -> not new.renumber) -- Implements the boolean check via groupBy, chunking the
-- list by renumber boolean.
>>> fmap ( (mapAccumL >>> mapAccumL) -- fmaps into the list of list of Simplified data,
-- with a composition of mapAccumL, i.e, map_reduce()
(\count MkLesson {lessonName} -> -- The map_reduce composition takes a numbering function
(count + 1 -- that takes the accumulator
, MkAnnotatedLesson lessonName count-- and applies it.
) )
1 -- The initial accumulator
>>> snd ) -- Discards the accumulator.
>>> concat -- Merges the list of lists
-- into a list of SimplifiedData again.
{- Version without comments or type annotation.
Technically 1 word shorter than the Python.
annotate = groupBy (\_ new -> not new.renumber)
>>> fmap ( (mapAccumL >>> mapAccumL)
(\count MkLesson {lessonName} ->
(count + 1
, MkAnnotatedLesson lessonName count
) )
1
>>> snd )
>>> concat
-}
{-
More idiomatically:
annotate = concat
. fmap ( snd . (mapAccumL . mapAccumL)
(\count MkLesson {lessonName} ->
(count + 1
, MkAnnotatedLesson lessonName count
)
)
1 )
. groupBy (\_ new -> not new.renumber)
-}
test = [ MkSimplifiedData False [MkLesson "Computer", MkLesson "Crash"]
, MkSimplifiedData False [MkLesson "Foo", MkLesson "Bar"]
, MkSimplifiedData True [MkLesson "Paper", MkLesson "Pencil"]
, MkSimplifiedData False [MkLesson "Imperative", MkLesson "Functional"]
]
New mapAccumL version, that’s shorter than the Python, but not necessarily more readable. This was what I was trying to post earlier.
It also highlights my point about naming lambdas; i.e, we could remove all the lambdas, replace them with names declared in the where clause, but would it be more readable then?
Imperative vs functional isn’t clearly delineated, but there is stateful, explicit mutation on one end, implicit mutation or quasi-mutation via State / accumulating parameter, as well as what I’d consider to be a relative pure solution via zip + optics.
The idea is more, functional programming should pull ahead and be preferred for data transforms, potentially at the cost of being comprehensible for the uninitiated, but being more concise and bug resistant without mutation.
But I can easily imagine talking to your juniors (including someone like me) and explaining that this idiom and the higher-order function involved is obscure and that an imperative approach would be better for the codebase, and you’d probably be right.
As far as preferring the imperative approach goes, maybe, but I’d always stand by an imperative approach if the choice is between an imperative approach, nothing, or a clumsy functional approach. We should be seeking more elegant ways to do this functionally no matter what, because while imperative programming is relatively well-explored, functional programming, although we have base camps, evacuation helicopters, and so on, is not, and the promise is still more understandable (declarative) and maintainable code.
I think the fact that we’re having difficulty getting a functional approach to pull ahead of the imperative one on this problem is, at the very least, providing an interesting exercise and topic for exploration.
Finally, credit has to go to mniip for the composition of mapAccumLs as something I overhead on FP Discord. Perhaps I should have waited for him to implement? It turns out mapAccumL composes evenly, although a third mapAccumL isn’t helpful as it just ends up ignoring the groupBy.
I like it! Concise and readable.
I think your implementation is my favourite one so far.
The use of groupBy is very cunning! I always assumed that the first argument to groupBy ought to be an equivalence relation, but maybe it’s fine for it to not be.
But your version doesn’t number the sections. If you add that feature it’s going to be longer than the Python
I like the grouping by approach! Unfortunately there is an issue with a couple of consequences. numberLessons essentially splits apart the structured data and then recovers the data by matching on title name. Firstly this is inefficient because annotated must be walked several times. Secondly this means the code is wrong if the same title appears more than once in a group. For example
numberIt
[ Section "One" True ["A", "B"]
, Section "One" False ["C", "D", "E"]
, Section "Three" True ["F", "G"]
, Section "Four" False []
, Section "Five" True ["H"]
]
leads to the output
Numbered 0 ("One",[Numbered 0 "A",Numbered 1 "B",Numbered 2 "C",Numbered 3 "D",Numbered 4 "E"])
Numbered 1 ("One",[Numbered 0 "A",Numbered 1 "B",Numbered 2 "C",Numbered 3 "D",Numbered 4 "E"])
Numbered 2 ("Three",[Numbered 0 "F",Numbered 1 "G"])
Numbered 3 ("Four",[])
Numbered 4 ("Five",[Numbered 0 "H"])
Whilst neither of these may be a problem in practice I think they imply that the code is more subtle than it needs to be.
The grouping approach by @lazamar and @Liamzy made me realise that the stateful section counter in the Python can be removed by (in Python) enumerate or (in Haskell) zip [1..]. @halogenandtoast also used that approach, but I didn’t notice it at the time.
sections' :: [Section Int]
sections' = flip evalState initialCounter $ do
for (zip [1..] sections) $ \(sectionCounter, section) -> do
when (resetLessonPosition section) $
lessonCounter .= 1
lessons' <- for (lessons section) $ \lesson -> do
position <- use lessonCounter
lessonCounter %= (+ 1)
pure (lesson {lposition = position})
let section' = section {sposition = sectionCounter, lessons = lessons'}
pure section'
Much nicer! I would say this is “less imperative” because it uses a smaller set of effects (i.e. a state of a smaller data type). I would say it’s “better” for that reason. I’m not sure I’d say it’s “more functional” though perhaps it’s is because the higer order function argument to the first for is doing “more” work. This is now very similar to @halogenandtoast’s version.
Full code versions: Revisions · Solution to https://discourse.haskell.org/t/beautiful-functional-programming/7411 · GitHub
I think we can make a clear delineation between code relying on a sequence on statement mutating a global state (machine code, assembly, C, tidying up ones bedroom) and others
It somehow mimic how the world works (and we are quite good at it) but it can be become quickly tricky to remember the current state (unlike in the real word) you can’t see it and have to imagite it.
It’s not a matter of bad or good, but by using a high-level programming language where everything is immutable by default you pretty much committed to not do “a sequence of statements mutating a global state” or at least avoid as much as possible.
And how about a knot-tying solution!
Use laziness to pass the solution as an input to the function that calculates the solution.
Still grouping on section titles to keep things simple.
A solution with list recursion and consing.
Resursion.hs
-- data declarations, setup elided....
updateSections :: [Section] -> Int -> Int -> [Section]
updateSections [] _ _ = []
updateSections (s:ss) sc lc =
s { position = sc', lessons = ls }: updateSections ss sc' (lessonPosition (last ls))
where sc' = sc + 1
ls = updateLessons (lessons s) (if resetLessonPosition s == True then 0 else lc)
updateLessons :: [Lesson] -> Int -> [Lesson]
updateLessons [] _ = []
updateLessons (l:ls) lc = l { lessonPosition = lc' }: updateLessons ls lc'
where lc' = lc + 1
solve :: IO ()
solve = print $ updateSections sections 0 0
I maintain that any solution that uses aeson’s fromJSON to parse to nice types is still operating on a key-value structure!
positionLesson :: Lesson -> Int -> PositionedLesson
positionLesson Lesson{..} position = PositionedLesson{..}
positionSection :: Section a -> Int -> PositionedSection a
positionSection Section{..} position = PositionedSection{..}
challenge :: Value -> Value
challenge val = case fromJSON val of
Success section -> toJSON $ setPositions section
Error _ -> error "Fail to parse JSON as Section"
setPositions :: [Section Lesson] -> [PositionedSection PositionedLesson]
setPositions =
coerce (imap' @(Compose [] PositionedSection) positionLesson)
<=< splitWhen (.reset_lesson_position)
. imap' positionSection
imap' :: (Traversable t) => (a -> Int -> b) -> t a -> t b
imap' f = flip evalState 1 . traverse (assignPos . f)
assignPos :: (Int -> b) -> State Int b
assignPos f = f <$> get <* modify' (+ 1)
Oh what’s that? You want to run this cute adorable bit of code yourself?
This smaaalll bit of setup code…
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}
module MyLib where
import Control.Monad ((<=<))
import Control.Monad.State.Class (MonadState (..), modify')
import Control.Monad.State.Strict (State, evalState)
import Data.Aeson (FromJSON, Result (..), ToJSON (toJSON), Value, fromJSON, decode)
import Data.Coerce (coerce)
import Data.Functor.Compose (Compose (Compose))
import Data.Text (Text)
import GHC.Generics (
Generic,
Generic1,
Generically (..),
)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.List.Split (splitWhen)
getData :: IO BS.ByteString
getData = BS.readFile "test.json"
test :: IO ()
test = BS.putStrLn . encodePretty . maybe (error "Bad JSON") challenge . decode =<< getData
data Section a = Section
{ title :: Text
, reset_lesson_position :: Bool
, lessons :: [a]
}
deriving (Generic, Generic1, Functor, Foldable, Traversable)
deriving via Generically (Section a) instance (ToJSON a) => ToJSON (Section a)
deriving via Generically (Section a) instance (FromJSON a) => FromJSON (Section a)
data PositionedSection a = PositionedSection
{ title :: Text
, reset_lesson_position :: Bool
, lessons :: [a]
, position :: Int
}
deriving (Generic, Generic1, Functor, Foldable, Traversable)
deriving via Generically (PositionedSection a) instance (ToJSON a) => ToJSON (PositionedSection a)
deriving via Generically (PositionedSection a) instance (FromJSON a) => FromJSON (PositionedSection a)
data Lesson = Lesson
{ name :: Text
}
deriving (Generic)
deriving via Generically Lesson instance ToJSON Lesson
deriving via Generically Lesson instance FromJSON Lesson
data PositionedLesson = PositionedLesson
{ name :: Text
, position :: Int
}
deriving (Generic)
deriving via Generically PositionedLesson instance ToJSON PositionedLesson
deriving via Generically PositionedLesson instance FromJSON PositionedLesson
A solution decoupling position generation and the updating of the sections
updatePositions sections (zip [1..] $ lessonPosititions sections)
with
-- | Computes the lesson positions as a [[Int]]
lessonPosititions :: [Section a] -> [[Int]]
lessonPosititions sections =
concatMap (flip reStructure [1..] . map lessons) $ breakOn resetLessonPosition sections
-- | Update the a list of section with the given section and lesson position.
updatePositions :: [Section a] -> [(Int, [Int])] -> [Section Int]
updatePositions =
zipWith (\s (sp, poss) -> s {sposition = sp
, lessons = zipWith (\l p -> l { lposition = p})
(lessons s)
poss
}
)
and the need of generic helpers which could be in Base
-- | Break a a list into nested lists
-- by copying the structure of a neste list
-- > reStructure ["abc", "d", "ef"] [1..]
-- [[1,2,3], [4], [5,6]]
reStructure :: [[a]] -> [b] -> [[b]]
reStructure [] _ = []
reStructure _ [] = []
reStructure ([]:xss) ys = []: reStructure xss ys
reStructure ((x:xs):xss) (y:ys) =
case reStructure (xs:xss) ys of
[] -> [[y]]
(ys':yss') -> (y:ys'):yss'
breakOn :: (a -> Bool) -> [a] -> [[a]]
breakOn f = groupBy (const $ not . f)
lessonPositions solves the real problem : finding the position number for a list of section.
It’s a pretty straight forward one liner.
The updatePositions is where Haskell doesn’t shine, updating nested data.
Still straightforward though.
(full code from @tomjaguarpaw gist).
This version is using Aeson’s Value type (JSON value, basically, over a treemap datatype), for a high fidelity rendering of the problem. This is also a pure zip-based solution using either the KeyMap interface in Aeson or through lens; no exec-state in sight here.
Which actually brings to mind another question: If you want to work with mutable objects holding dynamic data (i.e, some kind of treemap or hashmap), what is the canonical way to do so? You have Hashmap, Treemap, Keymap, EDN (from Clojure) libraries for the data structure. Of course, you’ll need either lens or optics to manipulate them efficiently, and I guess, even more canonically, you should cast them via aeson or other parser into a native Haskell ADT.
{- cabal:
build-depends: base, lens, lens-aeson, vector, aeson, aeson-pretty, bytestring
-}
{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
import Data.Aeson
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.QQ.Simple
import Data.Function ((&))
import qualified Data.Vector as V
import Control.Arrow
import qualified Data.List as L
import Data.Maybe (fromMaybe)
import Data.Foldable (traverse_)
import Data.Aeson.Encode.Pretty
import Data.ByteString.Lazy as BSL
import Data.String (fromString)
import Control.Lens
import Data.Aeson.Lens
samples :: Value
samples = [aesonQQ|[
{
"title": "Getting started",
"reset_lesson_position": false,
"lessons": [
{"name": "Welcome"},
{"name": "Installation"}
]
},
{
"title": "Basic operator",
"reset_lesson_position": false,
"lessons": [
{"name": "Addition / Subtraction"},
{"name": "Multiplication / Division"}
]
},
{
"title": "Advanced topics",
"reset_lesson_position": true,
"lessons": [
{"name": "Mutability"},
{"name": "Immutability"}
]
}
]|]
fixedSamples :: Value
fixedSamples = [aesonQQ|[
{
"title": "Getting started",
"reset_lesson_position": false,
"position": 1,
"lessons": [
{"name": "Welcome", "position": 1},
{"name": "Installation", "position": 2}
]
},
{
"title": "Basic operator",
"reset_lesson_position": false,
"position": 2,
"lessons": [
{"name": "Addition / Subtraction", "position": 3},
{"name": "Multiplication / Division", "position": 4}
]
},
{
"title": "Advanced topics",
"reset_lesson_position": true,
"position": 3,
"lessons": [
{"name": "Mutability", "position": 1},
{"name": "Immutability", "position": 2}
]
}
]|]
main :: IO ()
main = traverse_ BSL.putStr
[ fromString . show $ hiJose samples == fixedSamples
, "\n\n\n"
, encodePretty $ hiJose samples
, "\n\n\n"
, encodePretty fixedSamples
, "\n\n\n"
, fromString . show $ hiYosef samples == fixedSamples
, "\n\n\n"
, encodePretty $ hiYosef samples
, "\n"
]
hiJose :: Value -> Value
hiJose (Array innerArray) = Array . V.fromList
$ L.zipWith (\(Object keymap) count -> KM.insert "position" (Number (fromIntegral count)) keymap) (V.toList innerArray) [1..]
& L.groupBy (\_ b -> not . (\(Bool a) -> a) . fromMaybe (Bool False) $ b KM.!? "reset_lesson_position")
& fmap (zipAcross [1..] . fmap (id &&& maybe V.empty (\(Array a) -> a) . KM.lookup "lessons") )
& L.concat
& fmap makeAndAppendNewLessonField
where
zipAcross a [] = []
zipAcross a ((keymap, lessons):cont) =
let (segment, remainder) = L.splitAt (V.length lessons) a in
(keymap, L.zip (V.toList lessons) segment) : zipAcross remainder cont
makeAndAppendNewLessonField (keymap, vecOfLessonsKey) = Object $
KM.insert "lessons" newLessonField keymap
where
newLessonField = Array . V.fromList
$ fmap makeNewLessonField vecOfLessonsKey
makeNewLessonField (Object lesson, number) = Object $ KM.insert "position" (Number $ fromIntegral number) lesson
hiYosef :: Value -> Value -- Get the joke? Well, it wasn't funny anyways.
hiYosef = partsOf (values . atKey "position") .~ numbering
>>> V.fromList . toListOf values
>>> V.groupBy (\_ b -> not . fromMaybe False $ b ^? key "reset_lesson_position" . _Bool)
>>> fmap (partsOf (traversed . key "lessons" . values . atKey "position") .~ numbering)
>>> Array . V.concat
where
numbering = Just . Number . fromIntegral <$> [1..]
The ultimate lens version is still disappointing, is there a way to get lens to respect the bool during a traversal? That could easily save on a ton of code here…
If you program with cartesian closed categories in mind, then it’s functional.
If you rely on separation logic, then it is imperative.
Easy! 
Can you say something about separation logic and how it connects to the intuitive understanding of “imperative”?
What does
program with cartesian closed categories in mind
(emphasis added by me) even mean? 
Also why does for FP is enough to have CCC in mind but for imperative programming you have to rely on separation logic?
That seems of fairly marginal utility compared to -XRecordWildCards.
Because Hask isn’t a true category and you’d get ridiculed for talking about it like that 
There’s a thread about that
/jk
My questions were more of provocative nature you can program in any paradigm with separation logic or CCC in mind and that doesn’t make it any different 