{-# LANGUAGE TemplateHaskell, TupleSections #-}

module GOOL.Drasil.State (
  -- Types
  GS, GOOLState(..), FS, CS, MS, VS, 
  -- Lenses
  lensFStoGS, lensGStoFS, lensMStoGS, lensFStoCS, lensFStoMS, lensFStoVS, 
  lensCStoMS, lensMStoCS, lensCStoVS, lensMStoFS, lensMStoVS, lensVStoFS, 
  lensVStoMS, lensCStoFS, headers, sources, mainMod, currMain, currFileType, currParameters,
  -- Initial states
  initialState, initialFS, 
  -- State helpers
  modifyReturn, modifyReturnFunc, modifyReturnList, 
  -- State modifiers
  revFiles, addFile, addCombinedHeaderSource, addHeader, addSource, 
  addProgNameToPaths, setMainMod, addLangImport, addLangImportVS, 
  addExceptionImports, getLangImports, addLibImport, addLibImportVS, 
  addLibImports, getLibImports, addModuleImport, addModuleImportVS, 
  getModuleImports, addHeaderLangImport, getHeaderLangImports, 
  addHeaderLibImport, getHeaderLibImports, addHeaderModImport, 
  getHeaderModImports, addDefine, getDefines, addHeaderDefine, 
  getHeaderDefines, addUsing, getUsing, addHeaderUsing, getHeaderUsing, 
  setFileType, setModuleName, getModuleName, setClassName, getClassName, 
  setCurrMain, getCurrMain, addClass, getClasses, updateClassMap, getClassMap, 
  updateMethodExcMap, getMethodExcMap, updateCallMap, callMapTransClosure, 
  updateMEMWithCalls, addParameter, getParameters, setOutputsDeclared, 
  isOutputsDeclared, addException, addExceptions, getExceptions, addCall, 
  setMainDoc, getMainDoc, setScope, getScope, setCurrMainFunc, getCurrMainFunc, 
  setThrowUsed, getThrowUsed, setErrorDefined, getErrorDefined, addIter, 
  getIter, resetIter, incrementLine, incrementWord, getLineIndex, getWordIndex, 
  resetIndices, useVarName, genVarName, genLoopIndex
) where

import GOOL.Drasil.AST (FileType(..), ScopeTag(..), QualifiedName, qualName)
import GOOL.Drasil.CodeAnalysis (Exception, ExceptionType, printExc, hasLoc)
import GOOL.Drasil.CodeType (ClassName)

import Utils.Drasil (nubSort)

import Control.Lens (Lens', (^.), lens, makeLenses, over, set, _1, _2, both, at)
import Control.Monad.State (State, modify, gets)
import Data.Char (isDigit)
import Data.List (nub, delete)
import Data.Maybe (isNothing, fromMaybe)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Tuple (swap)
import Text.PrettyPrint.HughesPJ (Doc, empty)
import Text.Read (readMaybe)

data GOOLState = GS {
  GOOLState -> [String]
_headers :: [FilePath], -- Used by Drasil for doxygen config gen
  GOOLState -> [String]
_sources :: [FilePath], -- Used by Drasil for doxygen config and Makefile gen
  GOOLState -> Maybe String
_mainMod :: Maybe FilePath, -- Used by Drasil generator to access main 
                              -- mod file path (needed in Makefile generation)
  GOOLState -> Map String String
_classMap :: Map String ClassName, -- Used to determine whether an import is 
                                     -- needed when using extClassVar and obj

  -- Only used in Java and Swift, to generate correct "throws Exception" declarations
  GOOLState -> Map QualifiedName [ExceptionType]
_methodExceptionMap :: Map QualifiedName [ExceptionType], -- Method to exceptions thrown
  GOOLState -> Map QualifiedName [QualifiedName]
_callMap :: Map QualifiedName [QualifiedName], -- Method to other methods it calls

  -- Only used for Swift
  GOOLState -> Bool
_throwUsed :: Bool, -- to add code so Strings can be used as Errors
  GOOLState -> Bool
_errorDefined :: Bool -- to avoid duplicating that code
} 
makeLenses ''GOOLState

data FileState = FS {
  FileState -> GOOLState
_goolState :: GOOLState,
  FileState -> String
_currModName :: String, -- Used by fileDoc to insert the module name in the 
                          -- file path, and by CodeInfo/Java when building
                          -- method exception map and call map
  FileState -> FileType
_currFileType :: FileType, -- Used when populating headers and sources in GOOLState
  FileState -> Bool
_currMain :: Bool, -- Used to set mainMod in GOOLState, 
                     -- and in C++ to put documentation for the main 
                     -- module in the source file instead of header
  FileState -> [String]
_currClasses :: [ClassName], -- Used to update classMap
  FileState -> [String]
_langImports :: [String],
  FileState -> [String]
_libImports :: [String],
  FileState -> [String]
_moduleImports :: [String],
  
  -- Only used for Python and Swift
  FileState -> Doc
_mainDoc :: Doc, -- To print Python/Swift's "main" last

  -- C++ only
  FileState -> [String]
_headerLangImports :: [String],
  FileState -> [String]
_headerLibImports :: [String],
  FileState -> [String]
_headerModImports :: [String],
  FileState -> [String]
_defines :: [String],
  FileState -> [String]
_headerDefines :: [String],
  FileState -> [String]
_using :: [String],
  FileState -> [String]
_headerUsing :: [String]
}
makeLenses ''FileState

data ClassState = CS {
  ClassState -> FileState
_fileState :: FileState,
  ClassState -> String
_currClassName :: ClassName -- So class name is accessible when generating 
                              -- constructor or self 
}
makeLenses ''ClassState

type Index = Integer

data MethodState = MS {
  MethodState -> ClassState
_classState :: ClassState,
  MethodState -> [String]
_currParameters :: [String], -- Used to get parameter names when generating 
                               -- function documentation
  MethodState -> Map String Int
_varNames :: Map String Int, -- Used to generate fresh variable names

  -- Only used for Java
  MethodState -> Bool
_outputsDeclared :: Bool, -- So Java doesn't redeclare outputs variable when using inOutCall
  MethodState -> [ExceptionType]
_exceptions :: [ExceptionType], -- Used to build methodExceptionMap
  MethodState -> [QualifiedName]
_calls :: [QualifiedName], -- Used to build CallMap
  
  -- Only used for C++
  MethodState -> ScopeTag
_currScope :: ScopeTag, -- Used to maintain correct scope when adding 
                          -- documentation to function in C++
  MethodState -> Bool
_currMainFunc :: Bool, -- Used by C++ to put documentation for the main
                        -- function in source instead of header file
  MethodState -> [String]
_iterators :: [String],

  -- Only used for Swift
  MethodState -> (Index, Index)
_contentsIndices :: (Index, Index) -- Used to keep track of the current place
                                     -- in a file being read. First Int is the 
                                     -- line number, second is the word number.
}
makeLenses ''MethodState

-- This was once used, but now is not. However it would be a pain to revert all 
-- of the types back to MS from VS, and it is likely that this level of state 
-- will be useful in the future, so I'm just putting in a placeholder.
newtype ValueState = VS {
  ValueState -> MethodState
_methodState :: MethodState
}
makeLenses ''ValueState

type GS = State GOOLState
type FS = State FileState
type CS = State ClassState
type MS = State MethodState
type VS = State ValueState

-------------------------------
---- Lenses between States ----
-------------------------------

-- GS - FS --

lensGStoFS :: Lens' GOOLState FileState
lensGStoFS :: Lens' GOOLState FileState
lensGStoFS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GOOLState
gs -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FileState GOOLState
goolState GOOLState
gs FileState
initialFS) (forall a b. a -> b -> a
const (forall s a. s -> Getting a s a -> a
^. Lens' FileState GOOLState
goolState))

lensFStoGS :: Lens' FileState GOOLState
lensFStoGS :: Lens' FileState GOOLState
lensFStoGS = Lens' FileState GOOLState
goolState

-- GS - MS --

lensMStoGS :: Lens' MethodState GOOLState
lensMStoGS :: Lens' MethodState GOOLState
lensMStoGS = Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState GOOLState
lensFStoGS

-- FS - CS --

lensFStoCS :: Lens' FileState ClassState
lensFStoCS :: Lens' FileState ClassState
lensFStoCS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\FileState
fs -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClassState FileState
fileState FileState
fs ClassState
initialCS) (forall a b. a -> b -> a
const (forall s a. s -> Getting a s a -> a
^. Lens' ClassState FileState
fileState))

