{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

module Graphics.Implicit.ExtOpenScad.Util.StateC (addMessage, getVarLookup, modifyVarLookup, lookupVar, pushVals, getVals, putVals, withPathShiftedBy, getPath, getRelPath, errorC, warnC, scadOptions) where

import Prelude(FilePath, Maybe, ($), (<>), pure)

import Graphics.Implicit.ExtOpenScad.Definitions(VarLookup(VarLookup), OVal, Symbol, SourcePosition, Message(Message), MessageType(Error, Warning), ScadOpts, StateC, CompState(scadVars, oVals, sourceDir, messages, scadOpts))

import Data.Map (lookup)

import Data.Text.Lazy (Text)

import Control.Monad.State (modify, gets)

import System.FilePath((</>))

getVarLookup :: StateC VarLookup
getVarLookup :: StateC VarLookup
getVarLookup = (CompState -> VarLookup) -> StateC VarLookup
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompState -> VarLookup
scadVars

modifyVarLookup :: (VarLookup -> VarLookup) -> StateC ()
modifyVarLookup :: (VarLookup -> VarLookup) -> StateC ()
modifyVarLookup VarLookup -> VarLookup
f = (CompState -> CompState) -> StateC ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompState -> CompState) -> StateC ())
-> (CompState -> CompState) -> StateC ()
forall a b. (a -> b) -> a -> b
$ \CompState
c -> CompState
c { scadVars :: VarLookup
scadVars = VarLookup -> VarLookup
f (VarLookup -> VarLookup) -> VarLookup -> VarLookup
forall a b. (a -> b) -> a -> b
$ CompState -> VarLookup
scadVars CompState
c }

-- | Perform a variable lookup
--   FIXME: generate a warning when we look up a variable that is not present.
lookupVar :: Symbol -> StateC (Maybe OVal)
lookupVar :: Symbol -> StateC (Maybe OVal)
lookupVar Symbol
name = do
    (VarLookup Map Symbol OVal
varlookup) <- StateC VarLookup
getVarLookup
    Maybe OVal -> StateC (Maybe OVal)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OVal -> StateC (Maybe OVal))
-> Maybe OVal -> StateC (Maybe OVal)
forall a b. (a -> b) -> a -> b
$ Symbol -> Map Symbol OVal -> Maybe OVal
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Symbol
name Map Symbol OVal
varlookup

pushVals :: [OVal] -> StateC ()
pushVals :: [OVal] -> StateC ()
pushVals [OVal]
vals = (CompState -> CompState) -> StateC ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompState -> CompState) -> StateC ())
-> (CompState -> CompState) -> StateC ()
forall a b. (a -> b) -> a -> b
$ \CompState
c -> CompState
c { oVals :: [OVal]
oVals = [OVal]
vals [OVal] -> [OVal] -> [OVal]
forall a. Semigroup a => a -> a -> a
<> CompState -> [OVal]
oVals CompState
c }

getVals :: StateC [OVal]
getVals :: StateC [OVal]
getVals = (CompState -> [OVal]) -> StateC [OVal]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompState -> [OVal]
oVals

putVals :: [OVal] -> StateC ()
putVals :: [OVal] -> StateC ()
putVals [OVal]
vals = (CompState -> CompState) -> StateC ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompState -> CompState) -> StateC ())
-> (CompState -> CompState) -> StateC ()
forall a b. (a -> b) -> a -> b
$ \CompState
c -> CompState
c { oVals :: [OVal]
oVals = [OVal]
vals }

withPathShiftedBy :: FilePath -> StateC a -> StateC a
withPathShiftedBy :: FilePath -> StateC a -> StateC a
withPathShiftedBy FilePath
pathShift StateC a
s = do
  FilePath
path <- StateC FilePath
getPath
  (CompState -> CompState) -> StateC ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompState -> CompState) -> StateC ())
-> (CompState -> CompState) -> StateC ()
forall a b. (a -> b) -> a -> b
$ \CompState
c -> CompState
c { sourceDir :: FilePath
sourceDir = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
pathShift }
  a
x <- StateC a
s
  (CompState -> CompState) -> StateC ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompState -> CompState) -> StateC ())
-> (CompState -> CompState) -> StateC ()
forall a b. (a -> b) -> a -> b
$ \CompState
c -> CompState
c { sourceDir :: FilePath
sourceDir = FilePath
path }
  a -> StateC a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Pure the path stored in the state.
getPath :: StateC FilePath
getPath :: StateC FilePath
getPath = (CompState -> FilePath) -> StateC FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompState -> FilePath
sourceDir

getRelPath :: FilePath -> StateC FilePath
getRelPath :: FilePath -> StateC FilePath
getRelPath FilePath
relPath = do
    FilePath
path <- StateC FilePath
getPath
    FilePath -> StateC FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> StateC FilePath) -> FilePath -> StateC FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
relPath

addMesg :: Message -> StateC ()
addMesg :: Message -> StateC ()
addMesg Message
m = (CompState -> CompState) -> StateC ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompState -> CompState) -> StateC ())
-> (CompState -> CompState) -> StateC ()
forall a b. (a -> b) -> a -> b
$ \CompState
c -> CompState
c { messages :: [Message]
messages = CompState -> [Message]
messages CompState
c [Message] -> [Message] -> [Message]
forall a. Semigroup a => a -> a -> a
<> Message -> [Message]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message
m }

addMessage :: MessageType -> SourcePosition -> Text -> StateC ()
addMessage :: MessageType -> SourcePosition -> Text -> StateC ()
addMessage MessageType
mtype SourcePosition
pos Text
text = Message -> StateC ()
addMesg (Message -> StateC ()) -> Message -> StateC ()
forall a b. (a -> b) -> a -> b
$ MessageType -> SourcePosition -> Text -> Message
Message MessageType
mtype SourcePosition
pos Text
text

errorC :: SourcePosition -> Text -> StateC ()
errorC :: SourcePosition -> Text -> StateC ()
errorC = MessageType -> SourcePosition -> Text -> StateC ()
addMessage MessageType
Error
{-# INLINABLE errorC #-}

warnC :: SourcePosition -> Text -> StateC ()
warnC :: SourcePosition -> Text -> StateC ()
warnC = MessageType -> SourcePosition -> Text -> StateC ()
addMessage MessageType
Warning
{-# INLINABLE warnC #-}

scadOptions :: StateC ScadOpts
scadOptions :: StateC ScadOpts
scadOptions = (CompState -> ScadOpts) -> StateC ScadOpts
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompState -> ScadOpts
scadOpts