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

import           Apigen.Parser.Query        (declName)
import           Apigen.Parser.SymbolTable  (M, Name, SId, SIdToName, Sym,
                                             mustLookup, renameM)
import           Apigen.Types               (Decl (..))
import           Control.Arrow              (Arrow (first, second), (&&&))
import           Control.Monad.State.Strict (State)
import qualified Control.Monad.State.Strict as State
import           Data.Bifunctor             (Bifunctor (bimap))
import           Data.List                  (find, isPrefixOf, nub, sortOn)
import qualified Data.List                  as List
import           Data.List.Extra            (groupOn)
import           Data.Maybe                 (mapMaybe)
import           Data.Ord                   (Down (Down))
import qualified Data.Text                  as Text
import           Data.Tuple                 (swap)
import           Language.Cimple            (lexemeText)

namespaceNames :: [(Maybe (SId, Name), Sym)] -> [Name]
namespaceNames :: [(Maybe (SId, Name), Sym)] -> [Name]
namespaceNames =
    [Name] -> [Name]
forall a. Eq a => [a] -> [a]
nub
    ([Name] -> [Name])
-> ([(Maybe (SId, Name), Sym)] -> [Name])
-> [(Maybe (SId, Name), Sym)]
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (([Text] -> [Text]) -> Name -> Name
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
propertyPrefixes))))
    ([Name] -> [Name])
-> ([(Maybe (SId, Name), Sym)] -> [Name])
-> [(Maybe (SId, Name), Sym)]
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
hasProperty
    ([Name] -> [Name])
-> ([(Maybe (SId, Name), Sym)] -> [Name])
-> [(Maybe (SId, Name), Sym)]
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
isSpecial)
    ([Name] -> [Name])
-> ([(Maybe (SId, Name), Sym)] -> [Name])
-> [(Maybe (SId, Name), Sym)]
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe (SId, Name), Sym) -> Maybe Name)
-> [(Maybe (SId, Name), Sym)] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (((SId, Name) -> Name) -> Maybe (SId, Name) -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Text] -> [Text]) -> Name -> Name
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toLower) (Name -> Name) -> ((SId, Name) -> Name) -> (SId, Name) -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SId, Name) -> Name
forall a b. (a, b) -> b
snd) (Maybe (SId, Name) -> Maybe Name)
-> ((Maybe (SId, Name), Sym) -> Maybe (SId, Name))
-> (Maybe (SId, Name), Sym)
-> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (SId, Name), Sym) -> Maybe (SId, Name)
forall a b. (a, b) -> a
fst)

propertyPrefixes :: [Text.Text]
propertyPrefixes :: [Text]
propertyPrefixes = [Text
"get", Text
"set"]

hasProperty :: Name -> Bool
hasProperty :: Name -> Bool
hasProperty = ((Text -> Bool) -> [Text] -> Bool)
-> [Text] -> (Text -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Text]
propertyPrefixes ((Text -> Bool) -> Bool) -> (Name -> Text -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Text] -> Text -> Bool)
-> (Name -> [Text]) -> Name -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd

isSpecial :: Name -> Bool
isSpecial :: Name -> Bool
isSpecial = (([Text] -> Bool) -> [[Text]] -> Bool)
-> [[Text]] -> ([Text] -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Text] -> Bool) -> [[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [[Text]]
prefixes (([Text] -> Bool) -> Bool)
-> (Name -> [Text] -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [Text] -> Bool) -> [Text] -> [Text] -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf ([Text] -> [Text] -> Bool)
-> (Name -> [Text]) -> Name -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd
  where prefixes :: [[Text]]
prefixes = (Text -> [Text]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ Text
"callback"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
"err"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
"Err"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
propertyPrefixes

simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify :: SIdToName -> [Sym] -> (SIdToName, [Sym])
simplify SIdToName
st = ((SIdToName, ()) -> SIdToName)
-> ((SIdToName, ()), [Sym]) -> (SIdToName, [Sym])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (SIdToName, ()) -> SIdToName
forall a b. (a, b) -> a
fst (((SIdToName, ()), [Sym]) -> (SIdToName, [Sym]))
-> ([Sym] -> ((SIdToName, ()), [Sym]))
-> [Sym]
-> (SIdToName, [Sym])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sym], (SIdToName, ())) -> ((SIdToName, ()), [Sym])
forall a b. (a, b) -> (b, a)
swap (([Sym], (SIdToName, ())) -> ((SIdToName, ()), [Sym]))
-> ([Sym] -> ([Sym], (SIdToName, ())))
-> [Sym]
-> ((SIdToName, ()), [Sym])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (SIdToName, ()) [Sym]
 -> (SIdToName, ()) -> ([Sym], (SIdToName, ())))
