module ContentStore where

import Research
import Parser

import Control.Monad                  (foldM, forM)
import Crypto.Hash                    (hash, SHA256, Digest)
import Data.ByteString                (ByteString)
import Data.List                      (intercalate, nub, sortBy, sort)
import Data.Maybe                     (catMaybes)
import Data.Text                      (Text)
import Database.SQLite.Simple
import Database.SQLite.Simple.FromRow (FromRow(..), field)
import System.Directory               (createDirectoryIfMissing, getXdgDirectory, XdgDirectory(..))
import System.FilePath                ((</>), takeDirectory)

import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map             as Map
import qualified Data.Serialize       as Cereal
import qualified Data.Text            as T

data StoredTerm = StoredTerm
  { termHash :: Text
  , termNames :: Text
  , termData :: ByteString
  , termMetadata :: Text
  , termCreatedAt :: Integer
  , termTags :: Text
  } deriving (Show)

instance FromRow StoredTerm where
  fromRow = StoredTerm <$> field <*> field <*> field <*> field <*> field <*> field

tryDeserializeTerm :: ByteString -> IO (Maybe T)
tryDeserializeTerm bs =
  case deserializeTerm bs of
    Right t -> return $ Just t
    Left err -> do
      putStrLn $ "Error deserializing term: " ++ err
      return Nothing

parseNameList :: Text -> [Text]
parseNameList = filter (not . T.null) . T.splitOn ","

serializeNameList :: [Text] -> Text
serializeNameList = T.intercalate "," . nub . sort

initContentStore :: IO Connection
initContentStore = do
  dbPath <- getContentStorePath
  createDirectoryIfMissing True (takeDirectory dbPath)
  conn <- open dbPath
  execute_ conn "CREATE TABLE IF NOT EXISTS terms (\
                \hash TEXT PRIMARY KEY, \
                \names TEXT, \
                \term_data BLOB, \
                \metadata TEXT, \
                \created_at INTEGER DEFAULT (strftime('%s','now')), \
                \tags TEXT DEFAULT '')"
  execute_ conn "CREATE INDEX IF NOT EXISTS terms_names_idx ON terms(names)"
  execute_ conn "CREATE INDEX IF NOT EXISTS terms_tags_idx ON terms(tags)"
  return   conn

getContentStorePath :: IO FilePath
getContentStorePath = do
  dataDir <- getXdgDirectory XdgData "tricu"
  return $ dataDir </> "content-store.db"

instance Cereal.Serialize T where
  put Leaf = Cereal.putWord8 0
  put (Stem t) = do
    Cereal.putWord8 1
    Cereal.put t
  put (Fork a b) = do
    Cereal.putWord8 2
    Cereal.put a
    Cereal.put b

  get = do
    tag <- Cereal.getWord8
    case tag of
      0 -> return Leaf
      1 -> Stem <$> Cereal.get
      2 -> Fork <$> Cereal.get <*> Cereal.get
      _ -> fail $ "Invalid tag for T: " ++ show tag

serializeTerm :: T -> ByteString
serializeTerm = LBS.toStrict . Cereal.encodeLazy

deserializeTerm :: ByteString -> Either String T
deserializeTerm = Cereal.decodeLazy . LBS.fromStrict

hashTerm :: T -> Text
hashTerm = T.pack . show . (hash :: ByteString -> Digest SHA256) . serializeTerm

storeTerm :: Connection -> [String] -> T -> IO Text
storeTerm conn newNamesStrList term = do
  let termBS = serializeTerm term
      termHashText = hashTerm term
      newNamesTextList = map T.pack newNamesStrList
      metadataText = T.pack "{}"

  existingNamesQuery <- query conn
    "SELECT names FROM terms WHERE hash = ?"
    (Only termHashText) :: IO [Only Text]

  case existingNamesQuery of
    [] -> do
      let allNamesToStore = serializeNameList newNamesTextList
      execute conn
        "INSERT INTO terms (hash, names, term_data, metadata, tags) VALUES (?, ?, ?, ?, ?)"
        (termHashText, allNamesToStore, termBS, metadataText, T.pack "")
    [(Only currentNamesText)] -> do
      let currentNamesList = parseNameList currentNamesText
      let combinedNamesList = currentNamesList ++ newNamesTextList
      let allNamesToStore = serializeNameList combinedNamesList
      execute conn
        "UPDATE terms SET names = ?, metadata = ? WHERE hash = ?"
        (allNamesToStore, metadataText, termHashText)

  return termHashText

hashToTerm :: Connection -> Text -> IO (Maybe StoredTerm)
hashToTerm conn hashText =
  queryMaybeOne conn (selectStoredTermFields <> " WHERE hash = ?") (Only hashText)

