{-|
  Module:      Anki.Common
  Copyright:   (c) 2016 Al Zohali
  License:     BSD3
  Maintainer:  Al Zohali <zohl@fmap.me>
  Stability:   experimental

  = Description
  Auxiliary functions and types.
-}

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Anki.Common (
    AnkiException(..)
  , WeaklyTypedInt(..)
  , WeaklyTypedBool(..)
  , ModificationTime(..)
  , throwErr
  , getTextValue
  , getJsonValue
  , fromDictionary
  , mkEntry
  , dropPrefixOptions
  ) where


import Control.Exception (Exception)
import Control.Monad (unless)
import Data.Aeson (Value(..), encode, decode, FromJSON(..))
import Data.Aeson.Types (Options(..), defaultOptions)
import Data.Char (toLower, isUpper)
import Data.HashMap.Strict (toList)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Typeable (Typeable)
import Database.SQLite.Simple (SQLData(..))
import Database.SQLite.Simple.FromField (FromField(..), ResultError(..), returnError)
import Database.SQLite.Simple.Internal (Field(..))
import Database.SQLite.Simple.Ok (Ok(..))
import qualified Data.ByteString.Lazy.Char8 as BSLC8
import qualified Data.Text as T


-- | The exception is thrown when something goes wrong with this package.
data AnkiException
  = WrongFieldType
  -- ^ Thrown when column type is not a text.
  | NotJson
  -- ^ Thrown when text from database is not a valid json.
  | WrongJsonFormat
  -- ^ Thrown when json format differs from expected one.
  | ModelIdInconsistent
  -- ^ Thrown when external and internal ids of model differ.
  | DeckIdInconsistent
  -- ^ Thrown when external and internal ids of deck differ.
  | DeckOptionsIdInconsistent
  -- ^ Thrown when external and internal ids of deck options differ.
  deriving (Eq, Show, Typeable)

instance (Exception AnkiException)

-- | Exit from Ok monad.
throwErr :: (Typeable a) => Field -> AnkiException -> Ok a
throwErr f ex = returnError ConversionFailed f $ show ex

-- | Read field as a byte sequence.
getTextValue :: Field -> Ok BSLC8.ByteString
getTextValue = \case
  (Field (SQLText txt) _) -> return . BSLC8.pack . T.unpack $ txt
  f                       -> throwErr f WrongFieldType

-- | Read field as a JSON.
getJsonValue :: Field -> Ok Value
getJsonValue f = getTextValue f >>= getValue where
  getValue :: BSLC8.ByteString -> Ok Value
  getValue = maybe (throwErr f NotJson) return . decode

-- | Transform a JSON-dictionary to a list of values.
fromDictionary :: (Typeable a) => (Field -> (Text, Value) -> Ok a) -> Field -> Value -> Ok [a]
fromDictionary mkEntry' f = \case
  (Object o) -> mapM (mkEntry' f) (toList o)
  _          -> throwErr f WrongJsonFormat

-- | Transform a single pair from JSON-dictionary of type { <id>: {id: <id>, ....} } to a record.
mkEntry :: (Typeable a, FromJSON a, Eq b, Typeable b, FromJSON b)
  => (a -> b)
  -> AnkiException
  -> Field
  -> (Text, Value)
  -> Ok a

mkEntry entryId entryIdException f (key, value) = do
  entryId' <- maybe
    (throwErr f WrongJsonFormat)
    return
    (decode . BSLC8.pack . T.unpack $ key)

  entry <- maybe
    (throwErr f WrongJsonFormat)
    return
    (decode . encode $ value)

  unless (entryId' == entryId entry) $ throwErr f entryIdException
  return entry

-- | Cut the first word and lowercase the second.
dropPrefix :: String -> String
dropPrefix "" = ""
dropPrefix (c:t)
  | isUpper c = toLower c : t
  | otherwise = dropPrefix t

-- | Default options used in Aeson typeclasses in this module.
dropPrefixOptions :: Options
dropPrefixOptions = defaultOptions { fieldLabelModifier = dropPrefix }

-- | A wrapper to handle integers and strings with integers.
newtype WeaklyTypedInt = WeaklyTypedInt { getInt :: Int } deriving (Show, Eq, Num)

instance FromJSON WeaklyTypedInt where
  parseJSON = fmap fromInteger . \case
    (String s) -> return . read . T.unpack $ s
    (Number x) -> return . round $ x
    _ -> error "TODO"

instance FromField WeaklyTypedInt where
  fromField f = fromInteger <$> fromField f

-- | A wrapper to handle booleans, strings with booleans and 0-1 integers.
newtype WeaklyTypedBool = WeaklyTypedBool { getBool :: Bool } deriving (Show, Eq)

instance FromJSON WeaklyTypedBool where
  parseJSON = fmap WeaklyTypedBool . \case
    (String s) -> case s of
      "false" -> return False
      "true"  -> return True
      _       -> error "TODO"

    (Number x) -> case x of
      0 -> return False
      1 -> return True
      _ -> error "TODO"

    _ -> error "TODO"


-- | A wrapper handle time in POSIX format.
newtype ModificationTime = ModificationTime { getModificationTime :: UTCTime } deriving (Show, Eq)

instance FromField ModificationTime where
  fromField f = (ModificationTime . posixSecondsToUTCTime . fromInteger) <$> fromField f

instance FromJSON ModificationTime where
  parseJSON = fmap (ModificationTime . posixSecondsToUTCTime . fromInteger) . parseJSON