lensCStoFS :: Lens' ClassState FileState
lensCStoFS :: Lens' ClassState FileState
lensCStoFS = Lens' ClassState FileState
fileState

-- FS - MS --

lensFStoMS :: Lens' FileState MethodState
lensFStoMS :: Lens' FileState MethodState
lensFStoMS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\FileState
fs -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' MethodState FileState
lensMStoFS FileState
fs MethodState
initialMS) (forall a b. a -> b -> a
const (forall s a. s -> Getting a s a -> a
^. Lens' MethodState FileState
lensMStoFS))

lensMStoFS :: Lens' MethodState FileState 
lensMStoFS :: Lens' MethodState FileState
lensMStoFS = Lens' MethodState ClassState
classState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ClassState FileState
fileState

-- CS - MS --

lensCStoMS :: Lens' ClassState MethodState
lensCStoMS :: Lens' ClassState MethodState
lensCStoMS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\ClassState
cs -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' MethodState ClassState
classState ClassState
cs MethodState
initialMS) (forall a b. a -> b -> a
const (forall s a. s -> Getting a s a -> a
^. Lens' MethodState ClassState
classState))

lensMStoCS :: Lens' MethodState ClassState
lensMStoCS :: Lens' MethodState ClassState
lensMStoCS = Lens' MethodState ClassState
classState

