{-# LANGUAGE Strict #-}
module Apigen.Parser.InferNamespace (simplify) where

import           Apigen.Parser.Query       (declName)
import           Apigen.Parser.SymbolTable (Name, SId, SIdToName, Sym,
                                            mustLookup)
import           Apigen.Types              (Decl (..))
import           Control.Arrow             (second, (&&&))
import           Data.Bifunctor            (Bifunctor (bimap))
import qualified Data.HashMap.Strict       as HashMap
import           Data.Maybe                (mapMaybe)
import           Data.Text                 (Text)
import qualified Data.Text                 as Text
import           Language.Cimple           (lexemeText)

commonPrefix :: Eq a => [[a]] -> [a]
commonPrefix :: [[a]] -> [a]
commonPrefix [] = []
commonPrefix ([a]
first:[[a]]
rest) = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
go [a]
first [[a]]
rest
  where
    go :: [a] -> [a] -> [a]
go [a]
_ [] = []
    go [] [a]
_ = []
    go (a
x:[a]
xs) (a
y:[a]
ys)
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
xs [a]
ys
      | Bool
otherwise = []

simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify SIdToName
st [Sym]
decls = (SIdToName
renamed, [[Text] -> [Sym] -> Sym
forall lexeme. [Text] -> [Decl lexeme] -> Decl lexeme
Namespace [Text]
namespace [Sym]
decls])
  where
    sids :: [(SId, Name)]
    sids :: [(SId, Name)]
sids = (SId -> (SId, Name)) -> [SId] -> [(SId, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (SId -> SId
forall a. a -> a
id (SId -> SId) -> (SId -> Name) -> SId -> (SId, Name)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SIdToName -> SId -> Name
mustLookup SIdToName
st) ([SId] -> [(SId, Name)]) -> [SId] -> [(SId, Name)]
forall a b. (a -> b) -> a -> b
$ (Sym -> Maybe SId) -> [Sym] -> [SId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Lexeme SId -> SId) -> Maybe (Lexeme SId) -> Maybe SId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Lexeme SId -> SId
forall text. Lexeme text -> text
lexemeText (Maybe (Lexeme SId) -> Maybe SId)
-> (Sym -> Maybe (Lexeme SId)) -> Sym -> Maybe SId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sym -> Maybe (Lexeme SId)
declName) [Sym]
decls

    namespace :: [Text]
    namespace :: [Text]
namespace = [[Text]] -> [Text]
forall a. Eq a => [[a]] -> [a]
commonPrefix ([[Text]] -> [Text])
-> ([(SId, Name)] -> [[Text]]) -> [(SId, Name)] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SId, Name) -> [Text]) -> [(SId, Name)] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toLower ([Text] -> [Text])
-> ((SId, Name) -> [Text]) -> (SId, Name) -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd (Name -> [Text]) -> ((SId, Name) -> Name) -> (SId, Name) -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SId, Name) -> Name
forall a b. (a, b) -> b
snd) ([(SId, Name)] -> [Text]) -> [(SId, Name)] -> [Text]
forall a b. (a -> b) -> a -> b
$ [(SId, Name)]
sids

    renamed :: SIdToName
renamed = ((SId, Name) -> SIdToName -> SIdToName)
-> SIdToName -> [(SId, Name)] -> SIdToName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((SId -> Name -> SIdToName -> SIdToName)
-> (SId, Name) -> SIdToName -> SIdToName
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SId -> Name -> SIdToName -> SIdToName
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert ((SId, Name) -> SIdToName -> SIdToName)
-> ((SId, Name) -> (SId, Name))
-> (SId, Name)
-> SIdToName
-> SIdToName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name -> Name) -> (SId, Name) -> (SId, Name)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Name -> Name) -> (SId, Name) -> (SId, Name))
-> ([Text] -> Name -> Name) -> [Text] -> (SId, Name) -> (SId, Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [Text]) -> ([Text] -> [Text]) -> Name -> Name
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Text] -> [Text] -> [Text]
forall a b. a -> b -> a
const [Text]
namespace) (([Text] -> [Text]) -> Name -> Name)
-> ([Text] -> [Text] -> [Text]) -> [Text] -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
drop (SId -> [Text] -> [Text])
-> ([Text] -> SId) -> [Text] -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> SId
forall (t :: * -> *) a. Foldable t => t a -> SId
length ([Text] -> (SId, Name) -> (SId, Name))
-> [Text] -> (SId, Name) -> (SId, Name)
forall a b. (a -> b) -> a -> b
$ [Text]
namespace)) SIdToName
st [(SId, Name)]
sids