-- | Pretty easy since doesn't need renaming.
--
-- Just thread lexer state through, remove duplicates.
module Kempe.Module ( parseProcess
                    ) where

import           Control.Exception          (Exception, throwIO)
import qualified Data.ByteString.Lazy       as BSL
import qualified Data.ByteString.Lazy.Char8 as ASCII
import qualified Data.Set                   as S
import           Data.Tuple.Extra           (fst3, third3)
import           Kempe.AST
import           Kempe.Lexer
import           Kempe.Parser


parseProcess :: FilePath -> IO (Int, Declarations AlexPosn AlexPosn AlexPosn)
parseProcess :: FilePath -> IO (Int, Declarations AlexPosn AlexPosn AlexPosn)
parseProcess FilePath
fp = do
    (AlexUserState
st, [], Declarations AlexPosn AlexPosn AlexPosn
ds) <- Bool
-> [FilePath]
-> AlexUserState
-> IO
     (AlexUserState, [FilePath],
      Declarations AlexPosn AlexPosn AlexPosn)
loopFps Bool
True [FilePath
fp] AlexUserState
alexInitUserState
    (Int, Declarations AlexPosn AlexPosn AlexPosn)
-> IO (Int, Declarations AlexPosn AlexPosn AlexPosn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexUserState -> Int
forall a b c. (a, b, c) -> a
fst3 AlexUserState
st, {-# SCC "dedup" #-} Declarations AlexPosn AlexPosn AlexPosn
-> Declarations AlexPosn AlexPosn AlexPosn
forall a. Ord a => [a] -> [a]
dedup Declarations AlexPosn AlexPosn AlexPosn
ds)

yeetIO :: Exception e => Either e a -> IO a
yeetIO :: Either e a -> IO a
yeetIO = (e -> IO a) -> (a -> IO a) -> Either e a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- TODO: if module is imported, discard its exports
loopFps :: Bool -> [FilePath] -> AlexUserState -> IO (AlexUserState, [FilePath], Declarations AlexPosn AlexPosn AlexPosn)
loopFps :: Bool
-> [FilePath]
-> AlexUserState
-> IO
     (AlexUserState, [FilePath],
      Declarations AlexPosn AlexPosn AlexPosn)
loopFps Bool
_ [] AlexUserState
st = (AlexUserState, [FilePath],
 Declarations AlexPosn AlexPosn AlexPosn)
-> IO
     (AlexUserState, [FilePath],
      Declarations AlexPosn AlexPosn AlexPosn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexUserState
st, [], [])
loopFps Bool
isInit (FilePath
fp:[FilePath]
fps) AlexUserState
st = do
    (AlexUserState
st', Module [ByteString]
is Declarations AlexPosn AlexPosn AlexPosn
ds) <- FilePath
-> AlexUserState
-> IO (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
parseStep FilePath
fp AlexUserState
st
    let discardDs :: [KempeDecl a c b] -> [KempeDecl a c b]
discardDs = if Bool
isInit then [KempeDecl a c b] -> [KempeDecl a c b]
forall a. a -> a
id else (KempeDecl a c b -> Bool) -> [KempeDecl a c b] -> [KempeDecl a c b]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (KempeDecl a c b -> Bool) -> KempeDecl a c b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KempeDecl a c b -> Bool
forall a c b. KempeDecl a c b -> Bool
isExport)
    (Declarations AlexPosn AlexPosn AlexPosn
 -> Declarations AlexPosn AlexPosn AlexPosn)
-> (AlexUserState, [FilePath],
    Declarations AlexPosn AlexPosn AlexPosn)
-> (AlexUserState, [FilePath],
    Declarations AlexPosn AlexPosn AlexPosn)
forall c c' a b. (c -> c') -> (a, b, c) -> (a, b, c')
third3 (Declarations AlexPosn AlexPosn AlexPosn
-> Declarations AlexPosn AlexPosn AlexPosn
-> Declarations AlexPosn AlexPosn AlexPosn
forall a. [a] -> [a] -> [a]
++ Declarations AlexPosn AlexPosn AlexPosn
-> Declarations AlexPosn AlexPosn AlexPosn
forall a c b. [KempeDecl a c b] -> [KempeDecl a c b]
discardDs Declarations AlexPosn AlexPosn AlexPosn
ds) ((AlexUserState, [FilePath],
  Declarations AlexPosn AlexPosn AlexPosn)
 -> (AlexUserState, [FilePath],
     Declarations AlexPosn AlexPosn AlexPosn))
-> IO
     (AlexUserState, [FilePath],
      Declarations AlexPosn AlexPosn AlexPosn)
-> IO
     (AlexUserState, [FilePath],
      Declarations AlexPosn AlexPosn AlexPosn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> [FilePath]
-> AlexUserState
-> IO
     (AlexUserState, [FilePath],
      Declarations AlexPosn AlexPosn AlexPosn)
loopFps Bool
False ((ByteString -> FilePath) -> [ByteString] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FilePath
ASCII.unpack ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
is) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
fps) AlexUserState
st'
    where isExport :: KempeDecl a c b -> Bool
isExport Export{} = Bool
True
          isExport KempeDecl a c b
_        = Bool
False

parseStep :: FilePath -> AlexUserState -> IO (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
parseStep :: FilePath
-> AlexUserState
-> IO (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
parseStep FilePath
fp AlexUserState
st = do
    ByteString
contents <- FilePath -> IO ByteString
BSL.readFile FilePath
fp
    Either
  (ParseError AlexPosn)
  (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
-> IO (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
forall e a. Exception e => Either e a -> IO a
yeetIO (Either
   (ParseError AlexPosn)
   (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
 -> IO (AlexUserState, Module AlexPosn AlexPosn AlexPosn))
-> Either
     (ParseError AlexPosn)
     (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
-> IO (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
forall a b. (a -> b) -> a -> b
$ ByteString
-> AlexUserState
-> Either
     (ParseError AlexPosn)
     (AlexUserState, Module AlexPosn AlexPosn AlexPosn)
parseWithCtx ByteString
contents AlexUserState
st

dedup :: Ord a => [a] -> [a]
dedup :: [a] -> [a]
dedup = Set a -> [a] -> [a]
forall a. Ord a => Set a -> [a] -> [a]
loop Set a
forall a. Set a
S.empty
    where loop :: Set a -> [a] -> [a]
loop Set a
_ [] = []
          loop Set a
acc (a
x:[a]
xs) =
            if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
x Set a
acc
                then Set a -> [a] -> [a]
loop Set a
acc [a]
xs
                else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
loop (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
acc) [a]
xs