module Types where

import           Database.SQLite.Simple
import           Data.Aeson
import           Data.Monoid ((<>))
import           Data.Text (Text, unpack)
import           Control.Error (headMay)
import           Text.Read (readMaybe)

type DB a = Connection -> IO a

-- | Language

data Language = Language
  { langId   :: Integer
  , langName :: Text
  } deriving (Eq, Show)

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

instance ToRow Language where
  toRow l = toRow (Only (langName l))

instance ToJSON Language where
  toJSON l = object [ "id"   .= langId l
                    , "name" .= langName l
                    ]

instance FromJSON Language where
  parseJSON = withObject "Language object" $ \ o ->
    Language <$> o .: "id"
             <*> o .: "name"

allLanguages :: DB [Language]
allLanguages conn =
  query_ conn "SELECT id, name FROM languages"

-- | Entry

data Entry = Entry
  { eID       :: Integer
  , eWord     :: Text
  , eTranslit :: Text
  , eMeaning  :: Text
  , eNotes    :: Text
  , eLanguage :: Language
  } deriving (Eq, Show)

instance FromRow Entry where
  fromRow = Entry <$> field
                  <*> field
                  <*> field
                  <*> field
                  <*> field
                  <*> (Language <$> field <*> field)

instance ToRow Entry where
  toRow e = toRow ( eWord e
                  , eTranslit e
                  , eMeaning e
                  , eNotes e
                  , langId (eLanguage e)
                  )

instance ToJSON Entry where
  toJSON e = object [ "id"       .= eID e
                    , "word"     .= eWord e
                    , "translit" .= eTranslit e
                    , "meaning"  .= eMeaning e
                    , "notes"    .= eNotes e
                    , "language" .= eLanguage e
                    ]

instance FromJSON Entry where
  parseJSON = withObject "Word object" $ \ o ->
    Entry <$> o .: "id"
          <*> o .: "word"
          <*> o .: "translit"
          <*> o .: "meaning"
          <*> o .: "notes"
          <*> o .: "language"

paramsToEntry :: [(Text,Text)] -> Maybe Entry
paramsToEntry ps = Entry <$> pure 0
                         <*> lookup "word" ps
                         <*> lookup "translit" ps
                         <*> lookup "meaning" ps
                         <*> lookup "notes" ps
                         <*> (flip Language "???" <$> langNum)
  where langNum = lookup "lang" ps >>= (readMaybe . unpack)

--

addWord :: Entry -> DB Integer
addWord entry conn = do
  let q = "INSERT INTO words (word, trans, meaning, notes, language) \
          \ VALUES (?,?,?,?,?)"
  execute conn q entry
  fromIntegral <$> lastInsertRowId conn

updateWord :: Integer -> Entry -> DB ()
updateWord i e conn = do
  let q = "UPDATE words \
          \ SET word=?, trans=?, meaning=?, notes=? \
          \ WHERE id=?"
  execute conn q ( eWord e
                 , eTranslit e
                 , eMeaning e
                 , eNotes e
                 , i
                 )

getWordById :: Integer -> DB (Maybe Entry)
getWordById i conn = do
  let q = "SELECT w.id, w.word, w.trans, w.meaning, w.notes, l.id, l.name \
          \ FROM words w, languages l \
          \ WHERE w.id = ? AND w.language = l.id"
  headMay <$> query conn q (Only i)

getAllWords :: DB [Entry]
getAllWords conn = do
  let q = "SELECT w.id, w.word, w.trans, w.meaning, w.notes, l.id, l.name \
          \ FROM words w, languages l \
          \ WHERE w.language = l.id \
          \ ORDER BY w.word ASC"
  query_ conn q

getWordsByLanguage :: Text -> DB [Entry]
getWordsByLanguage lang conn = do
  let q = "SELECT w.id, w.word, w.trans, w.meaning, w.notes, l.id, l.name \
          \ FROM words w, languages l \
          \ WHERE w.language = l.id AND l.name = ? \
          \ ORDER BY w.word ASC"
  query conn q (Only lang)

searchText :: Text -> Text
searchText t = "%" <> t <> "%"

searchWord :: Text -> DB [Entry]
searchWord t conn = do
  let q = "SELECT w.id, w.word, w.trans, w.meaning, w.notes, l.id, l.name \
          \ FROM words w, languages l \
          \ WHERE w.language = l.id AND \
          \ (w.word LIKE ? OR w.trans LIKE ?) \
          \ ORDER BY w.word ASC"
  query conn q (searchText t, searchText t)

searchMeaning :: Text -> DB [Entry]
searchMeaning t conn = do
  let q = "SELECT w.id, w.word, w.trans, w.meaning, w.notes, l.id, l.name \
          \ FROM words w, languages l \
          \ WHERE w.language = l.id AND \
          \ (w.meaning LIKE ? OR w.notes LIKE ?) \
          \ ORDER BY w.word ASC"
  query conn q (searchText t, searchText t)

searchAll :: Text -> DB [Entry]
searchAll t conn = do
  let q = "SELECT w.id, w.word, w.trans, w.meaning, w.notes, l.id, l.name \
          \ FROM words w, languages l \
          \ WHERE w.language = l.id AND \
          \ (w.word LIKE ? OR w.trans LIKE ? OR \
          \  w.meaning LIKE ? OR w.notes LIKE ?) \
          \ ORDER BY w.word ASC"
  query conn q (searchText t, searchText t, searchText t, searchText t)