-- FS - VS --

lensFStoVS :: Lens' FileState ValueState
lensFStoVS :: Lens' FileState ValueState
lensFStoVS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\FileState
fs -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ValueState FileState
lensVStoFS FileState
fs ValueState
initialVS) (forall a b. a -> b -> a
const (forall s a. s -> Getting a s a -> a
^. Lens' ValueState FileState
lensVStoFS))

lensVStoFS :: Lens' ValueState FileState
lensVStoFS :: Lens' ValueState FileState
lensVStoFS = Iso' ValueState MethodState
methodState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MethodState FileState
lensMStoFS

-- CS - VS --

lensCStoVS :: Lens' ClassState ValueState
lensCStoVS :: Lens' ClassState ValueState
lensCStoVS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\ClassState
cs -> forall s t a b. ASetter s t a b -> b -> s -> t
set (Iso' ValueState MethodState
methodState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MethodState ClassState
classState) ClassState
cs ValueState
initialVS) 
  (forall a b. a -> b -> a
const (forall s a. s -> Getting a s a -> a
^. (Iso' ValueState MethodState
methodState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MethodState ClassState
classState)))

-- MS - VS --

lensMStoVS :: Lens' MethodState ValueState
lensMStoVS :: Lens' MethodState ValueState
lensMStoVS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\MethodState
ms -> forall s t a b. ASetter s t a b -> b -> s -> t
set Iso' ValueState MethodState
methodState MethodState
ms ValueState
initialVS) (forall a b. a -> b -> a
const (forall s a. s -> Getting a s a -> a
^. Iso' ValueState MethodState
methodState))

lensVStoMS :: Lens' ValueState MethodState
lensVStoMS :: Lens' ValueState MethodState
lensVStoMS = Iso' ValueState MethodState
methodState

-------------------------------
------- Initial States -------
-------------------------------

initialState :: GOOLState
initialState :: GOOLState
initialState = GS {
  _headers :: [String]
_headers = [],
  _sources :: [String]
_sources = [],
  _mainMod :: Maybe String
_mainMod = forall a. Maybe a
Nothing,
  _classMap :: Map String String
_classMap = forall k a. Map k a
Map.empty,

  _methodExceptionMap :: Map QualifiedName [ExceptionType]
_methodExceptionMap = forall k a. Map k a
Map.empty,
  _callMap :: Map QualifiedName [QualifiedName]
_callMap = forall k a. Map k a
Map.empty,

  _throwUsed :: Bool
_throwUsed = Bool
False,
  _errorDefined :: Bool
_errorDefined = Bool
False
}

initialFS :: FileState
initialFS :: FileState
initialFS = FS {
  _goolState :: GOOLState
_goolState = GOOLState
initialState,
  _currModName :: String
_currModName = String
"",
  _currFileType :: FileType
_currFileType = FileType
Combined,
  _currMain :: Bool
_currMain = Bool
False,
  _currClasses :: [String]
_currClasses = [],
  _langImports :: [String]
_langImports = [],
  _libImports :: [String]
_libImports = [],
  _moduleImports :: [String]
_moduleImports = [],
  
  _mainDoc :: Doc
_mainDoc = Doc
empty,

  _headerLangImports :: [String]
_headerLangImports = [],
  _headerLibImports :: [String]
_headerLibImports = [],
  _headerModImports :: [String]
_headerModImports = [],
  _defines :: [String]
_defines = [],
  _headerDefines :: [String]
_headerDefines = [],
  _using :: [String]
_using = [],
  _headerUsing :: [String]
_headerUsing = []
}

initialCS :: ClassState
initialCS :: ClassState
initialCS = CS {
  _fileState :: FileState
_fileState = FileState
initialFS,
  _currClassName :: String
_currClassName = String
""
}

initialMS :: MethodState
initialMS :: MethodState
initialMS = MS {
  _classState :: ClassState
_classState = ClassState
initialCS,
  _currParameters :: [String]
_currParameters = [],
  _varNames :: Map String Int
_varNames = forall k a. Map k a
Map.empty,

  _outputsDeclared :: Bool
_outputsDeclared = Bool
False,
  _exceptions :: [ExceptionType]
_exceptions = [],
  _calls :: [QualifiedName]
_calls = [],

  _currScope :: ScopeTag
_currScope = ScopeTag
Priv,
  _currMainFunc :: Bool
_currMainFunc = Bool
False,
  _iterators :: [String]
_iterators = [],

  _contentsIndices :: (Index, Index)
_contentsIndices = (Index
0,Index
0)
}

