{-# OPTIONS_GHC -Wwarn #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE TupleSections     #-}
module Apigen.Parser.InferSizedGet (simplify) where

import           Apigen.Parser.Query       (declName)
import           Apigen.Parser.SymbolTable (Name, SId, SIdToName, Sym,
                                            mustLookup)
import           Apigen.Types              (Constness (ConstThis), Decl (..))
import           Control.Arrow             (Arrow (first), (&&&))
import           Data.List                 (isSuffixOf)
import qualified Data.List                 as List
import           Data.Maybe                (mapMaybe)
import           Data.Text                 (Text)
import           Language.Cimple           (Lexeme, lexemeText)

simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify SIdToName
st [Sym]
decls = (SIdToName
st, (Sym -> Sym) -> [Sym] -> [Sym]
forall a b. (a -> b) -> [a] -> [b]
map Sym -> Sym
go [Sym]
decls)
  where
    go :: Sym -> Sym
    go :: Sym -> Sym
go (Namespace [Text]
ns [Sym]
mems) =
        [Text] -> [Sym] -> Sym
forall lexeme. [Text] -> [Decl lexeme] -> Decl lexeme
Namespace [Text]
ns ([Sym] -> Sym) -> [Sym] -> Sym
forall a b. (a -> b) -> a -> b
$ (Sym -> Sym) -> [Sym] -> [Sym]
forall a b. (a -> b) -> [a] -> [b]
map (SIdToName -> [([Text], Lexeme SId)] -> Sym -> Sym
inject SIdToName
st [([Text], Lexeme SId)]
names (Sym -> Sym) -> (Sym -> Sym) -> Sym -> Sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sym -> Sym
go) [Sym]
mems
      where
        names :: [([Text], Lexeme SId)]
names = ((Name, Lexeme SId) -> Maybe ([Text], Lexeme SId))
-> [(Name, Lexeme SId)] -> [([Text], Lexeme SId)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Maybe [Text], Lexeme SId) -> Maybe ([Text], Lexeme SId)
forall a b. (Maybe a, b) -> Maybe (a, b)
hoistMaybe ((Maybe [Text], Lexeme SId) -> Maybe ([Text], Lexeme SId))
-> ((Name, Lexeme SId) -> (Maybe [Text], Lexeme SId))
-> (Name, Lexeme SId)
-> Maybe ([Text], Lexeme SId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Maybe [Text])
-> (Name, Lexeme SId) -> (Maybe [Text], Lexeme SId)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Name -> Maybe [Text]
getterForSize) ([(Name, Lexeme SId)] -> [([Text], Lexeme SId)])
-> ([Sym] -> [(Name, Lexeme SId)])
-> [Sym]
-> [([Text], Lexeme SId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sym -> Maybe (Name, Lexeme SId)) -> [Sym] -> [(Name, Lexeme SId)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Lexeme SId -> (Name, Lexeme SId))
-> Maybe (Lexeme SId) -> Maybe (Name, Lexeme SId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SIdToName -> SId -> Name
mustLookup SIdToName
st (SId -> Name) -> (Lexeme SId -> SId) -> Lexeme SId -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme SId -> SId
forall text. Lexeme text -> text
lexemeText (Lexeme SId -> Name)
-> (Lexeme SId -> Lexeme SId) -> Lexeme SId -> (Name, Lexeme SId)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Lexeme SId -> Lexeme SId
forall a. a -> a
id) (Maybe (Lexeme SId) -> Maybe (Name, Lexeme SId))
-> (Sym -> Maybe (Lexeme SId)) -> Sym -> Maybe (Name, Lexeme SId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sym -> Maybe (Lexeme SId)
declName) ([Sym] -> [([Text], Lexeme SId)])
-> [Sym] -> [([Text], Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ [Sym]
mems
    go (ClassDecl Lexeme SId
ns [Sym]
mems) =
        Lexeme SId -> [Sym] -> Sym
forall lexeme. lexeme -> [Decl lexeme] -> Decl lexeme
ClassDecl Lexeme SId
ns ([Sym] -> Sym) -> [Sym] -> Sym
forall a b. (a -> b) -> a -> b
$ (Sym -> Sym) -> [Sym] -> [Sym]
forall a b. (a -> b) -> [a] -> [b]
map (SIdToName -> [([Text], Lexeme SId)] -> Sym -> Sym
inject SIdToName
st [([Text], Lexeme SId)]
names (Sym -> Sym) -> (Sym -> Sym) -> Sym -> Sym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sym -> Sym
go) [Sym]
mems
      where
        names :: [([Text], Lexeme SId)]
names = ((Name, Lexeme SId) -> Maybe ([Text], Lexeme SId))
-> [(Name, Lexeme SId)] -> [([Text], Lexeme SId)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Maybe [Text], Lexeme SId) -> Maybe ([Text], Lexeme SId)
forall a b. (Maybe a, b) -> Maybe (a, b)
hoistMaybe ((Maybe [Text], Lexeme SId) -> Maybe ([Text], Lexeme SId))
-> ((Name, Lexeme SId) -> (Maybe [Text], Lexeme SId))
-> (Name, Lexeme SId)
-> Maybe ([Text], Lexeme SId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Maybe [Text])
-> (Name, Lexeme SId) -> (Maybe [Text], Lexeme SId)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Name -> Maybe [Text]
getterForSize) ([(Name, Lexeme SId)] -> [([Text], Lexeme SId)])
-> ([Sym] -> [(Name, Lexeme SId)])
-> [Sym]
-> [([Text], Lexeme SId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sym -> Maybe (Name, Lexeme SId)) -> [Sym] -> [(Name, Lexeme SId)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Lexeme SId -> (Name, Lexeme SId))
-> Maybe (Lexeme SId) -> Maybe (Name, Lexeme SId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SIdToName -> SId -> Name
mustLookup SIdToName
st (SId -> Name) -> (Lexeme SId -> SId) -> Lexeme SId -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme SId -> SId
forall text. Lexeme text -> text
lexemeText (Lexeme SId -> Name)
-> (Lexeme SId -> Lexeme SId) -> Lexeme SId -> (Name, Lexeme SId)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Lexeme SId -> Lexeme SId
forall a. a -> a
id) (Maybe (Lexeme SId) -> Maybe (Name, Lexeme SId))
-> (Sym -> Maybe (Lexeme SId)) -> Sym -> Maybe (Name, Lexeme SId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sym -> Maybe (Lexeme SId)
declName) ([Sym] -> [([Text], Lexeme SId)])
-> [Sym] -> [([Text], Lexeme SId)]
forall a b. (a -> b) -> a -> b
$ [Sym]
mems

    go Sym
x = Sym
x

inject :: SIdToName -> [([Text], Lexeme SId)] -> Sym -> Sym
inject :: SIdToName -> [([Text], Lexeme SId)] -> Sym -> Sym
inject SIdToName
st [([Text], Lexeme SId)]
names Sym
sym =
    case ([Text] -> [([Text], Lexeme SId)] -> Maybe (Lexeme SId))
-> [([Text], Lexeme SId)] -> [Text] -> Maybe (Lexeme SId)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Text] -> [([Text], Lexeme SId)] -> Maybe (Lexeme SId)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup [([Text], Lexeme SId)]
names ([Text] -> Maybe (Lexeme SId))
-> (Lexeme SId -> [Text]) -> Lexeme SId -> Maybe (Lexeme SId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd (Name -> [Text]) -> (Lexeme SId -> Name) -> Lexeme SId -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SIdToName -> SId -> Name
mustLookup SIdToName
st (SId -> Name) -> (Lexeme SId -> SId) -> Lexeme SId -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme SId -> SId
forall text. Lexeme text -> text
lexemeText (Lexeme SId -> Maybe (Lexeme SId))
-> Maybe (Lexeme SId) -> Maybe (Lexeme SId)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sym -> Maybe (Lexeme SId)
declName Sym
sym of
        Just Lexeme SId
sizer -> Lexeme SId -> Sym -> Sym
makeArraySized Lexeme SId
sizer Sym
sym
        Maybe (Lexeme SId)
_          -> Sym
sym

makeArraySized :: Lexeme SId -> Sym -> Sym
makeArraySized :: Lexeme SId -> Sym -> Sym
makeArraySized Lexeme SId
sizer (Method Constness
ConstThis Sym
ret Lexeme SId
name [Sym]
params) =
    Constness -> Sym -> Lexeme SId -> [Sym] -> Sym
forall lexeme.
Constness -> Decl lexeme -> lexeme -> [Decl lexeme] -> Decl lexeme
Method Constness
ConstThis Sym
ret Lexeme SId
name ([Sym] -> Sym) -> [Sym] -> Sym
forall a b. (a -> b) -> a -> b
$ (Sym -> Sym) -> [Sym] -> [Sym]
forall a b. (a -> b) -> [a] -> [b]
map Sym -> Sym
go [Sym]
params
  where
    go :: Sym -> Sym
    go :: Sym -> Sym
go (Var (ArrayType     BuiltinType
ty) Lexeme SId
var) = Sym -> Lexeme SId -> Sym
forall lexeme. Decl lexeme -> lexeme -> Decl lexeme
Var (Sym -> Sym -> Sym
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
SizedArrayType (BuiltinType -> Sym
forall lexeme. BuiltinType -> Decl lexeme
BuiltinType BuiltinType
ty) (Lexeme SId -> Sym
forall lexeme. lexeme -> Decl lexeme
Ref Lexeme SId
sizer)) Lexeme SId
var
    go (Var (UserArrayType Lexeme SId
ty) Lexeme SId
var) = Sym -> Lexeme SId -> Sym
forall lexeme. Decl lexeme -> lexeme -> Decl lexeme
Var (Sym -> Sym -> Sym
forall lexeme. Decl lexeme -> Decl lexeme -> Decl lexeme
SizedArrayType (Lexeme SId -> Sym
forall lexeme. lexeme -> Decl lexeme
Typename    Lexeme SId
ty) (Lexeme SId -> Sym
forall lexeme. lexeme -> Decl lexeme
Ref Lexeme SId
sizer)) Lexeme SId
var
    go Sym
var = Sym
var
makeArraySized Lexeme SId
_ Sym
sym = Sym
sym

getterForSize :: Name -> Maybe [Text]
getterForSize :: Name -> Maybe [Text]
getterForSize ([Text]
_, name :: [Text]
name@(Text
"get":[Text]
_)) | [Text
"size"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Text]
name = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
take ([Text] -> SId
forall (t :: * -> *) a. Foldable t => t a -> SId
length [Text]
name SId -> SId -> SId
forall a. Num a => a -> a -> a
- SId
1) [Text]
name)
getterForSize Name
_  = Maybe [Text]
forall a. Maybe a
Nothing

hoistMaybe :: (Maybe a, b) -> Maybe (a, b)
hoistMaybe :: (Maybe a, b) -> Maybe (a, b)
hoistMaybe (Maybe a
a, b
b) = (,b
b) (a -> (a, b)) -> Maybe a -> Maybe (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
a