module Query
  ( module Query.Type,
    query,
  )
where

import Control.Exception (throw)
import Data.Aeson qualified as J
import Data.Aeson.Key qualified as JK
import Data.Aeson.KeyMap qualified as JM
import Data.List (isSuffixOf)
import Data.List.NonEmpty qualified as N
import Data.Maybe (fromMaybe)
import Data.Vector qualified as V
import Exception (DecodeException (DecodeException))
import Query.Parser ()
import Query.Printer ()
import Query.Record
import Query.Type
import Store qualified as S
import System.FilePath ((</>))

query :: Query -> IO [J.Value]
query (Select fs c js es w) = do
  c' <-
    mapM (fmap (fromValue c) . decodeFile . (c </>)) =<< ls c
  js' <-
    mapM
      ( \(JoinClause t c w) ->
          fmap (\j' -> JoinClause t (map (fromValue c) j') w) . mapM (decodeFile . (c </>))
            =<< ls c
      )
      js
  es' <-
    mapM
      ( \(EmbedClause c w) ->
          fmap (\e' -> EmbedClause (fromValue c e') w) . mapM (decodeFile . (c </>))
            =<< ls c
      )
      es
  pure $ map (Query.select fs) $ where_ w $ embed es' $ join c' js'
  where
    ls c =
      filter (not . (isSuffixOf "/"))
        <$> S.withStore "." "HEAD" do
          S.listDirectory c

-- TODO use fold
embed ::
  EmbedClauses (Record [J.Value]) ->
  [Records J.Value] ->
  [Records J.Value]
embed es vss = embed' vss es
  where
    embed' vss [] = vss
    embed' vss (EmbedClause (Record c es) w : ess) =
      embed'
        ( map
            ( \vs ->
                let es' :: [J.Value]
                    es' = filter (\e -> satisfies w (vs ++ [Record c e])) es
                 in vs
                      ++ [ Record
                             c
                             ( J.Object
                                 ( JM.singleton
                                     (JK.fromString c)
                                     (J.Array (V.fromList es'))
                                 )
                             )
                         ]
            )
            vss
        )
        ess

-- TODO use fold
join ::
  Records J.Value ->
  JoinClauses (Records J.Value) ->
  [Records J.Value]
join vs js = join' (map (: []) vs) js
  where
    join' vss [] = vss
    join' vss (JoinClause JoinLeft js w : jss) =
      join'
        ( concatMap
            ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
                [] -> [vs]
                vs' -> vs'
            )
            vss
        )
        jss
    join' vss (JoinClause JoinRight js w : jss) =
      join'
        ( concatMap
            ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
                [] -> [[j]]
                vs' -> vs'
            )
            js
        )
        jss
    join' vss (JoinClause JoinFull js w : jss) =
      join'
        ( concatMap
            ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
                [] -> [vs]
                vs' -> vs'
            )
            vss
            ++ concatMap
              ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
                  [] -> [[j]]
                  _ -> []
              )
              js
        )
        jss

select :: FieldSelector -> Records J.Value -> J.Value
select All vs = disjointUnions (map toValue vs)
select (Only fs) vs = Query.Record.select (N.toList fs) vs

where_ :: Maybe WhereClause -> [Records J.Value] -> [Records J.Value]
where_ w = filter (satisfies w)

satisfies :: Maybe WhereClause -> Records J.Value -> Bool
satisfies Nothing _ = True
satisfies (Just (And ws)) vs = all (\w -> satisfies (Just w) vs) ws
satisfies (Just (Or ws)) vs = any (\w -> satisfies (Just w) vs) ws
satisfies (Just (Where (Eq f g))) vs = lookups f vs == lookups g vs

decodeFile :: J.FromJSON a => Collection -> IO a
decodeFile fp = S.withStore "." "HEAD" do
  fromMaybe (throw DecodeException) . J.decode <$> S.readFile fp