lens fiddling

foo.hs

{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
import           Control.Applicative
import           Control.Lens
import           Control.Lens.Prism
import           Control.Monad
import           Data.Aeson
import           Data.Aeson.Types
import qualified Data.ByteString.Lazy as B
import qualified Data.Map             as Map
import           Data.Map.Lens
import           Data.String.QQ
import           Data.Text            (Text)
import           GHC.Generics

document :: B.ByteString
document = [s|{
 "food":  { "spock":     { "values": { "coffee":  5, "beer":  2, "pizza":  3 }, "total":  10 },
            "kirk":      { "values": { "coffee":  2, "beer":  3, "pizza":  4 }, "total":   9 } },
 "logic": { "starfleet": { "values": { "spock": 100, "kirk": 20, "bones": 50 }, "total": 170 } }
}|]

customOptions :: Options
customOptions = (defaultOptions { fieldLabelModifier = drop 1 })

data Node = Node { _values :: Map.Map Text Int
                 , _total  :: Int } deriving (Show, Generic)
type Nested = Map.Map Text (Map.Map Text Node)

instance FromJSON Node where
  parseJSON = genericParseJSON customOptions

makeLenses ''Node

data Stats = Stats { coffee     :: Int -- food/<person>/values/coffee,group=food
                   , pizza      :: Int -- food/<person>/values/pizza,group=food
                   , otherFood  :: Int -- food/<person>/total,group=food = food.<person>.total - Stats.coffee - Stats.pizza
                   , logic      :: Int -- logic/starfleet/values/<person>,group=logic
                   , otherLogic :: Int -- logic/starfleet/total,group=logic = logic.starfleet.total - Stats.logic
                   } deriving (Show)


-- https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/a-little-lens-starter-tutorial

-- ideal goal:
-- extractor = makeExtractor [[coffee, "food", person, "coffee"] looks for food/<person>/values/coffee
--                           ,[pizza,  "food", person, "pizza"] ...
--                           ,[logic,  "logic", "starfleet", person]] looks for logic/starfleet/values/<person>
--                           [[otherFood, "food", person, [coffee, pizza]] looks for food/<person>/total and subtracts coffee and pizza within context
--                           ,[otherLogic, "logic", "starfleet", [logic]]] looks for logic/starfleet/total and subtracts logic within context
-- extractor nested ["kirk", "spock", "bones"]
--   returns: {"kirk": Stats {...}, "spock": Stats {...}, "bones": Stats {...}
--
-- Where each path is only visited once, so bring along map{person=>Stats}
-- or equivalent out to the leaves and set their values on each match.. so
-- a coffee settter lens thingie etc.
-- And the second argument, the total fixupers, should get getter lenses for
-- the fields they are intertwined with, to fixup the total minus the fields.

-- Crude but functional extractor... ^?! is bad too, should continue to surf on
-- maybes and fallback to 0 if not found.
extractStats :: Text -> Nested -> Stats
extractStats name nested = Stats coffee pizza otherFood logic otherLogic
  where coffee = nested ^?! ix "food" . ix name . values . ix "coffee"
        pizza = nested ^?! ix "food" . ix name . values . ix "pizza"
        foodTotal = nested ^?! ix "food" . ix name . total
        otherFood = foodTotal - coffee - pizza
        logic = nested ^?! ix "logic" . ix "starfleet" . values . ix name
        logicTotal = nested ^?! ix "logic" . ix "starfleet" . total
        otherLogic = logicTotal - logic

main :: IO ()
main = do
  let nested = eitherDecode document :: Either String Nested
  print nested
  stats <- pure $ liftA fmap extractStats "kirk" nested -- sane construct? looks weird
  print stats