initialVS :: ValueState
initialVS :: ValueState
initialVS = VS {
  _methodState :: MethodState
_methodState = MethodState
initialMS
}

-------------------------------
------- State Patterns -------
-------------------------------

modifyReturn :: (s -> s) -> a -> State s a
modifyReturn :: forall s a. (s -> s) -> a -> State s a
modifyReturn s -> s
sf a
v = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify s -> s
sf
  forall (m :: * -> *) a. Monad m => a -> m a
return a
v

modifyReturnFunc :: (b -> s -> s) -> (b -> a) -> State s b -> State s a
modifyReturnFunc :: forall b s a. (b -> s -> s) -> (b -> a) -> State s b -> State s a
modifyReturnFunc b -> s -> s
sf b -> a
vf State s b
st = do
  b
v <- State s b
st
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ b -> s -> s
sf b
v
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b -> a
vf b
v

modifyReturnList :: [State s b] -> (s -> s) -> 
  ([b] -> a) -> State s a
modifyReturnList :: forall s b a. [State s b] -> (s -> s) -> ([b] -> a) -> State s a
modifyReturnList [State s b]
l s -> s
sf [b] -> a
vf = do
  [b]
v <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State s b]
l
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify s -> s
sf
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [b] -> a
vf [b]
v

-------------------------------
------- State Modifiers -------
-------------------------------

revFiles :: GOOLState -> GOOLState
revFiles :: GOOLState -> GOOLState
revFiles = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState [String]
headers forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState [String]
sources forall a. [a] -> [a]
reverse

addFile :: FileType -> FilePath -> GOOLState -> GOOLState
addFile :: FileType -> String -> GOOLState -> GOOLState
addFile FileType
Combined = String -> GOOLState -> GOOLState
addCombinedHeaderSource
addFile FileType
Source = String -> GOOLState -> GOOLState
addSource
addFile FileType
Header = String -> GOOLState -> GOOLState
addHeader

addHeader :: FilePath -> GOOLState -> GOOLState
addHeader :: String -> GOOLState -> GOOLState
addHeader String
fp = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState [String]
headers (\[String]
h -> forall a. Eq a => a -> [a] -> String -> [a]
ifElemError String
fp [String]
h forall a b. (a -> b) -> a -> b
$
  String
"Multiple files with same name encountered: " forall a. [a] -> [a] -> [a]
++ String
fp)

addSource :: FilePath -> GOOLState -> GOOLState
addSource :: String -> GOOLState -> GOOLState
addSource String
fp = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState [String]
sources (\[String]
s -> forall a. Eq a => a -> [a] -> String -> [a]
ifElemError String
fp [String]
s forall a b. (a -> b) -> a -> b
$
  String
"Multiple files with same name encountered: " forall a. [a] -> [a] -> [a]
++ String
fp)

addCombinedHeaderSource :: FilePath -> GOOLState -> GOOLState
addCombinedHeaderSource :: String -> GOOLState -> GOOLState
addCombinedHeaderSource String
fp = String -> GOOLState -> GOOLState
addSource String
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GOOLState -> GOOLState
addHeader String
fp 

addProgNameToPaths :: String -> GOOLState -> GOOLState
addProgNameToPaths :: String -> GOOLState -> GOOLState
addProgNameToPaths String
n = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState (Maybe String)
mainMod (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState [String]
sources (forall a b. (a -> b) -> [a] -> [b]
map String -> String
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState [String]
headers (forall a b. (a -> b) -> [a] -> [b]
map String -> String
f)
  where f :: String -> String
f = ((String
nforall a. [a] -> [a] -> [a]
++String
"/")forall a. [a] -> [a] -> [a]
++)

setMainMod :: String -> GOOLState -> GOOLState
setMainMod :: String -> GOOLState -> GOOLState
setMainMod String
n = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState (Maybe String)
mainMod (\Maybe String
m -> if forall a. Maybe a -> Bool
isNothing Maybe String
m then forall a. a -> Maybe a
Just String
n else forall a. HasCallStack => String -> a
error 
  String
"Multiple modules with main methods encountered")

addLangImport :: String -> MethodState -> MethodState
addLangImport :: String -> MethodState -> MethodState
addLangImport String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
langImports) (\[String]
is -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
iforall a. a -> [a] -> [a]
:[String]
is)
  
addLangImportVS :: String -> ValueState -> ValueState
addLangImportVS :: String -> ValueState -> ValueState
addLangImportVS String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Iso' ValueState MethodState
methodState (String -> MethodState -> MethodState
addLangImport String
i)

addExceptionImports :: [Exception] -> MethodState -> MethodState
addExceptionImports :: [Exception] -> MethodState -> MethodState
addExceptionImports [Exception]
es = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
langImports) 
  (\[String]
is -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ [String]
is forall a. [a] -> [a] -> [a]
++ [String]
imps)
  where imps :: [String]
