Testing Indexed State Monads

IndexedStateMonad.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Core.Core.PriceCalculation.Class where

import Control.Monad.Indexed ((>>>=))
import Control.Monad.Indexed.State (IxMonadState (iput), IxState (..), imodify)
import GHC.TypeLits (Symbol)
import Models.Core.CSV.SheetNames (SheetNames (NANS, NBRA))
import Prelude hiding (empty, (<<<), (>>>))

data EndState (xs :: [k]) = EndState

data AddBaseAmount

data PricesCalculated = PricesCalculated

data Resources (xs :: [k])

data Foo = Bar | Baz

type family (xs :: [Type]) ++ (ys :: [Type]) :: [Type] where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)

type family AddElementToEnd (x :: Type) (xs :: [Type]) :: [Type] where
  AddElementToEnd x '[] = x ': '[]
  AddElementToEnd x (x' ': xs) = x' ': xs ++ (AddElementToEnd x '[])

class PriceCalculation (c :: k) (v :: Symbol) where
  type LoadResources c v
  type StateSpecification c v

  empty :: IxState x (EndState '[]) ()

  loadResources :: IxState (EndState l) (EndState (AddElementToEnd (LoadResources c v) l)) ()

  addBaseAmount :: IxState (EndState l) (EndState (AddElementToEnd AddBaseAmount l)) ()

  calculate :: IxState (StateSpecification c v) (PricesCalculated) ()

  done :: IxState (StateSpecification c v) (PricesCalculated) ()

instance PriceCalculation 'Bar "V1" where
  type LoadResources 'Bar "V1" = Resources '[ 'NBRA, 'NANS]
  type
    StateSpecification 'Bar "V1" =
      EndState
        [ LoadResources 'Bar "V1"
        , AddBaseAmount
        ]
  empty = iput EndState
  loadResources = iput EndState
  addBaseAmount = iput EndState
  calculate = imodify calculate'
   where
    calculate' = const PricesCalculated

  done :: IxState (StateSpecification 'Bar "V1") (PricesCalculated) ()
  done = empty @_ @'Bar @"V1" >>> loadResources @_ @'Bar @"V1" >>> addBaseAmount @_ @'Bar @"V1" >>> calculate @_ @'Bar @"V1"

x >>> y = x >>>= const y