{-# 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                 as BS
import           Data.Map.Strict                 (Map)
import qualified Data.Map.Strict                 as Map
import           Data.Text                       (Text)
import qualified Data.Text                       as 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           Language.Cimple.Program         (Program)
import qualified Language.Cimple.Program         as Program
import           Language.Cimple.TranslationUnit (TranslationUnit)
import qualified Language.Cimple.TreeParser      as TreeParser

type StringNode = Node (Lexeme String)
type TextNode = Node (Lexeme Text)

toTextAst :: [StringNode] -> [TextNode]
toTextAst :: [StringNode] -> [TextNode]
toTextAst [StringNode]
stringAst =
    State (Map String Text) [TextNode] -> Map String Text -> [TextNode]
forall s a. State s a -> s -> a
evalState (AstActions (State (Map String Text)) String Text
-> [StringNode]
-> StateT
     (Map String Text) Identity (Mapped String Text [StringNode])
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 String Text)) String Text
cacheActions [StringNode]
stringAst) Map String Text
forall k a. Map k a
Map.empty
  where
    cacheActions :: TextActions (State (Map String Text)) String Text
    cacheActions :: AstActions (State (Map String Text)) String Text
cacheActions = (String -> State (Map String Text) Text)
-> AstActions (State (Map String Text)) String Text
forall (f :: * -> *) itext otext.
Applicative f =>
(itext -> f otext) -> TextActions f itext otext
textActions ((String -> State (Map String Text) Text)
 -> AstActions (State (Map String Text)) String Text)
-> (String -> State (Map String Text) Text)
-> AstActions (State (Map String Text)) String Text
forall a b. (a -> b) -> a -> b
$ \String
s -> do
        Map String Text
m <- StateT (Map String Text) Identity (Map String Text)
forall s (m :: * -> *). MonadState s m => m s
get
        case String -> Map String Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
s Map String Text
m of
            Maybe Text
Nothing -> do
                let text :: Text
text = String -> Text
Text.pack String
s
                Map String Text -> StateT (Map String Text) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Map String Text -> StateT (Map String Text) Identity ())
-> Map String Text -> StateT (Map String Text) Identity ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> Map String Text -> Map String Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
s Text
text Map String Text
m
                Text -> State (Map String Text) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text
            Just Text
text ->
                Text -> State (Map String Text) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text


parseText :: Text -> Either String [TextNode]
parseText :: Text -> Either String [TextNode]
parseText Text
contents =
    [StringNode] -> [TextNode]
toTextAst ([StringNode] -> [TextNode])
-> Either String [StringNode] -> Either String [TextNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Alex [StringNode] -> Either String [StringNode]
forall a. String -> Alex a -> Either String a
runAlex (Text -> String
Text.unpack Text
contents) Alex [StringNode]
Parser.parseTranslationUnit

parseTextPedantic :: Text -> Either String [TextNode]
parseTextPedantic :: Text -> Either String [TextNode]
parseTextPedantic =
    Text -> Either String [TextNode]
parseText (Text -> Either String [TextNode])
-> ([TextNode] -> Either String [TextNode])
-> Text
-> Either String [TextNode]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> TreeParser [TextNode] -> Either String [TextNode]
forall a. TreeParser a -> Either String a
TreeParser.toEither (TreeParser [TextNode] -> Either String [TextNode])
-> ([TextNode] -> TreeParser [TextNode])
-> [TextNode]
-> Either String [TextNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TextNode] -> TreeParser [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
. Text -> Either String [TextNode]
parseTextPedantic (Text -> Either String [TextNode])
-> (ByteString -> Text) -> ByteString -> Either String [TextNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (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
BS.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
":" 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