imps = forall a b. (a -> b) -> [a] -> [b]
map Exception -> String
printExc forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Exception -> Bool
hasLoc [Exception]
es

getLangImports :: FS [String]
getLangImports :: FS [String]
getLangImports = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
langImports)

addLibImport :: String -> MethodState -> MethodState
addLibImport :: String -> MethodState -> MethodState
addLibImport String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
libImports) (\[String]
is -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
iforall a. a -> [a] -> [a]
:[String]
is)

addLibImportVS :: String -> ValueState -> ValueState
addLibImportVS :: String -> ValueState -> ValueState
addLibImportVS String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
libImports) (\[String]
is -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
iforall a. a -> [a] -> [a]
:[String]
is)

addLibImports :: [String] -> MethodState -> MethodState
addLibImports :: [String] -> MethodState -> MethodState
addLibImports [String]
is MethodState
s = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> MethodState -> MethodState
addLibImport) MethodState
s [String]
is

getLibImports :: FS [String]
getLibImports :: FS [String]
getLibImports = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
libImports)

addModuleImport :: String -> MethodState -> MethodState
addModuleImport :: String -> MethodState -> MethodState
addModuleImport String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
moduleImports) (\[String]
is -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
iforall a. a -> [a] -> [a]
:[String]
is)

addModuleImportVS :: String -> ValueState -> ValueState
addModuleImportVS :: String -> ValueState -> ValueState
addModuleImportVS String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Iso' ValueState MethodState
methodState (String -> MethodState -> MethodState
addModuleImport String
i)

getModuleImports :: FS [String]
getModuleImports :: FS [String]
getModuleImports = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
moduleImports)

addHeaderLangImport :: String -> ValueState -> ValueState
addHeaderLangImport :: String -> ValueState -> ValueState
addHeaderLangImport String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
headerLangImports) 
  (\[String]
is -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
iforall a. a -> [a] -> [a]
:[String]
is)

getHeaderLangImports :: FS [String]
getHeaderLangImports :: FS [String]
getHeaderLangImports = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
headerLangImports)

addHeaderLibImport :: String -> MethodState -> MethodState
addHeaderLibImport :: String -> MethodState -> MethodState
addHeaderLibImport String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
headerLibImports)
  (\[String]
is -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
iforall a. a -> [a] -> [a]
:[String]
is)

getHeaderLibImports :: FS [String]
getHeaderLibImports :: FS [String]
getHeaderLibImports = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
headerLibImports)

addHeaderModImport :: String -> ValueState -> ValueState
addHeaderModImport :: String -> ValueState -> ValueState
addHeaderModImport String
i = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
headerModImports)
  (\[String]
is -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
iforall a. a -> [a] -> [a]
:[String]
is)

getHeaderModImports :: FS [String]
getHeaderModImports :: FS [String]
getHeaderModImports = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
headerModImports)

addDefine :: String -> ValueState -> ValueState
addDefine :: String -> ValueState -> ValueState
addDefine String
d = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
defines) (\[String]
ds -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
dforall a. a -> [a] -> [a]
:[String]
ds)

getDefines :: FS [String]
getDefines :: FS [String]
getDefines = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
defines)
  
addHeaderDefine :: String -> ValueState -> ValueState
addHeaderDefine :: String -> ValueState -> ValueState
addHeaderDefine String
d = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
headerDefines) (\[String]
ds -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
dforall a. a -> [a] -> [a]
:[String]
ds)

getHeaderDefines :: FS [String]
getHeaderDefines :: FS [String]
getHeaderDefines = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
headerDefines)

addUsing :: String -> ValueState -> ValueState
addUsing :: String -> ValueState -> ValueState
addUsing String
u = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
using) (\[String]
us -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
uforall a. a -> [a] -> [a]
:[String]
us)

getUsing :: FS [String]
getUsing :: FS [String]
getUsing = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
using)

addHeaderUsing :: String -> ValueState -> ValueState
addHeaderUsing :: String -> ValueState -> ValueState
addHeaderUsing String
u = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
headerUsing) (\[String]
us -> forall a. Ord a => [a] -> [a]
nubSort forall a b. (a -> b) -> a -> b
$ String
uforall a. a -> [a] -> [a]
:[String]
us)

getHeaderUsing :: FS [String]
getHeaderUsing :: FS [String]
getHeaderUsing = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
headerUsing)

setMainDoc :: Doc -> MethodState -> MethodState
setMainDoc :: Doc -> MethodState -> MethodState
setMainDoc Doc
d = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' MethodState FileState
lensMStoFS forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FileState Doc
mainDoc Doc
d

getMainDoc :: FS Doc
getMainDoc :: FS Doc
getMainDoc = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState Doc
mainDoc)

