{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData      #-}
module Language.Cimple.Program
  ( Program
  , fromList
  , toList
  , includeGraph
  ) where

import           Data.Map.Strict                   (Map)
import qualified Data.Map.Strict                   as Map
import           Data.Text                         (Text)
import           Language.Cimple.Ast               (Node)
import           Language.Cimple.Graph             (Graph)
import qualified Language.Cimple.Graph             as Graph
import           Language.Cimple.Lexer             (Lexeme (..))
import           Language.Cimple.SemCheck.Includes (collectIncludes,
                                                    normaliseIncludes)
import           Language.Cimple.TranslationUnit   (TranslationUnit)


data Program text = Program
  { forall text. Program text -> Map String [Node (Lexeme text)]
progAsts     :: Map FilePath [Node (Lexeme text)]
  , forall text. Program text -> Graph () String
progIncludes :: Graph () FilePath
  }


toList :: Program a -> [TranslationUnit a]
toList :: forall a. Program a -> [TranslationUnit a]
toList = Map String [Node (Lexeme a)] -> [(String, [Node (Lexeme a)])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String [Node (Lexeme a)] -> [(String, [Node (Lexeme a)])])
-> (Program a -> Map String [Node (Lexeme a)])
-> Program a
-> [(String, [Node (Lexeme a)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program a -> Map String [Node (Lexeme a)]
forall text. Program text -> Map String [Node (Lexeme text)]
progAsts


includeGraph :: Program a -> [(FilePath, FilePath)]
includeGraph :: forall a. Program a -> [(String, String)]
includeGraph = Graph () String -> [(String, String)]
forall node key. Graph node key -> [(key, key)]
Graph.edges (Graph () String -> [(String, String)])
-> (Program a -> Graph () String)
-> Program a
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program a -> Graph () String
forall text. Program text -> Graph () String
progIncludes


fromList :: [TranslationUnit Text] -> Either String (Program Text)
fromList :: [TranslationUnit Text] -> Either String (Program Text)
fromList [TranslationUnit Text]
tus = do
    let tusWithIncludes :: [(TranslationUnit Text, [String])]
tusWithIncludes = (TranslationUnit Text -> (TranslationUnit Text, [String]))
-> [TranslationUnit Text] -> [(TranslationUnit Text, [String])]
forall a b. (a -> b) -> [a] -> [b]
map TranslationUnit Text -> (TranslationUnit Text, [String])
normaliseIncludes [TranslationUnit Text]
tus
    let progAsts :: Map String [Node (Lexeme Text)]
progAsts = [TranslationUnit Text] -> Map String [Node (Lexeme Text)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([TranslationUnit Text] -> Map String [Node (Lexeme Text)])
-> ([(TranslationUnit Text, [String])] -> [TranslationUnit Text])
-> [(TranslationUnit Text, [String])]
-> Map String [Node (Lexeme Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TranslationUnit Text, [String]) -> TranslationUnit Text)
-> [(TranslationUnit Text, [String])] -> [TranslationUnit Text]
forall a b. (a -> b) -> [a] -> [b]
map (TranslationUnit Text, [String]) -> TranslationUnit Text
forall a b. (a, b) -> a
fst ([(TranslationUnit Text, [String])]
 -> Map String [Node (Lexeme Text)])
-> [(TranslationUnit Text, [String])]
-> Map String [Node (Lexeme Text)]
forall a b. (a -> b) -> a -> b
$ [(TranslationUnit Text, [String])]
tusWithIncludes
    -- Check whether all includes can be resolved.
    [((), String, [String])]
includeEdges <- ((TranslationUnit Text, [String])
 -> Either String ((), String, [String]))
-> [(TranslationUnit Text, [String])]
-> Either String [((), String, [String])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((TranslationUnit Text
 -> [String] -> Either String ((), String, [String]))
-> (TranslationUnit Text, [String])
-> Either String ((), String, [String])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((TranslationUnit Text
  -> [String] -> Either String ((), String, [String]))
 -> (TranslationUnit Text, [String])
 -> Either String ((), String, [String]))
-> (TranslationUnit Text
    -> [String] -> Either String ((), String, [String]))
-> (TranslationUnit Text, [String])
-> Either String ((), String, [String])
forall a b. (a -> b) -> a -> b
$ [String]
-> TranslationUnit Text
-> [String]
-> Either String ((), String, [String])
collectIncludes ([String]
 -> TranslationUnit Text
 -> [String]
 -> Either String ((), String, [String]))
-> [String]
-> TranslationUnit Text
-> [String]
-> Either String ((), String, [String])
forall a b. (a -> b) -> a -> b
$ (TranslationUnit Text -> String)
-> [TranslationUnit Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TranslationUnit Text -> String
forall a b. (a, b) -> a
fst [TranslationUnit Text]
tus) [(TranslationUnit Text, [String])]
tusWithIncludes
    let progIncludes :: Graph () String
progIncludes = [((), String, [String])] -> Graph () String
forall key node. Ord key => [(node, key, [key])] -> Graph node key
Graph.fromEdges [((), String, [String])]
includeEdges
    Program Text -> Either String (Program Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Program{Map String [Node (Lexeme Text)]
Graph () String
progIncludes :: Graph () String
progAsts :: Map String [Node (Lexeme Text)]
progIncludes :: Graph () String
progAsts :: Map String [Node (Lexeme Text)]
..}