content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE DeriveGeneric #-}
  module Data.Label where
  
  import Data.Hashable
  import Data.Order
  import Data.Abstract.FreeCompletion
  import Control.Monad.State
  import Control.DeepSeq
  import Text.Printf
  import Prettyprinter
  
  import Data.Aeson (FromJSON, ToJSON)
  import GHC.Generics
  
  -- Retrieves label from expression.
  class HasLabel x where
    label :: x -> Label
  
  newtype Label = Label { labelVal :: Int }
    deriving (Ord,Eq,Hashable,Num,NFData,Generic,ToJSON,FromJSON)
  
  instance Show Label where
    show (Label l) = printf "#%d" l
  
  instance Pretty Label where
    pretty (Label l) = "#" <> pretty l
  
  instance Enum Label where
    toEnum = Label
    fromEnum = labelVal
  
  instance PreOrd Label where
    (⊑) = (==)
  
  instance Complete (FreeCompletion Label) where
    Lower l1 ⊔ Lower l2 | l1 == l2 = Lower l1
    _ ⊔ _ = Top
  
  instance UpperBounded (FreeCompletion Label) where
    top = Top
  
  fresh :: MonadState Label m => m Label
  fresh = state (\l -> (l,l+1))
  
  generate :: State Label x -> x
  generate = generateFrom 0
  
  generateState :: State Label x -> (x, Label)
  generateState = generateStateFrom 0
  
  generateFrom :: Label -> State Label x -> x
  generateFrom i m = evalState m i
  
  generateStateFrom :: Label -> State Label x -> (x, Label)
  generateStateFrom i m = runState m i
  
  generate' :: Monad m => StateT Label m x -> m x
  generate' = generateFrom' 0
  
  generateState' :: StateT Label m x -> m (x, Label)
  generateState' = generateStateFrom' 0
  
  generateFrom' :: Monad m => Label -> StateT Label m x -> m x
  generateFrom' i m = evalStateT m i
  
  generateStateFrom' :: Label -> StateT Label m x -> m (x, Label)
  generateStateFrom' i m = runStateT m i
  