setFileType :: FileType -> FileState -> FileState
setFileType :: FileType -> FileState -> FileState
setFileType = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FileState FileType
currFileType

setModuleName :: String -> FileState -> FileState
setModuleName :: String -> FileState -> FileState
setModuleName = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' FileState String
currModName

getModuleName :: FS String
getModuleName :: FS String
getModuleName = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState String
currModName)

setClassName :: String -> ClassState -> ClassState
setClassName :: String -> ClassState -> ClassState
setClassName = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClassState String
currClassName

getClassName :: MS ClassName
getClassName :: MS String
getClassName = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. (Lens' MethodState ClassState
classState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ClassState String
currClassName))

setCurrMain :: MethodState -> MethodState
setCurrMain :: MethodState -> MethodState
setCurrMain = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState Bool
currMain) (\Bool
b -> if Bool
b then 
  forall a. HasCallStack => String -> a
error String
"Multiple main functions defined" else Bool -> Bool
not Bool
b)

getCurrMain :: FS Bool
getCurrMain :: FS Bool
getCurrMain = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState Bool
currMain)

addClass :: String -> ClassState -> ClassState
addClass :: String -> ClassState -> ClassState
addClass String
c = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ClassState FileState
fileState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState [String]
currClasses) (\[String]
cs -> forall a. Eq a => a -> [a] -> String -> [a]
ifElemError String
c [String]
cs 
  String
"Multiple classes with same name in same file")

getClasses :: FS [String]
getClasses :: FS [String]
getClasses = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
currClasses)

updateClassMap :: String -> FileState -> FileState
updateClassMap :: String -> FileState -> FileState
updateClassMap String
n FileState
fs = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' FileState GOOLState
goolState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState (Map String String)
classMap) (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
  forall a b. (a -> b) -> [a] -> [b]
map (String
n,) (FileState
fs forall s a. s -> Getting a s a -> a
^. Lens' FileState [String]
currClasses))) FileState
fs

getClassMap :: VS (Map String String)
getClassMap :: VS (Map String String)
getClassMap = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState GOOLState
goolState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState (Map String String)
classMap))

updateMethodExcMap :: String -> MethodState -> MethodState
updateMethodExcMap :: String -> MethodState -> MethodState
updateMethodExcMap String
n MethodState
ms = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState GOOLState
goolState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState (Map QualifiedName [ExceptionType])
methodExceptionMap) 
  (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (String -> String -> QualifiedName
qualName String
mn String
n) (MethodState
ms forall s a. s -> Getting a s a -> a
^. Lens' MethodState [ExceptionType]
exceptions)) MethodState
ms
  where mn :: String
mn = MethodState
ms forall s a. s -> Getting a s a -> a
^. (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState String
currModName)

getMethodExcMap :: VS (Map QualifiedName [ExceptionType])
getMethodExcMap :: VS (Map QualifiedName [ExceptionType])
getMethodExcMap = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. (Lens' ValueState FileState
lensVStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState GOOLState
goolState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState (Map QualifiedName [ExceptionType])
methodExceptionMap))

updateCallMap :: String -> MethodState -> MethodState
updateCallMap :: String -> MethodState -> MethodState
updateCallMap String
n MethodState
ms = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState GOOLState
goolState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState (Map QualifiedName [QualifiedName])
callMap) 
  (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (String -> String -> QualifiedName
qualName String
mn String
n) (MethodState
ms forall s a. s -> Getting a s a -> a
^. Lens' MethodState [QualifiedName]
calls)) MethodState
ms
  where mn :: String
mn = MethodState
ms forall s a. s -> Getting a s a -> a
^. (Lens' MethodState FileState
lensMStoFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileState String
currModName)

callMapTransClosure :: GOOLState -> GOOLState
callMapTransClosure :: GOOLState -> GOOLState
callMapTransClosure = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState (Map QualifiedName [QualifiedName])
callMap Map QualifiedName [QualifiedName]
-> Map QualifiedName [QualifiedName]
tClosure
  where tClosure :: Map QualifiedName [QualifiedName]
-> Map QualifiedName [QualifiedName]
tClosure Map QualifiedName [QualifiedName]
m = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Map QualifiedName [QualifiedName]
-> [QualifiedName] -> [QualifiedName]
traceCalls Map QualifiedName [QualifiedName]
m) Map QualifiedName [QualifiedName]
m
        traceCalls :: Map QualifiedName [QualifiedName] -> [QualifiedName] -> 
          [QualifiedName]
        traceCalls :: Map QualifiedName [QualifiedName]
-> [QualifiedName] -> [QualifiedName]
traceCalls Map QualifiedName [QualifiedName]
_ [] = []
        traceCalls Map QualifiedName [QualifiedName]
