module Language.ATS (
lexATS
, parse
, parseWithCtx
, parseM
, printATS
, printATSCustom
, printATSFast
, printErr
, warnErr
, defaultFixityState
, getDependencies
, ATS (..)
, Declaration (..)
, Expression (..)
, Type (..)
, Function (..)
, Implementation (..)
, Pattern (..)
, Name (..)
, UnOp (..)
, BinOp (..)
, DataPropLeaf (..)
, Leaf (..)
, DataSortLeaf (..)
, 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.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 Lens.Micro
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
warnErr :: MonadIO m => FilePath -> ATSError -> m ()
warnErr fp = liftIO . hPutDoc stderr . ((dullyellow "Warning" <+> text (fp <> ":")) <+> ) . preErr
parseM :: String -> Either ATSError (ATS AlexPosn)
parseM = parseWithCtx defaultFixityState stripComments
parse :: String -> Either ATSError (ATS AlexPosn)
parse = parseWithCtx defaultFixityState id
lexErr :: Either String a -> Either ATSError a
lexErr = over _Left LexError
stripComments :: [Token] -> [Token]
stripComments = filter nc
where nc CommentLex{} = False
nc CommentBegin{} = False
nc CommentEnd{} = False
nc CommentContents{} = False
nc _ = True
parseWithCtx :: FixityState AlexPosn -> ([Token] -> [Token]) -> String -> Either ATSError (ATS AlexPosn)
parseWithCtx st p = stateParse <=< lex'
where withSt = flip runStateT st
lex' = lexErr . fmap p . lexATS
stateParse = fmap rewriteATS' . withSt . parseATS
getDependencies :: ATS a -> [FilePath]
getDependencies (ATS ds) = g =<< ds
where g (Load _ _ _ s) = [s]
g (Include s) = [s]
g (Local _ as as') = foldMap getDependencies [as, as']
g _ = mempty