Beautiful functional programming

[lazamar]

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.

https://gist.github.com/lazamar/fd9e809d01298e29600d247c02b0889a

[danielc777888]

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

[DrewFenwick]

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

[maxigit]

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

[Liamzy]

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…

[wiz]

If you program with cartesian closed categories in mind, then it’s functional.
If you rely on separation logic, then it is imperative.
Easy!

[tomjaguarpaw]

Can you say something about separation logic and how it connects to the intuitive understanding of “imperative”?

[bolt12]

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?

[george.fst]

That seems of fairly marginal utility compared to -XRecordWildCards.

[wiz]

@bolt12

(emphasis added by me) even mean?

Because Hask isn’t a true category and you’d get ridiculed for talking about it like that

@bolt12

Also why does for FP is enough to have CCC in mind but for imperative programming you have to rely on separation logic?

There’s a thread about that

Why imperative code is worse than functional code

Continuing the discussion from Beautiful functional programming: @tomjaguarpaw asks the question why people think imperative code is worse than functional code. I think that is an interesting discussion topic. First of all, I personally wouldn’t really say functional, but instead denotative. My inspiration for striving for denotative code comes from the podcast and ZuriHac presentation of @conal. He can explain it much better than me in a short discourse post: [Conal Elliott on "…

/jk

[bolt12]

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