cm (QualifiedName
c:[QualifiedName]
cs) = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ QualifiedName
c forall a. a -> [a] -> [a]
: Map QualifiedName [QualifiedName]
-> [QualifiedName] -> [QualifiedName]
traceCalls Map QualifiedName [QualifiedName]
cm (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [QualifiedName]
cs forall a. [a] -> [a] -> [a]
++ 
          forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] QualifiedName
c Map QualifiedName [QualifiedName]
cm)

updateMEMWithCalls :: GOOLState -> GOOLState
updateMEMWithCalls :: GOOLState -> GOOLState
updateMEMWithCalls GOOLState
s = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' GOOLState (Map QualifiedName [ExceptionType])
methodExceptionMap (\Map QualifiedName [ExceptionType]
mem -> forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
  (Map QualifiedName [ExceptionType]
-> Map QualifiedName [QualifiedName]
-> QualifiedName
-> [ExceptionType]
-> [ExceptionType]
addCallExcs Map QualifiedName [ExceptionType]
mem (GOOLState
s forall s a. s -> Getting a s a -> a
^. Lens' GOOLState (Map QualifiedName [QualifiedName])
callMap)) Map QualifiedName [ExceptionType]
mem) GOOLState
s
  where addCallExcs :: Map QualifiedName [ExceptionType] -> 
          Map QualifiedName [QualifiedName] -> QualifiedName -> [ExceptionType] 
          -> [ExceptionType]
        addCallExcs :: Map QualifiedName [ExceptionType]
-> Map QualifiedName [QualifiedName]
-> QualifiedName
-> [ExceptionType]
-> [ExceptionType]
addCallExcs Map QualifiedName [ExceptionType]
mem Map QualifiedName [QualifiedName]
cm QualifiedName
f [ExceptionType]
es = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [ExceptionType]
es forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\QualifiedName
fn -> forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
          [] QualifiedName
fn Map QualifiedName [ExceptionType]
mem) (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] QualifiedName
f Map QualifiedName [QualifiedName]
cm)

addParameter :: String -> MethodState -> MethodState
addParameter :: String -> MethodState -> MethodState
addParameter String
p = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' MethodState [String]
currParameters (\[String]
ps -> forall a. Eq a => a -> [a] -> String -> [a]
ifElemError String
p [String]
ps forall a b. (a -> b) -> a -> b
$ 
  String
"Function has duplicate parameter: " forall a. [a] -> [a] -> [a]
++ String
p)

getParameters :: MS [String]
getParameters :: MS [String]
getParameters = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' MethodState [String]
currParameters))

setOutputsDeclared :: MethodState -> MethodState
setOutputsDeclared :: MethodState -> MethodState
setOutputsDeclared = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' MethodState Bool
outputsDeclared Bool
True

isOutputsDeclared :: MS Bool
isOutputsDeclared :: MS Bool
isOutputsDeclared = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' MethodState Bool
outputsDeclared)

addException :: ExceptionType -> MethodState -> MethodState
addException :: ExceptionType -> MethodState -> MethodState
addException ExceptionType
e = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' MethodState [ExceptionType]
exceptions (\[ExceptionType]
es -> forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ ExceptionType
e forall a. a -> [a] -> [a]
: [ExceptionType]
es)

addExceptions :: [ExceptionType] -> ValueState -> ValueState
addExceptions :: [ExceptionType] -> ValueState -> ValueState
addExceptions [ExceptionType]
es = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Iso' ValueState MethodState
methodState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MethodState [ExceptionType]
exceptions) (\[ExceptionType]
exs -> forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [ExceptionType]
es forall a. [a] -> [a] -> [a]
++ [ExceptionType]
exs)

getExceptions :: MS [ExceptionType]
getExceptions :: MS [ExceptionType]
getExceptions = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' MethodState [ExceptionType]
exceptions)

addCall :: QualifiedName -> ValueState -> ValueState
addCall :: QualifiedName -> ValueState -> ValueState
addCall QualifiedName
f = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Iso' ValueState MethodState
methodState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' MethodState [QualifiedName]
calls) (QualifiedName
fforall a. a -> [a] -> [a]
:)

setScope :: ScopeTag -> MethodState -> MethodState
setScope :: ScopeTag -> MethodState -> MethodState
setScope = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' MethodState ScopeTag
currScope

getScope :: MS ScopeTag
getScope :: MS ScopeTag
getScope = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' MethodState ScopeTag
currScope)

setCurrMainFunc :: Bool -> MethodState -> MethodState
setCurrMainFunc :: Bool -> MethodState -> MethodState
setCurrMainFunc = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' MethodState Bool
currMainFunc

getCurrMainFunc :: MS Bool
getCurrMainFunc :: MS Bool
getCurrMainFunc = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' MethodState Bool
currMainFunc)

setThrowUsed :: MethodState -> MethodState
setThrowUsed :: MethodState -> MethodState
setThrowUsed = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' MethodState GOOLState
lensMStoGS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState Bool
throwUsed) Bool
True

