Beautiful Functional Programming

UpdateSection.hs

module Fun where
import Data.List(groupBy)

data Lesson c = Lesson
  { name :: String,
    lposition :: c
  }
  deriving (Show)

data Section c = Section
  { title :: String,
    resetLessonPosition :: Bool,
    lessons :: [Lesson c],
    sposition :: c
  }
  deriving (Show)

sections :: [Section ()]
sections =
  [ Section
      { title = "Getting started",
        resetLessonPosition = False,
        lessons =
          [ Lesson {name = "Welcome", lposition = ()},
            Lesson {name = "Installation", lposition = ()}
          ],
        sposition = ()
      },
    Section
      { title = "Basic operator",
        resetLessonPosition = False,
        lessons =
          [ Lesson {name = "Addition / Subtraction", lposition = ()},
            Lesson {name = "Multiplication / Division", lposition = ()}
          ],
        sposition = ()
      },
    Section
      { title = "Advanced topics",
        resetLessonPosition = True,
        lessons =
          [ Lesson {name = "Mutability", lposition = ()},
            Lesson {name = "Immutability", lposition = ()}
          ],
        sposition = ()
      }
  ]
  
-- | 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)
    
lessonPosititions :: [Section a] -> [[Int]]
lessonPosititions sections = 
  concatMap (flip reStructure [1..] . map lessons)  $ breakOn resetLessonPosition sections
  
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
                              }
          )
main :: IO ()
main = do
  mapM_ print $ updatePositions sections (zip [1..] $ lessonPosititions sections)