Beautiful functional programming

#48

I feel like this is a good candidate for runST

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Monad (when)
import Control.Monad.ST
import Data.Aeson
import Data.STRef
import Data.Traversable (for)

newtype SectionList = SectionList [Section]

data Section = Section
    { title :: String
    , reset_lesson_position :: Bool
    , lessons :: [Lesson]
    }

instance ToJSON SectionList where
    toJSON (SectionList xs) = toJSON $ runST $ do
        lessonPos <- newSTRef 1

        for (zip [1 :: Int ..] xs) $ \(sectionPos, Section{..}) -> do
            when reset_lesson_position $ writeSTRef lessonPos 1

            lessons <- for lessons $ \Lesson{..} -> do
                pos <- readSTRef lessonPos
                modifySTRef lessonPos (+ 1)
                pure $ object ["name" .= name, "position" .= Number (fromIntegral pos)]

            pure $
                object
                    [ "title" .= title
                    , "reset_lesson_position" .= reset_lesson_position
                    , "lessons" .= toJSON lessons
                    , "position" .= Number (fromIntegral sectionPos)
                    ]

newtype Lesson = Lesson {name :: String}

sections :: SectionList
sections =
    SectionList
        [ Section
            { title = "Getting started"
            , reset_lesson_position = False
            , lessons =
                [ Lesson{name = "Welcome"}
                , Lesson{name = "Installation"}
                ]
            }
        , Section
            { title = "Basic operator"
            , reset_lesson_position = False
            , lessons =
                [ Lesson{name = "Addition / Subtraction"}
                , Lesson{name = "Multiplication / Division"}
                ]
            }
        , Section
            { title = "Advanced topics"
            , reset_lesson_position = True
            , lessons =
                [ Lesson{name = "Mutability"}
                , Lesson{name = "Immutability"}
                ]
            }
        ]

main :: IO ()
main = print $ encode sections

-- $> main

EDIT: While structurally not as “pretty” as the python code, I feel like it gets close in spirit.

2 Likes
#49

Thank you very much @josevalim for introducing this problem and for taking the time to join us in this thread, that’s very generous of you!

I am also interested in learning how to ease the migration from imperative to functional. The Python solution appears more accessible than the FP variants, but perhaps we could demonstrate that it is not so simple. In this example, I find it surprising that the lesson_counter assignment in the if scope override the parent scopes. This becomes even more surprising when this happens inside a function scope, see: Why am I getting an UnboundLocalError when the variable has a value?. Taking these scoping rules into consideration, then I am not so sure that the Python solution is really more accessible.

7 Likes
#50

TBH, when you have SPJ forwarding something by Jose Valim, you’re likely to get a very interesting and informative thread.

This thread brings 5 things to mind:

  • For schemes (Haskell recursion schemes applied to for loops)
  • Insufficient power of optics / zip?
  • Haskell foldr is literally just an implementation of for (re: Probie)
  • Labeled gotos might still be a good idea / Walrus operators in Haskell
  • Benchmarking against Python via “Impractical Python Programs” and “Big Book of Small Python Projects”

For Schemes

Recursion is equivalent in power to while, and higher-order functions can be seen as replacements for for-loops. The advantage of higher-order functions, or specialized syntax resembling for-loops, over for is roughly the same as the advantage of for, while, and function calls over the traditional goto. Goto is simply too powerful, and is not expressive enough to indicate the intent of its use. Likewise, for can be seen similarily as too powerful (Go, for instance, lacks while, and implements all looping via for), and more specialized higher-order functions (or extensions to the for expression syntax, in Elixir) might be a better way to do it; i.e, the specialized higher-order functions represent specific uses of for and convey intent better.

This implies For Schemes, as an analogue to Haskell’s recursion schemes, i.e, a way to taxonomize and analyze things people do with for. For functional languages, this is particularly useful in the sense that if someone coming in from an imperative language wants to reach for a for loop, there’s an existing functional alternative that achieves the same result. For imperative and more traditional languages, as long as there’s compiler / interpreter support, you get the effects of being more specific than a for loop without sacrificing performance, as with Javascript array methods.

Ideally, we should be able to get “for loop considered harmful” in the same way “goto is considered harmful”.

Insufficient power of optics / zip

I’m not sure if this has been done already, whether it’s possible, but if you go from the idea that “higher-order functions are a better replacement for for”, and we can’t do this easily with optics and zip (but can with mapAccumL in Haskell / map_reduce() in Elixir), it implies that we are missing a specialized higher-order function for this task.

If I understand correctly, this particular problem resulted in the addition of let to for expressions in Elixir (Introducing `for let` and `for reduce` - Official Proposals - Elixir Programming Language Forum ), presumably over map_reduce(). Likewise, if existing features in optics and the zip function is insufficient, it implies that we might need new functions to automate this simply.

