{-# LANGUAGE OverloadedStrings #-}

-- | Main module for the library
module Language.ATS ( -- * Functions for working with syntax
                      lexATS
                    , parse
                    , parseWithCtx
                    , parseM
                    , printATS
                    , printATSCustom
                    , printATSFast
                    , printErr
                    , warnErr
                    , defaultFixityState
                    -- * Library functions
                    , getDependencies
                    , getDependenciesC
                    -- * Syntax Tree
                    , ATS (..)
                    , Declaration (..)
                    , Expression (..)
                    , Type (..)
                    , Function (..)
                    , Implementation (..)
                    , Pattern (..)
                    , Name (..)
                    , UnOp (..)
                    , BinOp (..)
                    , DataPropLeaf (..)
                    , Leaf (..)
                    , DataSortLeaf (..)
                    , Arg (..)
                    , Addendum (..)
                    , LambdaType (..)
                    , Universal (..)
                    , Existential (..)
                    , PreFunction (..)
                    , StaticExpression (..)
                    , StackFunction (..)
                    , Fixity (..)
                    , SortArg (..)
                    , Sort (..)
                    , SortArgs
                    , Args
                    , Fix
                    -- * Parser State
                    , FixityState
                    -- * Lexical types
                    , Token (..)
                    , AlexPosn (..)
                    , Keyword (..)
                    -- * Error types
                    , ATSError (..)
                    -- * Lenses
                    , preF
                    , expression
                    , fun
                    , leaves
                    , constructorUniversals
                    , typeCall
                    , typeCallArgs
                    -- * Misecellany
                    , languageATSVersion
                    ) where

import           Control.Composition          ((-$))
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.State
import           Data.Version                 (Version)
import           GHC.IO.Handle.FD             (stderr)
import           Language.ATS.Lexer
import           Language.ATS.Parser
import           Language.ATS.PrettyPrint
import           Language.ATS.Rewrite
import           Language.ATS.Types
import           Language.ATS.Types.Lens
import           Lens.Micro
import           Paths_language_ats           (version)
import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))

-- | @since 1.7.4.0
languageATSVersion :: Version
languageATSVersion = version

rewriteATS' :: Eq a => (ATS a, FixityState a) -> ATS a
rewriteATS' (ATS ds, st) = ATS (rewriteDecl st <$> ds)

-- | Print an error message to standard error.
printErr :: MonadIO m => ATSError -> m ()
printErr = liftIO . hPutDoc stderr . (<> "\n") . pretty

-- | Same as 'printErr', but print a yellow warning message instead.
warnErr :: MonadIO m => FilePath -> ATSError -> m ()
warnErr fp = liftIO . hPutDoc stderr . ((dullyellow "Warning" <+> text (fp <> ":")) <+> ) . preErr
-- TODO: this should detect if being piped to terminal!

-- | Parse a string containing ATS source, disregarding comments.
parseM :: String -> Either ATSError (ATS AlexPosn)
parseM = parseWithCtx defaultFixityState stripComments

-- | Parse a string containing ATS source.
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

-- | Parse with some fixity declarations already in scope.
parseWithCtx :: FixityState AlexPosn -> ([Token] -> [Token]) -> String -> Either ATSError (ATS AlexPosn)
parseWithCtx st p = stateParse <=< lex'
    where withSt = runStateT -$ st
          lex' = lexErr . fmap p . lexATS
          stateParse = fmap rewriteATS' . withSt . parseATS

-- | Extract a list of files that some code depends on.
getDependencies :: ATS a -> [FilePath]
getDependencies (ATS ds) = g =<< ds
    where g (Load _ _ _ s)   = [s]
          g (Include s)      = [s]
          g (Local _ as as') = getDependencies =<< [as, as']
          g _                = mempty

-- | Extract a list of @#include#-ed filepaths, plus all external C blocks.
--
-- @since 1.7.7.0
getDependenciesC :: ATS a -> ([FilePath], [String])
getDependenciesC (ATS ds) = go (d <$> ds)
    where
        d (Load _ _ _ s)   = ([s], [])
        d (Include s)      = ([s], [])
        d (Local _ as as') = appendBoth (getDependenciesC as) (getDependenciesC as')
        d (CBlock str)     = ([],[str])
        d _                = ([],[])
        appendBoth :: ([a], [b]) -> ([a], [b]) -> ([a], [b])
        appendBoth (x, y) (x', y') = (x ++ x', y ++ y')
        go :: [([a], [b])] -> ([a], [b])
        go xs = (concat (fst <$> xs), concat (snd <$> xs))