Collect.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}

module Language.EO.Phi.Metrics.Collect where

import Control.Lens ((+=))
import Control.Monad (forM_)
import Control.Monad.State (State, execState)
import Data.Aeson (FromJSON)
import Data.Generics.Labels ()
import GHC.Generics (Generic)
import Language.EO.Phi.Rules.Common ()
import Language.EO.Phi.Syntax.Abs

data Metrics = Metrics
  { dataless :: Int
  , applications :: Int
  , formations :: Int
  , dispatches :: Int
  }
  deriving (Generic, Show, FromJSON, Eq)

defaultMetrics :: Metrics
defaultMetrics =
  Metrics
    { dataless = 0
    , applications = 0
    , formations = 0
    , dispatches = 0
    }

collectMetrics :: (Inspectable a) => a -> Metrics
collectMetrics a = execState (inspect a) defaultMetrics

class Inspectable a where
  inspect :: a -> State Metrics ()

instance Inspectable Program where
  inspect (Program binding) = forM_ binding inspect

instance Inspectable Binding where
  inspect = \case
    AlphaBinding attr obj -> do
      inspect attr
      inspect obj
    EmptyBinding attr -> do
      #dataless += 1
      inspect attr
    DeltaBinding _ -> pure ()
    LambdaBinding _ -> #dataless += 1
    MetaBindings _ -> pure ()

instance Inspectable Attribute where
  inspect = \case
    Phi -> pure ()
    Rho -> pure ()
    Sigma -> pure ()
    VTX -> pure ()
    Label _ -> pure ()
    Alpha _ -> pure ()
    MetaAttr _ -> pure ()

instance Inspectable Object where
  inspect = \case
    Formation bindings -> do
      #formations += 1
      forM_ bindings inspect
    Application obj bindings -> do
      #applications += 1
      inspect obj
      forM_ bindings inspect
    ObjectDispatch obj attr -> do
      #dispatches += 1
      inspect obj
      inspect attr
    GlobalObject -> pure ()
    ThisObject -> pure ()
    Termination -> pure ()
    MetaObject _ -> pure ()
    MetaFunction _ _ -> pure ()