module Language.Drasil.Code.Imperative.Helpers (
  liftS, lookupC, convScope
) where

import Language.Drasil (UID, QuantityDict)
import Database.Drasil (symbResolve)
import Language.Drasil.Code.Imperative.DrasilState (DrasilState(..),
  ScopeType(..))
import Language.Drasil.CodeSpec (HasOldCodeSpec(..))
import Drasil.GOOL (SharedProg, ScopeSym(..))

import Control.Monad.State (State)
import Control.Lens ((^.))

-- | Puts a state-dependent value into a singleton list.
liftS :: State a b -> State a [b]
liftS :: forall a b. State a b -> State a [b]
liftS = (b -> [b]) -> StateT a Identity b -> StateT a Identity [b]
forall a b. (a -> b) -> StateT a Identity a -> StateT a Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [])

-- | Gets the 'QuantityDict' corresponding to a 'UID'.
lookupC :: DrasilState -> UID -> QuantityDict
lookupC :: DrasilState -> UID -> QuantityDict
lookupC DrasilState
g = ChunkDB -> UID -> QuantityDict
symbResolve (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec -> Getting ChunkDB CodeSpec ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB CodeSpec ChunkDB
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' CodeSpec ChunkDB
sysinfodbO)

-- | Converts a 'ScopeType' to a 'Scope'
convScope :: (SharedProg r) => ScopeType -> r (Scope r)
convScope :: forall (r :: * -> *). SharedProg r => ScopeType -> r (Scope r)
convScope ScopeType
Local  = r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local
convScope ScopeType
Global = r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
global
convScope ScopeType
MainFn = r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
mainFn