getThrowUsed :: MS Bool
getThrowUsed :: MS Bool
getThrowUsed = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. (Lens' MethodState GOOLState
lensMStoGS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState Bool
throwUsed))

setErrorDefined :: MethodState -> MethodState
setErrorDefined :: MethodState -> MethodState
setErrorDefined = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' MethodState GOOLState
lensMStoGS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState Bool
errorDefined) Bool
True

getErrorDefined :: MS Bool
getErrorDefined :: MS Bool
getErrorDefined = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. (Lens' MethodState GOOLState
lensMStoGS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GOOLState Bool
errorDefined))

addIter :: String -> MethodState -> MethodState
addIter :: String -> MethodState -> MethodState
addIter String
st = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' MethodState [String]
iterators ([String
st]forall a. [a] -> [a] -> [a]
++)

getIter :: MS [String]
getIter :: MS [String]
getIter = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' MethodState [String]
iterators)

resetIter :: String -> MethodState -> MethodState
resetIter :: String -> MethodState -> MethodState
resetIter String
st = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' MethodState [String]
iterators (forall a. Eq a => a -> [a] -> [a]
delete String
st)

incrementLine :: MethodState -> MethodState
incrementLine :: MethodState -> MethodState
incrementLine = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState (Index, Index)
contentsIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1) (forall a. Num a => a -> a -> a
+Index
1)  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' MethodState (Index, Index)
contentsIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) Index
0

incrementWord :: MethodState -> MethodState
incrementWord :: MethodState -> MethodState
incrementWord = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState (Index, Index)
contentsIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) (forall a. Num a => a -> a -> a
+Index
1)

getLineIndex :: MS Index
getLineIndex :: MS Index
getLineIndex = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. (Lens' MethodState (Index, Index)
contentsIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1))

getWordIndex :: MS Index
getWordIndex :: MS Index
getWordIndex = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. (Lens' MethodState (Index, Index)
contentsIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2))

resetIndices :: MethodState -> MethodState
resetIndices :: MethodState -> MethodState
resetIndices = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' MethodState (Index, Index)
contentsIndices (Index
0,Index
0)

useVarName :: String -> MethodState -> MethodState
useVarName :: String -> MethodState -> MethodState
useVarName String
v = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' MethodState (Map String Int)
varNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at String
prefix) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
max Int
nextSuffix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Int
0)
  where (String
prefix, Int
nextSuffix) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Field2 s t a b => Lens s t a b
_2 (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
+Int
1)) forall a b. (a -> b) -> a -> b
$ String -> (String, Maybe Int)
splitVarName String
v

genVarName :: [String] -> String -> MS String
genVarName :: [String] -> String -> MS String
genVarName [String]
candidates String
backup = do
  Map String Int
used <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. Lens' MethodState (Map String Int)
varNames)
  let
    isAvailable :: (String, Maybe Int) -> Bool
isAvailable (String
n,Maybe Int
c) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> b -> a
const Bool
False) forall a. Ord a => a -> a -> Bool
(>=) Maybe Int
c) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n Map String Int
used
    choice :: (String, Maybe Int)
choice = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. a -> b -> a
const (String -> (String, Maybe Int)
splitVarName String
backup) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String, Maybe Int) -> Bool
isAvailable forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> (String, Maybe Int)
splitVarName [String]
candidates
  (String, Maybe Int) -> MS String
bumpVarName (String, Maybe Int)
choice

genLoopIndex :: MS String
genLoopIndex :: MS String
genLoopIndex = [String] -> String -> MS String
genVarName [String
"i", String
"j", String
"k"] String
"i"

-- Helpers

ifElemError :: (Eq a) => a -> [a] -> String -> [a]
ifElemError :: forall a. Eq a => a -> [a] -> String -> [a]
ifElemError a
e [a]
es String
err = if a
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
es then forall a. HasCallStack => String -> a
error String
err else a
e forall a. a -> [a] -> [a]
: [a]
es

-- Split the longest numerical (0-9) suffix from the rest of the string
splitVarName :: String -> (String, Maybe Int)
splitVarName :: String -> (String, Maybe Int)
splitVarName = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Field2 s t a b => Lens s t a b
_2 forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

bumpVarName :: (String, Maybe Int) -> MS String
bumpVarName :: (String, Maybe Int) -> MS String
bumpVarName (String
n,Maybe Int
c) = do
  Maybe Int
count <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall s a. s -> Getting a s a -> a
^. (Lens' MethodState (Map String Int)
varNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at String
n))
  let suffix :: Maybe Int
suffix = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Int
count (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Int
count forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
max) Maybe Int
c
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' MethodState (Map String Int)
varNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at String
n) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
+Int
1) Maybe Int
suffix
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
n ((String
n forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Int
count