nameToTerm :: Connection -> Text -> IO (Maybe StoredTerm)
nameToTerm conn nameText =
  queryMaybeOne conn
    (selectStoredTermFields <> " WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC LIMIT 1")
    (nameText, nameText <> T.pack ",%", T.pack "%," <> nameText <> T.pack ",%", T.pack "%," <> nameText)

listStoredTerms :: Connection -> IO [StoredTerm]
listStoredTerms conn =
  query_ conn (selectStoredTermFields <> " ORDER BY created_at DESC")

storeEnvironment :: Connection -> Env -> IO [(String, Text)]
storeEnvironment conn env = do
  let defs = Map.toList $ Map.delete "!result" env
  let groupedDefs = Map.toList $ Map.fromListWith (++) [(term, [name]) | (name, term) <- defs]

  forM groupedDefs $ \(term, namesList) -> do
    hashVal <- storeTerm conn namesList term
    return (head namesList, hashVal)

loadTerm :: Connection -> String -> IO (Maybe T)
loadTerm conn identifier = do
  result <- getTerm conn (T.pack identifier)
  case result of
    Just storedTerm -> tryDeserializeTerm (termData storedTerm)
    Nothing -> return Nothing

getTerm :: Connection -> Text -> IO (Maybe StoredTerm)
getTerm conn identifier = do
  if '#' `elem` (T.unpack identifier)
    then hashToTerm conn (T.pack $ drop 1 (T.unpack identifier))
    else nameToTerm conn identifier

loadEnvironment :: Connection -> IO Env
loadEnvironment conn = do
  terms <- listStoredTerms conn
  foldM addTermToEnv Map.empty terms
  where
    addTermToEnv env storedTerm = do
      maybeT <- tryDeserializeTerm (termData storedTerm)
      case maybeT of
        Just t -> do
          let namesList = parseNameList (termNames storedTerm)
          return $ foldl (\e name -> Map.insert (T.unpack name) t e) env namesList
        Nothing -> return env

termVersions :: Connection -> String -> IO [(Text, T, Integer)]
termVersions conn name = do
  let nameText = T.pack name
  results <- query conn
    ("SELECT hash, term_data, created_at FROM terms WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC")
    (nameText, nameText <> T.pack ",%", T.pack "%," <> nameText <> T.pack ",%", T.pack "%," <> nameText)

  catMaybes <$> mapM (\(hashVal, termDataVal, timestamp) -> do
    maybeT <- tryDeserializeTerm termDataVal
    return $ fmap (\t -> (hashVal, t, timestamp)) maybeT
    ) results

setTag :: Connection -> Text -> Text -> IO ()
setTag conn hash tagValue = do
  exists <- termExists conn hash
  if exists
    then do
      currentTagsQuery <- query conn "SELECT tags FROM terms WHERE hash = ?" (Only hash) :: IO [Only Text]
      case currentTagsQuery of
        [Only tagsText] -> do
          let tagsList = parseNameList tagsText
              newTagsList = tagValue : tagsList
              newTags = serializeNameList newTagsList
          execute conn "UPDATE terms SET tags = ? WHERE hash = ?" (newTags, hash)
        _ -> putStrLn $ "Term with hash " ++ T.unpack hash ++ " not found (should not happen if exists is true)"
    else
      putStrLn $ "Term with hash " ++ T.unpack hash ++ " does not exist"

termExists :: Connection -> Text -> IO Bool
termExists conn hash = do
  results <- query conn "SELECT 1 FROM terms WHERE hash = ? LIMIT 1" (Only hash) :: IO [[Int]]
  return $ not (null results)

termToTags :: Connection -> Text -> IO [Text]
termToTags conn hash = do
  tagsQuery <- query conn "SELECT tags FROM terms WHERE hash = ?" (Only hash) :: IO [Only Text]
  case tagsQuery of
    [Only tagsText] -> return $ parseNameList tagsText
    _ -> return []

tagToTerm :: Connection -> Text -> IO [StoredTerm]
tagToTerm conn tagValue = do
  let pattern = "%" <> tagValue <> "%"
  query conn (selectStoredTermFields <> " WHERE tags LIKE ? ORDER BY created_at DESC") (Only pattern)

allTermTags :: Connection -> IO [StoredTerm]
allTermTags conn = do
  query_ conn (selectStoredTermFields <> " WHERE tags IS NOT NULL AND tags != '' ORDER BY created_at DESC")

selectStoredTermFields :: Query
selectStoredTermFields = "SELECT hash, names, term_data, metadata, created_at, tags FROM terms"

queryMaybeOne :: (FromRow r, ToRow q) => Connection -> Query -> q -> IO (Maybe r)
queryMaybeOne conn qry params = do
  results <- query conn qry params
  case results of
    [row] -> return $ Just row
    _     -> return Nothing