Editor.hs

{-# language
    TemplateHaskell
  , Rank2Types
  , ExistentialQuantification
  , ScopedTypeVariables
  , OverloadedStrings
  #-}

module Rasa.Internal.Editor
  (
  -- * Accessing/Storing state
  Editor
  , HasEditor(..)
  , buffers
  , exiting
  , ext
  , bufExt
  , nextBufId
  , BufRef(..)
  ) where

import Rasa.Internal.Buffer
import Rasa.Internal.Extensions

import Unsafe.Coerce
import Data.Dynamic
import Data.Default
import Data.Maybe
import Data.IntMap
import Control.Lens

-- | An opaque reference to a buffer (The contained Int is not meant to be
-- altered). It is possible for references to become stale if buffers are
-- deleted. Operations over invalid BufRef's are simply ignored and return
-- 'Nothing' if a value was expected.
newtype BufRef =
  BufRef Int
  deriving (Show, Eq, Ord)

-- | This is the primary state of the editor.
data Editor = Editor
  { _buffers' :: IntMap Buffer
  , _exiting' :: Bool
  , _extState' :: ExtMap
  , _nextBufId' :: Int
  }
makeLenses ''Editor

instance Show Editor where
  show ed =
    "Buffers==============\n" ++ show (ed^.buffers) ++ "\n\n"
    ++ "Editor Extensions==============\n" ++ show (ed^.extState) ++ "\n\n"
    ++ "---\n\n"

-- | This allows polymorphic lenses over anything that has access to an Editor context
class HasEditor a where
  editor :: Lens' a Editor

-- | A lens over the map of available buffers
buffers :: HasEditor e => Lens' e (IntMap Buffer)
buffers = editor.buffers'

-- | A lens over the exiting status of the editor
exiting :: HasEditor e => Lens' e Bool
exiting = editor.exiting'

-- | A lens over the extension state of 'Editor' level extensions
extState :: HasEditor e => Lens' e ExtMap
extState = editor.extState'

-- | A lens over the next buffer id to be allocated
nextBufId :: HasEditor e => Lens' e Int
nextBufId = editor.nextBufId'

instance HasEditor Editor where
  editor = lens id (flip const)

instance Default Editor where
  def =
    Editor
    { _extState'=def
    , _buffers'=empty
    , _exiting'=False
    , _nextBufId'=0
    }

-- | 'ext' is a lens which will focus the extension state that matches the type
-- inferred as the focal point. It's a little bit of magic, if you treat the
-- focus as a member of your extension state it should just work out.
--
-- This lens falls back on the extension's 'Data.Default.Default' instance (when getting) if
-- nothing has yet been stored.

ext
  :: forall a e.
    (Show a, Typeable a, Default a, HasEditor e)
  => Lens' e a
ext = lens getter setter
  where
    getter ed =
      fromMaybe def $ ed ^. extState . at (typeRep (Proxy :: Proxy a)) .
      mapping coerce
    setter ed new =
      set
        (extState . at (typeRep (Proxy :: Proxy a)) . mapping coerce)
        (Just new)
        ed
    coerce = iso (\(Ext x) -> unsafeCoerce x) Ext