Haskell foldr is just an implementation of for (Probie)

I guess this is old hat, but it should be emphasized more that everything anyone can do with for, anyone can do with Haskell foldr (although not necessarily foldl’ / reduce). reduce holds an accumulator, i.e, implicit state, updates the state, but cannot short-circuit, as lazy-right folds can. foldr is powerful enough to store state in an external accumulator, build a continuation pattern from the original data structure, then implement any recursive pattern necessary (i.e, map, mapAccumL, filter, foldl’, traverse, etc).

Labeled gotos might still be a good idea. / Walrus operators in Haskell

Here’s a certain declarative programming problem in Haskell. A certain declarative style in Haskell completely eschews the use of lambdas, considering them insufficiently declarative, and relegating them to where clauses. I.e, you end up with named blocks in Haskell; what you’d do in another language with a block, such as a loop, you name instead and render a function, hopefully making the code clearer.

However, if you compare it to the Python, this can actually make the code less clear, because in Python, you have immediate access to the block for viewing, whereas you’d have to scan to the where clause or let declaration in Haskell.

In Haskell, a potential solution might be an equivalent to a Walrus operator, i.e, -XLetLambda / -XLetWalrus, to provide immediate use after declare.

Right now, if we want to do this, we’d have to do let foo arg = arg in foo, which can be unnecessarily verbose. A solution might be a language extension to the syntax allowing foo\arg -> arg syntax, i.e, the lambda is immediately used after declaration. We can also extend this to foo\->3 syntax for variable declarations.

Conversely, for more traditional languages, you might wish for a hoisting macro, i.e, a block of code has the macro applied, and it is now hoisted to top level, providing a name for the block, as well as optionally allowing reuse by creating a function that takes arguments filling in out-of-scoped names.

Benchmarking against Python

Lastly, I think Haskell losing to Python in expressiveness is pretty bad, because if you check out Hutton’s “Programming in Haskell”, he makes the claim that Haskell can be 2-10 times shorter than C, whereas Python claims to be 2-5 times shorter than C. When you look at functional Python, the gap obviously narrows tremendously, but Python doesn’t support functional programming well at the implementation level, and Haskell’s syntax is optimized for functional programming.

But benchmarking against Python is useful, since Python is considered the gold standard as a combination of readability and expressiveness, and moreover, Python is pretty good when it comes to its overall ecosystem.

There are a few open Python books introducing a bunch of newbie projects, say: Impractical Python Projects ( GitHub - rlvaugh/Impractical_Python_Projects: Code & supporting files for chapters in book ) and The Big Book of Small Python Projects ( GitHub - asweigart/the-big-book-of-small-python-projects: The source code for the programs in "The Big Book of Small Python Projects" ). I’ve ported one from the latter myself ( New, Average, and Pragmatic: Translation of Vigenere Cipher from "The Big Book of Small Python Projects" into Haskell ), but the Python books present an opportunity to benchmark the ecosystem maturity in your own language, the expressiveness and maintainability of the language, and present a possible Rosetta stone for newbies to grasp and hang on to.

Projects where you end up being significantly more verbose than normal can present possible pain points that need to be resolved, and projects where there are no good corresponding libraries in your own language might highlight points for improvement.

4 Likes
#51

I agree. The Python solution looks accessible because it hides all of the mechanics of how state is passed around and in functional programming we prefer those mechanics to be explicit, for very valid reasons (which may make our code seem noisier to others?).

And thank you for sharing your article. I particularly enjoyed your choice of using different data types for the input and output to solve this problem, which I believe helps outline the functions are transforming the data (rather than mutating in place as in Python).

This is a very interesting thought and I wonder if a new operation would help. People with functional programming experience look at the problem and say “oh, that’s a mapAccumL”. The issue is that those new to functional programming won’t necessarily see/know that. So we would need to consider if/how someone new would also know the new operation.

Perhaps the answer is that this is an education issue and mastering many of the higher-order functions are part of the job, so learn them! But even this conclusion branches into your next topic: you could also use foldr to solve the problem and use it as a general replacement for several uses of for. Should we promote one over the other? Yes/no? When/why?

Those proposals were not accepted because the community did not agree on them. However, could this also be a possible exploration point for Haskell? What if Haskell comprehensions also allowed you to pass an accumulator between iterations, effectively becoming some sort of flatMapAccumL? How would that look like? Would that help? At least, that’s what I tried to address in that Elixir branch but did not succeed. :slight_smile:

2 Likes
#52