-> (SIdToName, ())
-> State (SIdToName, ()) [Sym]
-> ([Sym], (SIdToName, ()))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (SIdToName, ()) [Sym]
-> (SIdToName, ()) -> ([Sym], (SIdToName, ()))
forall s a. State s a -> s -> (a, s)
State.runState (SIdToName
st, ()) (State (SIdToName, ()) [Sym] -> ([Sym], (SIdToName, ())))
-> ([Sym] -> State (SIdToName, ()) [Sym])
-> [Sym]
-> ([Sym], (SIdToName, ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sym -> StateT (SIdToName, ()) Identity Sym)
-> [Sym] -> State (SIdToName, ()) [Sym]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sym -> StateT (SIdToName, ()) Identity Sym
go
  where
    go :: Sym -> M () Sym
    go :: Sym -> StateT (SIdToName, ()) Identity Sym
go (Namespace [Text]
name [Sym]
mems) = [Text] -> [Sym] -> Sym
forall lexeme. [Text] -> [Decl lexeme] -> Decl lexeme
Namespace [Text]
name ([Sym] -> Sym)
-> State (SIdToName, ()) [Sym]
-> StateT (SIdToName, ()) Identity Sym
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sym -> StateT (SIdToName, ()) Identity Sym)
-> [Sym] -> State (SIdToName, ()) [Sym]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sym -> StateT (SIdToName, ()) Identity Sym
go [Sym]
mems

    go (ClassDecl Lexeme SId
name [Sym]
mems) = do
        [(Name, [(Maybe (SId, Name), Sym)])] -> State (SIdToName, ()) ()
stripNamespacesM [(Name, [(Maybe (SId, Name), Sym)])]
namespaced
        Sym -> StateT (SIdToName, ()) Identity Sym
forall (m :: * -> *) a. Monad m => a -> m a
return (Sym -> StateT (SIdToName, ()) Identity Sym)
-> Sym -> StateT (SIdToName, ()) Identity Sym
forall a b. (a -> b) -> a -> b
$ Lexeme SId -> [Sym] -> Sym
forall lexeme. lexeme -> [Decl lexeme] -> Decl lexeme
ClassDecl Lexeme SId
name ([Sym]
unnamespaced [Sym] -> [Sym] -> [Sym]
forall a. [a] -> [a] -> [a]
++ ((Name, [(Maybe (SId, Name), Sym)]) -> Sym)
-> [(Name, [(Maybe (SId, Name), Sym)])] -> [Sym]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [(Maybe (SId, Name), Sym)]) -> Sym
forall a a lexeme. ((a, [Text]), [(a, Decl lexeme)]) -> Decl lexeme
mkNamespace [(Name, [(Maybe (SId, Name), Sym)])]
namespaced)
      where
        mkNamespace :: ((a, [Text]), [(a, Decl lexeme)]) -> Decl lexeme
mkNamespace = ([Text] -> [Decl lexeme] -> Decl lexeme)
-> ([Text], [Decl lexeme]) -> Decl lexeme
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> [Decl lexeme] -> Decl lexeme
forall lexeme. [Text] -> [Decl lexeme] -> Decl lexeme
Namespace (([Text], [Decl lexeme]) -> Decl lexeme)
-> (((a, [Text]), [(a, Decl lexeme)]) -> ([Text], [Decl lexeme]))
-> ((a, [Text]), [(a, Decl lexeme)])
-> Decl lexeme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [Text]) -> [Text])
-> ([(a, Decl lexeme)] -> [Decl lexeme])
-> ((a, [Text]), [(a, Decl lexeme)])
-> ([Text], [Decl lexeme])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a, [Text]) -> [Text]
forall a b. (a, b) -> b
snd (((a, Decl lexeme) -> Decl lexeme)
-> [(a, Decl lexeme)] -> [Decl lexeme]
forall a b. (a -> b) -> [a] -> [b]
map (a, Decl lexeme) -> Decl lexeme
forall a b. (a, b) -> b
snd)

        -- Each class member mapped to its declaration name SId and Name.
        names :: [(Maybe (SId, Name), Sym)]
