theta/src/DeviceConfig/Ltp.hs

{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuasiQuotes                #-}

module DeviceConfig.Ltp
  (
    ReplaceSide(..)
  , TrafficModel(..)
  , ProfileCrossConnect(..)
  , makeCrossConnect
  , ProfilePorts(..)
  , Service(..)
  , OntConfig(..)
  , Config(..)
  )
  where

import           Control.Monad.State       (StateT)
import           Control.Monad.State.Class
import           Data.Foldable             (forM_)
import qualified Data.Text                 as T
import qualified Data.Text.Lazy            as TL
import           Data.Text.Lazy.Builder
import           Types                     (IpAddress, VlanId, vlanId)

data ReplaceSide = ReplaceSideOnt | ReplaceSideOlt
  deriving (Show, Eq)

data TrafficModel = TrafficModelOneToOne | TrafficModelNToOne
  deriving (Show, Eq)

data ProfileCrossConnect = ProfileCrossConnect
  {
      name         :: T.Text
    , replaceSide  :: ReplaceSide
    , trafficModel :: TrafficModel
    , bridgeGroup  :: Int
    , outerVid     :: VlanId
    , innerVid     :: Maybe VlanId
  } deriving (Show, Eq)

makeCrossConnect :: T.Text -> ProfileCrossConnect
makeCrossConnect n =
  ProfileCrossConnect
  {
    name = n
  , replaceSide = ReplaceSideOnt
  , trafficModel = TrafficModelNToOne
  , bridgeGroup = 0
  , outerVid = [vlanId|1|]
  , innerVid = Nothing
  }

data ProfilePorts = ProfilePorts
  {
    name               :: T.Text
    ,  bridgeGroup     :: Int
  , igmpDynamicEntries :: [()]
  } deriving (Show, Eq)

makeProfilePorts :: T.Text -> ProfilePorts
makeProfilePorts n = ProfilePorts
  {
    name = n
  , bridgeGroup = 0
  , igmpDynamicEntries = []
  }

data Service = Service
  {
    crossConnect :: T.Text
  , dba          :: ()
  } deriving (Show, Eq)

makeService :: T.Text -> Service
makeService ccName = Service
  {
    crossConnect = ccName
  , dba = ()
  }

data OntConfig = OntConfig
  {
      ponPortId    :: Int
    , ontId        :: Int
    , services     :: [Service]
    , profilePorts :: Maybe ProfilePorts
  } deriving (Show, Eq)

data ManagementConfig = ManagementConfig
  {
    managementIp   :: IpAddress
  , managementMask :: IpAddress
  , managementVid  :: VlanId
  } deriving (Show, Eq)

data Config = Config
  {
      management           :: ManagementConfig
    , profilesCrossConnect :: [ProfileCrossConnect]
    , profilesPorts        :: [ProfilePorts]
    , interfaceOnt         :: [OntConfig]
  } deriving (Show, Eq)

data ConfigRenderState = ConfigRenderState
  {
    currentIndent :: Int
  , result        :: Builder
  }

newtype ConfigRenderM m a = ConfigRenderM (StateT ConfigRenderState m a)
  deriving (Functor, Applicative, Monad, MonadState ConfigRenderState)

class ConfigChunk a where
  render :: (Monad m) => a -> ConfigRenderM m ()

instance (ConfigChunk a, Foldable f) => ConfigChunk (f a) where
  render fa = forM_ fa render

instance ConfigChunk ManagementConfig where
  render mgmt = undefined

instance ConfigChunk ProfileCrossConnect where
  render cc = undefined

instance ConfigChunk ProfilePorts where
  render ports = undefined

instance ConfigChunk OntConfig where
  render ont = undefined

instance ConfigChunk Config where
  render cfg = withIndent 2 $ do
    render $ management cfg
    render $ profilesCrossConnect cfg
    render $ profilesPorts cfg
    render $ interfaceOnt cfg

printLine :: (Monad m) => T.Text -> ConfigRenderM m ()
printLine t = do
  indent <- gets currentIndent
  modify' (\s -> s { result = result s
                     <> (fromLazyText . TL.replicate (fromIntegral indent) . TL.singleton) ' '
                     <> (fromLazyText . TL.fromStrict) t
                     <> singleton '\n' })

addBuilder :: (Monad m) => Builder -> ConfigRenderM m ()
addBuilder b = do
  indent <- gets currentIndent
  modify' (\s -> s { result = result s
                     <> (fromLazyText . TL.replicate (fromIntegral indent) . TL.singleton) ' '
                     <> b
                     <> singleton '\n' })

changeIndent :: (Monad m) => Int -> ConfigRenderM m ()
changeIndent i = modify' $ \s -> s { currentIndent = currentIndent s + i }

withIndent :: (Monad m) => Int -> ConfigRenderM m a -> ConfigRenderM m a
withIndent i f = do
  changeIndent i
  r <- f
  changeIndent (-i)
  return r

renderConfig :: Config -> T.Text
renderConfig cfg = undefined
  -- printLine "configure terminal"
  -- render cfg
  -- printLine "exit"
  -- printLine "commit"
  -- printLine "exit"