This is a very interesting thought and I wonder if a new operation would help. People with functional programming experience look at the problem and say “oh, that’s a mapAccumL”. The issue is that those new to functional programming won’t necessarily see/know that. So we would need to consider if/how someone new would also know the new operation.

Perhaps the answer is that this is an education issue and mastering many of the higher-order functions are part of the job, so learn them! But even this conclusion branches into your next topic: you could also use foldr to solve the problem and use it as a general replacement for several uses of for. Should we promote one over the other? Yes/no? When/why?

The interesting thing about Haskell is that it’s not that different from Elixir, but whereas Elixir is interpreted to BEAM or Erlang, Haskell is translated to Haskell Core on the first of a few IRs.

A Prelude or base library can actually be considered a sort of language on its own; you can use -XNoImplicitPrelude to disable everything and not even expose the primitives (not without imports or -XMagicHash), so much of what is the responsibility of a language designer or implementer elsewhere can be done in userland.

So we don’t need a full operation, just a library somewhere that ends up being used, or a proposal to CLC to add the function to base, whereas poor Javascripters can try to be functional all they want, but end up blowing themselves up with atrocious performance.

As for for and foldr, well, I’m told that like Haskell, Elixir also has mutable overrides based on BEAM and the message passing model? The point is, while they’re there, they’re supposed to be emergency options. STRef actually optimizes worse than accumulating parameter (3 times slower in my benchmarks over naive factorial) and use of State.Strict monad (which is a convenient interface abstracting accumulating parameter) + modify’.
Data.List.foldr, likewise, can space leak. It’s there if you need it, it’s more idiomatic than abusing STRef / IORef / other mutables. And, imo, it’s less ergonomic than for; to get it to store state, you have to get it to convert the data structure to a continuation, then apply it to an outside value.

And that’s what I think about for / foldr; it’s not preferred, but if you can’t think of another way to do it, it’s there for you.

I think the big problem here is that we need For Schemes, i.e, to understand what users are doing with for-loops, then figuring out how to solve their problems with syntax for comprehensions in Elixir and higher-order functions in Haskell.

Many people just point me to traverse / for in Data.Traversable, but you still have the goto problem; we are just using overrides willy-nilly, without understanding the reason for using the overrides and finding a better way to avoid using the override.

1 Like
#53

I must say I’m a bit surprised by the direction of this discussion. There are a few things that confuse me. Firstly, people seem to have a clear idea of a delineation between functional code and imperative code. What is it? I don’t know! It’s not clear to me that those two concepts are disjoint. Secondly, people seem to have the idea that imperative code is somehow “worse” than functional code. Why? I don’t know! To me Haskell is the world’s finest imperative programming language. I have no qualms about programming imperatively (only about programming with unrestrained effects). Thirdly, people seem to believe that Haskell can’t express the same ideas as the nice Python code. It can! Look below; it’s almost a direct translation of of the Python into the Haskell.

There are a couple of caveats in the translation. Firstly, the Haskell data structure is immutable, meaning that we have to explicitly replace the old one with the new one. That adds a couple of lines. Secondly, Haskell is pure, meaning that we have to get the counter in a separate step from using the lesson counter. That adds another couple of lines.

Often, writing in Haskell the same code that you would have written in Python is the right thing to do! I wish Haskellers would do so more.

sections' :: [Section Int]
sections' = flip evalState initialCounter $ do
  for sections $ \section -> do
    when (resetLessonPosition section) $
      lessonCounter .= 1

    lessons' <- for (lessons section) $ \lesson -> do
      lessonCounter' <- use lessonCounter
      let lesson' = lesson {lposition = lessonCounter'}
      lessonCounter %= (+ 1)
      pure lesson'

    sectionCounter' <- use sectionCounter
    let section' = section {sposition = sectionCounter', lessons = lessons'}
    sectionCounter %= (+ 1)

    pure section'

Full code: Solution to https://discourse.haskell.org/t/beautiful-functional-programming/7411 · GitHub

11 Likes
Why imperative code is worse than functional code
Monadic Code In Haskell
Mutable Value Semantics Trend vs Immutability
Break with traverse / traverse_?
#54

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' }
2 Likes
#55

How about doing it without using any accumulator at all? :slight_smile:
No folds, just map, filter and zip.

4 Likes
#56 
{-# 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?

@tomjaguarpaw:

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.

1 Like
#57

I like it! Concise and readable.

#58

I think your implementation is my favourite one so far.

#59

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 :slight_smile:

#60

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.

#61

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

2 Likes
#62

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.

1 Like
#63

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.

1 Like
#64

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
2 Likes
#65

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
1 Like
Why imperative code is worse than functional code
#66

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).

1 Like
#67

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…