names = (Sym -> (Maybe (SId, Name), Sym))
-> [Sym] -> [(Maybe (SId, Name), Sym)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe SId -> Maybe (SId, Name))
-> (Maybe SId, Sym) -> (Maybe (SId, Name), Sym)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((SId -> (SId, Name)) -> Maybe SId -> Maybe (SId, Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SId -> (SId, Name)) -> Maybe SId -> Maybe (SId, Name))
-> (SId -> (SId, Name)) -> Maybe SId -> Maybe (SId, Name)
forall a b. (a -> b) -> a -> b
$ 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) ((Maybe SId, Sym) -> (Maybe (SId, Name), Sym))
-> (Sym -> (Maybe SId, Sym)) -> Sym -> (Maybe (SId, Name), Sym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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 -> Maybe SId) -> (Sym -> Sym) -> Sym -> (Maybe SId, Sym)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Sym -> Sym
forall a. a -> a
id)) [Sym]
mems
        nsNames :: [Name]
nsNames = [(Maybe (SId, Name), Sym)] -> [Name]
namespaceNames [(Maybe (SId, Name), Sym)]
names
        nss :: [(Maybe Name, [(Maybe (SId, Name), Sym)])]
nss = ((Maybe Name, [(Maybe (SId, Name), Sym)]) -> Maybe SId)
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Maybe SId -> (Name -> Maybe SId) -> Maybe Name -> Maybe SId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe SId
forall a. Maybe a
Nothing (Name -> [Name] -> Maybe SId
forall a. Eq a => a -> [a] -> Maybe SId
`List.elemIndex` [Name]
nsNames) (Maybe Name -> Maybe SId)
-> ((Maybe Name, [(Maybe (SId, Name), Sym)]) -> Maybe Name)
-> (Maybe Name, [(Maybe (SId, Name), Sym)])
-> Maybe SId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Name, [(Maybe (SId, Name), Sym)]) -> Maybe Name
forall a b. (a, b) -> a
fst) -- Restore original order.
              ([(Maybe Name, [(Maybe (SId, Name), Sym)])]
 -> [(Maybe Name, [(Maybe (SId, Name), Sym)])])
-> ([(Maybe (SId, Name), Sym)]
    -> [(Maybe Name, [(Maybe (SId, Name), Sym)])])
-> [(Maybe (SId, Name), Sym)]
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Name, (Maybe (SId, Name), Sym))]
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
forall a b. Ord a => [(a, b)] -> [(a, [b])]
collectByFst
              ([(Maybe Name, (Maybe (SId, Name), Sym))]
 -> [(Maybe Name, [(Maybe (SId, Name), Sym)])])
-> ([(Maybe (SId, Name), Sym)]
    -> [(Maybe Name, (Maybe (SId, Name), Sym))])
-> [(Maybe (SId, Name), Sym)]
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe (SId, Name), Sym)
 -> (Maybe Name, (Maybe (SId, Name), Sym)))
-> [(Maybe (SId, Name), Sym)]
-> [(Maybe Name, (Maybe (SId, Name), Sym))]
forall a b. (a -> b) -> [a] -> [b]
map ([Name]
-> (Maybe (SId, Name), Sym)
-> (Maybe Name, (Maybe (SId, Name), Sym))
select ([Name]
 -> (Maybe (SId, Name), Sym)
 -> (Maybe Name, (Maybe (SId, Name), Sym)))
-> ([Name] -> [Name])
-> [Name]
-> (Maybe (SId, Name), Sym)
-> (Maybe Name, (Maybe (SId, Name), Sym))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Down SId) -> [Name] -> [Name]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SId -> Down SId
forall a. a -> Down a
Down (SId -> Down SId) -> (Name -> SId) -> Name -> Down SId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> SId
forall (t :: * -> *) a. Foldable t => t a -> SId
length ([Text] -> SId) -> (Name -> [Text]) -> Name -> SId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd) ([Name]
 -> (Maybe (SId, Name), Sym)
 -> (Maybe Name, (Maybe (SId, Name), Sym)))
-> [Name]
-> (Maybe (SId, Name), Sym)
-> (Maybe Name, (Maybe (SId, Name), Sym))
forall a b. (a -> b) -> a -> b
$ [Name]
nsNames)
              ([(Maybe (SId, Name), Sym)]
 -> [(Maybe Name, [(Maybe (SId, Name), Sym)])])
