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

import           Control.Monad.State.Lazy        (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.Parser          (parseCimple)
import           Language.Cimple.Program         (Program)
import qualified Language.Cimple.Program         as Program
import           Language.Cimple.TranslationUnit (TranslationUnit)

type CacheState a = State (Map String Text) a

cacheText :: String -> CacheState Text
cacheText :: String -> CacheState Text
cacheText 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 -> CacheState Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text
        Just Text
text ->
            Text -> CacheState Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text


process :: [Node (Lexeme String)] -> [Node (Lexeme Text)]
process :: [Node (Lexeme String)] -> [Node (Lexeme Text)]
process [Node (Lexeme String)]
stringAst =
    State (Map String Text) [Node (Lexeme Text)]
-> Map String Text -> [Node (Lexeme Text)]
forall s a. State s a -> s -> a
evalState ((Node (Lexeme String)
 -> StateT (Map String Text) Identity (Node (Lexeme Text)))
-> [Node (Lexeme String)]
-> State (Map String Text) [Node (Lexeme Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Lexeme String -> StateT (Map String Text) Identity (Lexeme Text))
-> Node (Lexeme String)
-> StateT (Map String Text) Identity (Node (Lexeme Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> CacheState Text)
-> Lexeme String -> StateT (Map String Text) Identity (Lexeme Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> CacheState Text
cacheText)) [Node (Lexeme String)]
stringAst) Map String Text
forall k a. Map k a
Map.empty


parseText :: Text -> Either String [Node (Lexeme Text)]
parseText :: Text -> Either String [Node (Lexeme Text)]
parseText Text
contents =
    [Node (Lexeme String)] -> [Node (Lexeme Text)]
process ([Node (Lexeme String)] -> [Node (Lexeme Text)])
-> Either String [Node (Lexeme String)]
-> Either String [Node (Lexeme Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String [Node (Lexeme String)]
res
  where
    res :: Either String [Node (Lexeme String)]
    res :: Either String [Node (Lexeme String)]
res = String
-> Alex [Node (Lexeme String)]
-> Either String [Node (Lexeme String)]
forall a. String -> Alex a -> Either String a
runAlex (Text -> String
Text.unpack Text
contents) Alex [Node (Lexeme String)]
parseCimple


parseFile :: FilePath -> IO (Either String (TranslationUnit Text))
parseFile :: String -> IO (Either String (TranslationUnit Text))
parseFile String
source =
    Either String [Node (Lexeme Text)]
-> Either String (TranslationUnit Text)
forall b. Either String b -> Either String (String, b)
addSource (Either String [Node (Lexeme Text)]
 -> Either String (TranslationUnit Text))
-> (ByteString -> Either String [Node (Lexeme Text)])
-> ByteString
-> Either String (TranslationUnit Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String [Node (Lexeme Text)]
parseText (Text -> Either String [Node (Lexeme Text)])
-> (ByteString -> Text)
-> ByteString
-> Either String [Node (Lexeme Text)]
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
"In file \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> 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 (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO (Either String (TranslationUnit Text))
parseFile [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