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

import Control.Arrow (second)
import Control.Exception (throw)
import Control.Monad.Trans (lift)
import Data.Aeson qualified as J
import Data.Aeson.Encode.Pretty qualified as JP
import Data.Aeson.Key qualified as JK
import Data.Aeson.KeyMap qualified as JM
import Data.List (foldl', foldl1')
import Data.Map qualified as M
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Vector qualified as V
import Store.Exception (DecodeException (DecodeException), MissingFileName (MissingFileName))
import Store.Query.Parser ()
import Store.Query.Printer ()
import Store.Query.Record
import Store.Query.Type
import Store.Store qualified as S
import System.FilePath ((</>))

query :: Query -> S.StoreM [J.Value]
query (Delete c w) = do
  c' <-
    mapM (\fn -> fmap ((fn,) . fromValue c) . decodeFile c $ fn)
      =<< S.listFiles c
  let fps = map fst $ whereBy snd w (map (second (: [])) c')
  lift $ print fps
  mapM_ S.deleteFile (map (c </>) fps)
  S.commit
  pure []
query (Insert vs c) = do
  let vs' = map (\v -> ((c, fileName v), v)) vs

      fileName v@(J.Object kvs) =
        case JM.lookup "$fileName" kvs of
          Just (J.String fileName) -> T.unpack fileName
          _ -> throw (MissingFileName v)
  mapM_ (\((c, fn), v) -> encodeFile c fn v) vs'
  S.commit
  pure []
query (Select fs c js es w) = do
  c' <-
    mapM (\fn -> fromValue c <$> decodeFile c fn)
      =<< S.listFiles c
  js' <-
    mapM
      ( \(JoinClause t c w) ->
          fmap (\j' -> JoinClause t (map (fromValue c) j') w)
            . mapM (decodeFile c)
            =<< S.listFiles c
      )
      js
  es' <-
    mapM
      ( \(EmbedClause c w) ->
          fmap (\e' -> EmbedClause (fromValue c e') w)
            . mapM (decodeFile c)
            =<< S.listFiles c
      )
      es
  pure $ map (Store.Query.select fs) $ where_ w $ embeds es' $ joins js' c'
query (Update c v w) = do
  c' <-
    mapM (\fn -> fmap (((c, fn),) . fromValue c) . decodeFile c $ fn)
      =<< S.listFiles c
  let c'' = whereBy snd w (map (second (: [])) c')
  mapM_
    ( \((c, fn), v') ->
        encodeFile c fn (foldl1' union (map toValue v') `union` v)
    )
    c''
  S.commit
  pure []

embeds ::
  EmbedClauses (Record [J.Value]) ->
  [Records J.Value] ->
  [Records J.Value]
embeds = flip (foldl' embed)

embed ::
  [Records J.Value] ->
  EmbedClause (Record [J.Value]) ->
  [Records J.Value]
embed vss (EmbedClause (Record c es) w) =
  map
    ( \vs ->
        vs
          ++ [ fromValue
                 c
                 ( J.Array
                     ( V.fromList
                         [ e
                           | e <- es,
                             satisfies w (vs ++ [Record c e])
                         ]
                     )
                 )
             ]
    )
    vss

joins ::
  JoinClauses (Records J.Value) ->
  [Record J.Value] ->
  [Records J.Value]
joins js (map (: []) -> vss) = foldl' join vss js

join ::
  [Records J.Value] ->
  JoinClause (Records J.Value) ->
  [Records J.Value]
join vss (JoinClause JoinLeft js w) =
  concatMap
    ( \vs -> case filter (satisfies w) $ map (\j -> vs ++ [j]) js of
        [] -> [vs]
        vs' -> vs'
    )
    vss
join vss (JoinClause JoinRight js w) =
  concatMap
    ( \j -> case filter (satisfies w) $ map (\vs -> vs ++ [j]) vss of
        [] -> [[j]]
        vs' -> vs'
    )
    js
join vss (JoinClause JoinFull js w) =
  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

select :: FieldSelector -> Records J.Value -> J.Value
select (SelectObject kvs) vs =
  J.Object
    . JM.fromMap
    . M.mapKeys JK.fromString
    . (M.map (\s -> Store.Query.select s vs))
    $ kvs
select (SelectField f) vs = fromMaybe J.Null (lookups f vs)

where_ :: Maybe WhereClause -> [Records J.Value] -> [Records J.Value]
where_ = whereBy id

whereBy :: (a -> [Record J.Value]) -> Maybe WhereClause -> [a] -> [a]
whereBy f w = filter (satisfies w . f)

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 = either Just (flip lookups vs) f == either Just (flip lookups vs) g

decodeFile :: String -> String -> S.StoreM J.Value
decodeFile c fn = do
  let fp = c </> fn
  union (J.Object (JM.singleton "$fileName" (J.String (T.pack fn))))
    . fromMaybe (throw DecodeException)
    . J.decode
    <$> S.readFile fp

encodeFile :: String -> String -> J.Value -> S.StoreM ()
encodeFile c fn (J.Object kvs) = do
  let fp = c </> fn
  S.writeFile fp (JP.encodePretty (J.Object (JM.filterWithKey (\k _ -> k /= "$fileName") kvs)))