-> [(Maybe (SId, Name), Sym)]
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
forall a b. (a -> b) -> a -> b
$ [(Maybe (SId, Name), Sym)]
names

        unnamespaced :: [Sym]
unnamespaced = [Sym]
-> ([(Maybe (SId, Name), Sym)] -> [Sym])
-> Maybe [(Maybe (SId, Name), Sym)]
-> [Sym]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (((Maybe (SId, Name), Sym) -> Sym)
-> [(Maybe (SId, Name), Sym)] -> [Sym]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (SId, Name), Sym) -> Sym
forall a b. (a, b) -> b
snd) (Maybe [(Maybe (SId, Name), Sym)] -> [Sym])
-> ([(Maybe Name, [(Maybe (SId, Name), Sym)])]
    -> Maybe [(Maybe (SId, Name), Sym)])
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
-> [Sym]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Name
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
-> Maybe [(Maybe (SId, Name), Sym)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Maybe Name
forall a. Maybe a
Nothing ([(Maybe Name, [(Maybe (SId, Name), Sym)])] -> [Sym])
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])] -> [Sym]
forall a b. (a -> b) -> a -> b
$ [(Maybe Name, [(Maybe (SId, Name), Sym)])]
nss
        namespaced :: [(Name, [(Maybe (SId, Name), Sym)])]
namespaced = ((Maybe Name, [(Maybe (SId, Name), Sym)])
 -> Maybe (Name, [(Maybe (SId, Name), Sym)]))
-> [(Maybe Name, [(Maybe (SId, Name), Sym)])]
-> [(Name, [(Maybe (SId, Name), Sym)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Maybe Name
ns, [(Maybe (SId, Name), Sym)]
mem) -> (,[(Maybe (SId, Name), Sym)]
mem) (Name -> (Name, [(Maybe (SId, Name), Sym)]))
-> Maybe Name -> Maybe (Name, [(Maybe (SId, Name), Sym)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
ns) [(Maybe Name, [(Maybe (SId, Name), Sym)])]
nss

    go Sym
x = Sym -> StateT (SIdToName, ()) Identity Sym
forall (m :: * -> *) a. Monad m => a -> m a
return Sym
x

stripNamespacesM :: [(Name, [(Maybe (SId, Name), Sym)])] -> State (SIdToName, ()) ()
stripNamespacesM :: [(Name, [(Maybe (SId, Name), Sym)])] -> State (SIdToName, ()) ()
stripNamespacesM =
    ((Name, [(Maybe (SId, Name), Sym)]) -> State (SIdToName, ()) ())
-> [(Name, [(Maybe (SId, Name), Sym)])] -> State (SIdToName, ()) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Name -> [SId] -> State (SIdToName, ()) ())
-> (Name, [SId]) -> State (SIdToName, ()) ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((SId -> State (SIdToName, ()) ())
-> [SId] -> State (SIdToName, ()) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((SId -> State (SIdToName, ()) ())
 -> [SId] -> State (SIdToName, ()) ())
-> (Name -> SId -> State (SIdToName, ()) ())
-> Name
-> [SId]
-> State (SIdToName, ()) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> SId -> State (SIdToName, ()) ()
forall s. (Name -> Name) -> SId -> M s ()
renameM ((Name -> Name) -> SId -> State (SIdToName, ()) ())
-> (Name -> Name -> Name)
-> Name
-> SId
-> State (SIdToName, ()) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SId -> Name -> Name
dropAfterErr (SId -> Name -> Name) -> (Name -> SId) -> Name -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> SId
forall (t :: * -> *) a. Foldable t => t a -> SId
length ([Text] -> SId) -> (Name -> [Text]) -> Name -> SId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd) ((Name, [SId]) -> State (SIdToName, ()) ())
-> ((Name, [(Maybe (SId, Name), Sym)]) -> (Name, [SId]))
-> (Name, [(Maybe (SId, Name), Sym)])
-> State (SIdToName, ()) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Maybe (SId, Name), Sym)] -> [SId])
-> (Name, [(Maybe (SId, Name), Sym)]) -> (Name, [SId])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Maybe (SId, Name), Sym) -> Maybe SId)
-> [(Maybe (SId, Name), Sym)] -> [SId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (((SId, Name) -> SId) -> Maybe (SId, Name) -> Maybe SId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SId, Name) -> SId
forall a b. (a, b) -> a
fst (Maybe (SId, Name) -> Maybe SId)
-> ((Maybe (SId, Name), Sym) -> Maybe (SId, Name))
-> (Maybe (SId, Name), Sym)
-> Maybe SId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (SId, Name), Sym) -> Maybe (SId, Name)
forall a b. (a, b) -> a
fst)))
  where
    dropAfterErr :: SId -> Name -> Name
