{-# LANGUAGE Strict     #-}
{-# LANGUAGE StrictData #-}
module Language.Cimple.IO
    ( parseFile
    , parseFiles
    , parseProgram
    , parseText
    ) where

import           Control.Monad                   ((>=>))
import qualified Control.Monad.Parallel          as P
import           Control.Monad.State.Strict      (State, evalState, get, put)
import qualified Data.ByteString.Lazy            as LBS
import           Data.Map.Strict                 (Map)
import qualified Data.Map.Strict                 as Map
import           Data.Text                       (Text)
import qualified Data.Text.Encoding              as Text
import           Language.Cimple.Ast             (Node)
import           Language.Cimple.Lexer           (Lexeme, runAlex)
import           Language.Cimple.MapAst          (TextActions, mapAst,
                                                  textActions)
import qualified Language.Cimple.Parser          as Parser
import qualified Language.Cimple.ParseResult     as ParseResult
import           Language.Cimple.Program         (Program)
import qualified Language.Cimple.Program         as Program
import           Language.Cimple.TranslationUnit (TranslationUnit)
import qualified Language.Cimple.TreeParser      as TreeParser

type TextNode = Node (Lexeme Text)

cacheText :: [TextNode] -> [TextNode]
cacheText :: [TextNode] -> [TextNode]
cacheText [TextNode]
textAst =
    State (Map Text Text) [TextNode] -> Map Text Text -> [TextNode]
forall s a. State s a -> s -> a
evalState (AstActions (State (Map Text Text)) Text Text
-> [TextNode]
-> State (Map Text Text) (Mapped Text Text [TextNode])
forall itext otext a (f :: * -> *).
(MapAst itext otext a, Applicative f) =>
AstActions f itext otext -> a -> f (Mapped itext otext a)
mapAst AstActions (State (Map Text Text)) Text Text
cacheActions [TextNode]
textAst) Map Text Text
forall k a. Map k a
Map.empty
  where
    cacheActions :: TextActions (State (Map Text Text)) Text Text
    cacheActions :: AstActions (State (Map Text Text)) Text Text
cacheActions = (Text -> State (Map Text Text) Text)
-> AstActions (State (Map Text Text)) Text Text
forall (f :: * -> *) itext otext.
Applicative f =>
(itext -> f otext) -> TextActions f itext otext
textActions ((Text -> State (Map Text Text) Text)
 -> AstActions (State (Map Text Text)) Text Text)
-> (Text -> State (Map Text Text) Text)
-> AstActions (State (Map Text Text)) Text Text
forall a b. (a -> b) -> a -> b
$ \Text
s -> do
        Map Text Text
m <- State (Map Text Text) (Map Text Text)
forall s (m :: * -> *). MonadState s m => m s
get
        case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
s Map Text Text
m of
            Maybe Text
Nothing -> do
                Map Text Text -> State (Map Text Text) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Map Text Text -> State (Map Text Text) ())
-> Map Text Text -> State (Map Text Text) ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
s Text
s Map Text Text
m
                Text -> State (Map Text Text) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
            Just Text
text ->
                Text -> State (Map Text Text) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text


parseText :: Text -> Either String [TextNode]
parseText :: Text -> Either String [TextNode]
parseText = ([TextNode] -> [TextNode])
-> Either String [TextNode] -> Either String [TextNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TextNode] -> [TextNode]
cacheText (Either String [TextNode] -> Either String [TextNode])
-> (Text -> Either String [TextNode])
-> Text
-> Either String [TextNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Alex [TextNode] -> Either String [TextNode])
-> Alex [TextNode] -> ByteString -> Either String [TextNode]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Alex [TextNode] -> Either String [TextNode]
forall a. ByteString -> Alex a -> Either String a
runAlex Alex [TextNode]
Parser.parseTranslationUnit (ByteString -> Either String [TextNode])
-> (Text -> ByteString) -> Text -> Either String [TextNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

parseBytes :: LBS.ByteString -> Either String [TextNode]
parseBytes :: ByteString -> Either String [TextNode]
parseBytes = (ByteString -> Alex [TextNode] -> Either String [TextNode])
-> Alex [TextNode] -> ByteString -> Either String [TextNode]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Alex [TextNode] -> Either String [TextNode]
forall a. ByteString -> Alex a -> Either String a
runAlex Alex [TextNode]
Parser.parseTranslationUnit

parseBytesPedantic :: LBS.ByteString -> Either String [TextNode]
parseBytesPedantic :: ByteString -> Either String [TextNode]
parseBytesPedantic = ByteString -> Either String [TextNode]
parseBytes (ByteString -> Either String [TextNode])
-> ([TextNode] -> Either String [TextNode])
-> ByteString
-> Either String [TextNode]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ParseResult [TextNode] -> Either String [TextNode]
forall a. ParseResult a -> Either String a
ParseResult.toEither (ParseResult [TextNode] -> Either String [TextNode])
-> ([TextNode] -> ParseResult [TextNode])
-> [TextNode]
-> Either String [TextNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TextNode] -> ParseResult [TextNode]
TreeParser.parseTranslationUnit


parseFile :: FilePath -> IO (Either String (TranslationUnit Text))
parseFile :: String -> IO (Either String (TranslationUnit Text))
parseFile String
source =
    Either String [TextNode] -> Either String (TranslationUnit Text)
forall b. Either String b -> Either String (String, b)
addSource (Either String [TextNode] -> Either String (TranslationUnit Text))
-> (ByteString -> Either String [TextNode])
-> ByteString
-> Either String (TranslationUnit Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String [TextNode]
parseBytesPedantic (ByteString -> Either String (TranslationUnit Text))
-> IO ByteString -> IO (Either String (TranslationUnit Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
LBS.readFile String
source
  where
    -- Add source filename to the error message, if any.
    addSource :: Either String b -> Either String (String, b)
addSource (Left String
err) = String -> Either String (String, b)
forall a b. a -> Either a b
Left (String -> Either String (String, b))
-> String -> Either String (String, b)
forall a b. (a -> b) -> a -> b
$ String
source String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
    -- If there's no error message, record the source filename in the returned
    -- TranslationUnit.
    addSource (Right b
ok) = (String, b) -> Either String (String, b)
forall a b. b -> Either a b
Right (String
source, b
ok)


parseFiles' :: [FilePath] -> IO (Either String [TranslationUnit Text])
parseFiles' :: [String] -> IO (Either String [TranslationUnit Text])
parseFiles' [String]
sources = [Either String (TranslationUnit Text)]
-> Either String [TranslationUnit Text]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([Either String (TranslationUnit Text)]
 -> Either String [TranslationUnit Text])
-> IO [Either String (TranslationUnit Text)]
-> IO (Either String [TranslationUnit Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Either String (TranslationUnit Text)))
-> [String] -> IO [Either String (TranslationUnit Text)]
forall (m :: * -> *) a b.
MonadParallel m =>
(a -> m b) -> [a] -> m [b]
P.mapM String -> IO (Either String (TranslationUnit Text))
parseFile [String]
sources


parseFiles :: [FilePath] -> IO (Either String [TranslationUnit Text])
parseFiles :: [String] -> IO (Either String [TranslationUnit Text])
parseFiles [String]
sources = (Program Text -> [TranslationUnit Text])
-> Either String (Program Text)
-> Either String [TranslationUnit Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Program Text -> [TranslationUnit Text]
forall a. Program a -> [TranslationUnit a]
Program.toList (Either String (Program Text)
 -> Either String [TranslationUnit Text])
-> (Either String [TranslationUnit Text]
    -> Either String (Program Text))
-> Either String [TranslationUnit Text]
-> Either String [TranslationUnit Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String [TranslationUnit Text]
-> ([TranslationUnit Text] -> Either String (Program Text))
-> Either String (Program Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TranslationUnit Text] -> Either String (Program Text)
Program.fromList) (Either String [TranslationUnit Text]
 -> Either String [TranslationUnit Text])
-> IO (Either String [TranslationUnit Text])
-> IO (Either String [TranslationUnit Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO (Either String [TranslationUnit Text])
parseFiles' [String]
sources


parseProgram :: [FilePath] -> IO (Either String (Program Text))
parseProgram :: [String] -> IO (Either String (Program Text))
parseProgram [String]
sources = (Either String [TranslationUnit Text]
-> ([TranslationUnit Text] -> Either String (Program Text))
-> Either String (Program Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TranslationUnit Text] -> Either String (Program Text)
Program.fromList) (Either String [TranslationUnit Text]
 -> Either String (Program Text))
-> IO (Either String [TranslationUnit Text])
-> IO (Either String (Program Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO (Either String [TranslationUnit Text])
parseFiles' [String]
sources