module Language.ATS (
lexATS
, parse
, parseWithCtx
, printATS
, printATSCustom
, printATSFast
, printErr
, defaultFixityState
, getDependencies
, ATS (..)
, Declaration (..)
, Expression (..)
, Type (..)
, Function (..)
, Implementation (..)
, Pattern (..)
, Name (..)
, UnOp (..)
, BinOp (..)
, DataPropLeaf (..)
, Leaf (..)
, Arg (..)
, Addendum (..)
, LambdaType (..)
, Universal (..)
, Existential (..)
, PreFunction (..)
, StaticExpression (..)
, StackFunction (..)
, Paired (..)
, Fixity (..)
, SortArg (..)
, Sort (..)
, SortArgs
, FixityState
, Token (..)
, AlexPosn (..)
, Keyword (..)
, ATSError
, preF
, expression
, fun
, leaves
, constructorUniversals
, typeCall
, typeCallArgs
) where
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.State
import GHC.IO.Handle.FD (stderr)
import Language.ATS.Lexer
import Language.ATS.Parser
import Language.ATS.PrettyPrint
import Language.ATS.Types
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
rewriteATS' :: Eq a => (ATS a, FixityState a) -> ATS a
rewriteATS' (ATS ds, st) = ATS (rewriteDecl st <$> ds)
printErr :: MonadIO m => ATSError -> m ()
printErr = liftIO . hPutDoc stderr . (<> "\n") . pretty
parse :: String -> Either ATSError (ATS AlexPosn)
parse = parseWithCtx defaultFixityState
parseWithCtx :: FixityState AlexPosn -> String -> Either ATSError (ATS AlexPosn)
parseWithCtx st = stateParse <=< lexErr
where withSt = flip runStateT st
lexErr = over _Left LexError . lexATS
stateParse = fmap rewriteATS' . withSt . parseATS
getDependencies :: ATS a -> [FilePath]
getDependencies (ATS ds) = g =<< ds
where g (Staload _ _ s) = [s]
g (Include s) = [s]
g (Local _ as as') = foldMap getDependencies [as, as']
g _ = mempty