dropAfterErr SId
n ([Text]
ns,x :: Text
x@Text
"Err":[Text]
xs)      = ([Text]
ns[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++SId -> [Text] -> [Text]
getNs SId
n [Text]
xs, Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
drop SId
n [Text]
xs)
    dropAfterErr SId
n ([Text]
ns,x :: Text
x@Text
"err":[Text]
xs)      = ([Text]
ns[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++SId -> [Text] -> [Text]
getNs SId
n [Text]
xs, Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
drop SId
n [Text]
xs)
    dropAfterErr SId
n ([Text]
ns,x :: Text
x@Text
"callback":[Text]
xs) = ([Text]
ns[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++SId -> [Text] -> [Text]
getNs SId
n [Text]
xs, Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
drop SId
n [Text]
xs)
    dropAfterErr SId
n ([Text]
ns,[Text]
xs)              = ([Text]
ns[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++SId -> [Text] -> [Text]
getNs SId
n [Text]
xs,   SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
drop SId
n [Text]
xs)

    getNs :: SId -> [Text] -> [Text]
getNs SId
n [Text]
xs = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toLower (SId -> [Text] -> [Text]
forall a. SId -> [a] -> [a]
take SId
n [Text]
xs)

select :: [Name] -> (Maybe (SId, Name), Sym) -> (Maybe Name, (Maybe (SId, Name), Sym))
select :: [Name]
-> (Maybe (SId, Name), Sym)
-> (Maybe Name, (Maybe (SId, Name), Sym))
select [Name]
nsNames (Maybe (SId, Name), Sym)
x =
    ((\Name
name -> (Name -> Bool) -> [Name] -> Maybe Name
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (([Text] -> [Text]) -> Name -> Name
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toLower) Name
name Name -> Name -> Bool
`isInNamespace`) [Name]
nsNames) (Name -> Maybe Name)
-> ((SId, Name) -> Name) -> (SId, Name) -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SId, Name) -> Name
forall a b. (a, b) -> b
snd ((SId, Name) -> Maybe Name) -> Maybe (SId, Name) -> Maybe Name
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Maybe (SId, Name), Sym) -> Maybe (SId, Name)
forall a b. (a, b) -> a
fst (Maybe (SId, Name), Sym)
x, (Maybe (SId, Name), Sym)
x)

isInNamespace :: Name -> Name -> Bool
isInNamespace :: Name -> Name -> Bool
isInNamespace ([Text]
_,Text
"callback":[Text]
name) = ([Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
name) ([Text] -> Bool) -> (Name -> [Text]) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd
isInNamespace ([Text]
_,Text
"err":[Text]
name)      = ([Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
name) ([Text] -> Bool) -> (Name -> [Text]) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd
isInNamespace ([Text]
_,[Text]
name)            = ([Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
name) ([Text] -> Bool) -> (Name -> [Text]) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Text]
forall a b. (a, b) -> b
snd

collectByFst :: Ord a => [(a, b)] -> [(a, [b])]
collectByFst :: [(a, b)] -> [(a, [b])]
collectByFst = ([(a, b)] -> (a, [b])) -> [[(a, b)]] -> [(a, [b])]
forall a b. (a -> b) -> [a] -> [b]
map [(a, b)] -> (a, [b])
forall a b. [(a, b)] -> (a, [b])
collapse ([[(a, b)]] -> [(a, [b])])
-> ([(a, b)] -> [[(a, b)]]) -> [(a, b)] -> [(a, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> [(a, b)] -> [[(a, b)]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn (a, b) -> a
forall a b. (a, b) -> a
fst ([(a, b)] -> [[(a, b)]])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [[(a, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> [(a, b)] -> [(a, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (a, b) -> a
forall a b. (a, b) -> a
fst
  where
    collapse :: [(a, b)] -> (a, [b])
collapse xs :: [(a, b)]
xs@((a, b)
x:[(a, b)]
_) = ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x, ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
xs)
    collapse [(a, b)]
_        = [Char] -> (a, [b])
forall a. HasCallStack => [Char] -> a
error [Char]
"collect: empty list unexpected"