Beautiful functional programming

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