{-# LANGUAGE TemplateHaskell #-}

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
) 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)
import Control.Monad.State (State, modify, gets)
import Data.List (nub, delete)
import Data.Maybe (isNothing)
import Data.Map (Map, fromList, insert, union, findWithDefault, mapWithKey)
import qualified Data.Map as Map (empty, map)
import Text.PrettyPrint.HughesPJ (Doc, empty)

data GOOLState = GS {
  GOOLState -> [FilePath]
_headers :: [FilePath], -- Used by Drasil for doxygen config gen
  GOOLState -> [FilePath]
_sources :: [FilePath], -- Used by Drasil for doxygen config and Makefile gen
  GOOLState -> Maybe FilePath
_mainMod :: Maybe FilePath, -- Used by Drasil generator to access main 
                              -- mod file path (needed in Makefile generation)
  GOOLState -> Map FilePath FilePath
_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 -> FilePath
_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 -> [FilePath]
_currClasses :: [ClassName], -- Used to update classMap
  FileState -> [FilePath]
_langImports :: [String],
  FileState -> [FilePath]
_libImports :: [String],
  FileState -> [FilePath]
_moduleImports :: [String],
  
  -- Only used for Python and Swift
  FileState -> Doc
_mainDoc :: Doc, -- To print Python/Swift's "main" last

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

data ClassState = CS {
  ClassState -> FileState
_fileState :: FileState,
  ClassState -> FilePath
_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 -> [FilePath]
_currParameters :: [String], -- Used to get parameter names when generating 
                               -- function documentation

  -- 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 -> [FilePath]
_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 :: (FileState -> f FileState) -> GOOLState -> f GOOLState
lensGStoFS = (GOOLState -> FileState)
-> (GOOLState -> FileState -> GOOLState)
-> Lens GOOLState GOOLState FileState FileState
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\gs :: GOOLState
gs -> ASetter FileState FileState GOOLState GOOLState
-> GOOLState -> FileState -> FileState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter FileState FileState GOOLState GOOLState
Lens' FileState GOOLState
goolState GOOLState
gs FileState
initialFS) ((FileState -> GOOLState) -> GOOLState -> FileState -> GOOLState
forall a b. a -> b -> a
const (FileState -> Getting GOOLState FileState GOOLState -> GOOLState
forall s a. s -> Getting a s a -> a
^. Getting GOOLState FileState GOOLState
Lens' FileState GOOLState
goolState))

lensFStoGS :: Lens' FileState GOOLState
lensFStoGS :: (GOOLState -> f GOOLState) -> FileState -> f FileState
lensFStoGS = (GOOLState -> f GOOLState) -> FileState -> f FileState
Lens' FileState GOOLState
goolState

-- GS - MS --

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

-- FS - CS --

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

lensCStoFS :: Lens' ClassState FileState
lensCStoFS :: (FileState -> f FileState) -> ClassState -> f ClassState
lensCStoFS = (FileState -> f FileState) -> ClassState -> f ClassState
Lens' ClassState FileState
fileState

-- FS - MS --

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

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

-- CS - MS --

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

lensMStoCS :: Lens' MethodState ClassState
lensMStoCS :: (ClassState -> f ClassState) -> MethodState -> f MethodState
lensMStoCS = (ClassState -> f ClassState) -> MethodState -> f MethodState
Lens' MethodState ClassState
classState

-- FS - VS --

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

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

-- CS - VS --

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

-- MS - VS --

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

lensVStoMS :: Lens' ValueState MethodState
lensVStoMS :: (MethodState -> f MethodState) -> ValueState -> f ValueState
lensVStoMS = (MethodState -> f MethodState) -> ValueState -> f ValueState
Iso' ValueState MethodState
methodState

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

initialState :: GOOLState
initialState :: GOOLState
initialState = GS :: [FilePath]
-> [FilePath]
-> Maybe FilePath
-> Map FilePath FilePath
-> Map QualifiedName [ExceptionType]
-> Map QualifiedName [QualifiedName]
-> Bool
-> Bool
-> GOOLState
GS {
  _headers :: [FilePath]
_headers = [],
  _sources :: [FilePath]
_sources = [],
  _mainMod :: Maybe FilePath
_mainMod = Maybe FilePath
forall a. Maybe a
Nothing,
  _classMap :: Map FilePath FilePath
_classMap = Map FilePath FilePath
forall k a. Map k a
Map.empty,

  _methodExceptionMap :: Map QualifiedName [ExceptionType]
_methodExceptionMap = Map QualifiedName [ExceptionType]
forall k a. Map k a
Map.empty,
  _callMap :: Map QualifiedName [QualifiedName]
_callMap = Map QualifiedName [QualifiedName]
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
-> FilePath
-> FileType
-> Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> Doc
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> FileState
FS {
  _goolState :: GOOLState
_goolState = GOOLState
initialState,
  _currModName :: FilePath
_currModName = "",
  _currFileType :: FileType
_currFileType = FileType
Combined,
  _currMain :: Bool
_currMain = Bool
False,
  _currClasses :: [FilePath]
_currClasses = [],
  _langImports :: [FilePath]
_langImports = [],
  _libImports :: [FilePath]
_libImports = [],
  _moduleImports :: [FilePath]
_moduleImports = [],
  
  _mainDoc :: Doc
_mainDoc = Doc
empty,

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

initialCS :: ClassState
initialCS :: ClassState
initialCS = CS :: FileState -> FilePath -> ClassState
CS {
  _fileState :: FileState
_fileState = FileState
initialFS,
  _currClassName :: FilePath
_currClassName = ""
}

initialMS :: MethodState
initialMS :: MethodState
initialMS = MS :: ClassState
-> [FilePath]
-> Bool
-> [ExceptionType]
-> [QualifiedName]
-> ScopeTag
-> Bool
-> [FilePath]
-> (Index, Index)
-> MethodState
MS {
  _classState :: ClassState
_classState = ClassState
initialCS,
  _currParameters :: [FilePath]
_currParameters = [],

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- Helpers

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