{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE StandaloneDeriving #-}

module Main ( main ) where


import           Control.Exception           (assert)
import           Data.Aeson
import           Data.Aeson.Default
import           Data.Aeson.Default.HKD
import           Data.Aeson.Default.List
import           Data.Aeson.Default.Map.Lazy
import           Data.Functor.Identity
import           Data.Map.Lazy
import           Data.Maybe
import           GHC.Generics


data NameH f = Name { first  :: String
                    , middle :: f String
                    , last_  :: String
                    } deriving Generic

instance FromJSON (NameH Maybe)

instance Default NameH where
  constrDef _ = Name "Jorah" (Identity ".") "Gao"

deriving instance Eq (NameH Identity)


data PersonH f = Person { name :: NameH f
                        , age  :: f Int
                        } deriving Generic

instance FromJSON (PersonH Maybe)

instance Default PersonH where
  constrDef _ = Person (constrDef "Name") (Identity 28)

deriving instance Eq (PersonH Identity)


data DBH f = DB { host :: HKD String f
                , port :: HKD Int f
                } deriving Generic

instance FromJSON (DBH Maybe)

instance Default DBH where
  constrDef _ = DB "localhost" 3306

deriving instance Eq (DBH Identity)


data ConfigH f = Config { db :: HKD (DBH f) f } deriving Generic

instance FromJSON (ConfigH Maybe)

instance Default ConfigH where
  constrDef _ = Config (constrDef "DB")

deriving instance Eq (ConfigH Identity)


data ShapeH f = Square { side :: HKD Double f }
              | Circle { redius :: HKD Double f }
              deriving Generic

instance FromJSON (ShapeH Maybe)

instance Default ShapeH where
  constrDef "Square" = Square 1.0
  constrDef "Circle" = Circle 1.0

deriving instance Eq (ShapeH Identity)


data BoxH f = Box { base   :: HKD (ShapeH f) f
                  , height :: HKD Double f
                  } deriving Generic

instance FromJSON (BoxH Maybe)

instance Default BoxH where
  constrDef _ = Box (constrDef "Square") 1.0

deriving instance Eq (BoxH Identity)


data HandlerH f = Handler { level    :: HKD String f
                          , filterer :: HKD [String] f
                          } deriving Generic

instance FromJSON (HandlerH Maybe)

instance Default HandlerH where
  constrDef _ = Handler "INFO" []

deriving instance Eq (HandlerH Identity)


data SinkH f = Sink { handlers :: HKD (ListH HandlerH f) f } deriving Generic

instance FromJSON (SinkH Maybe)

instance Default SinkH where
  constrDef _ = Sink (constrDef "ListH")

deriving instance Eq (SinkH Identity)


data ManagerH f = Manager { sinks :: HKD (MapH String SinkH f) f
                          } deriving Generic

instance FromJSON (ManagerH Maybe)

instance Default ManagerH where
  constrDef _ = Manager $ constrDef "MapH"

deriving instance Eq (ManagerH Identity)


it :: String -> Bool -> IO ()
it = flip assert . putStrLn

main :: IO ()
main = do
  putStrLn "\n<<<<<<<<<<<<<<<<<<<<<< Test <<<<<<<<<<<<<<<<<<<<<<"

  it "flatten data" $
    let res1 = decode "{\"first\":\"Jorah\", \"last_\": \"Gao\"}" == Just (Name "Jorah" (Identity ".") "Gao")
        res2 = decode "{\"first\":\"Jorah1\", \"last_\": \"Gao2\"}" == Just (Name "Jorah1" (Identity ".") "Gao2")
        res3 = decode "{\"first\":\"Jorah3\", \"middle\": \"*\", \"last_\": \"Gao4\"}" == Just (Name "Jorah3" (Identity "*") "Gao4")
        res4 = decode "{}" == Just (DB "localhost" 3306 :: DBH Identity)
        res5 = decode "{\"host\": \"127.0.0.1\"}" == Just (DB "127.0.0.1" 3306 :: DBH Identity)
        res6 = decode "{\"port\": 3307}" == Just (DB "localhost" 3307 :: DBH Identity)
        res7 = decode "{\"host\": \"127.0.0.1\", \"port\": 3307}" == Just (DB "127.0.0.1" 3307 :: DBH Identity)
    in all id [res1, res2, res3, res4, res5, res6, res7]
  it "nested data" $
    let res1 = decode "{\"name\": {\"first\": \"Jorah5\", \"last_\": \"Gao6\"}}" == Just (Person (Name "Jorah5" (Identity ".") "Gao6") (Identity 28))
        res2 = decode "{\"name\": {\"first\": \"Jorah5\", \"last_\": \"Gao6\"}, \"age\": 82}" == Just (Person (Name "Jorah5" (Identity ".") "Gao6") (Identity 82))
        res3 = decode "{}" == Just (Config (DB "localhost" 3306) :: ConfigH Identity)
        res4 = decode "{\"db\": {}}" == Just (Config (DB "localhost" 3306) :: ConfigH Identity)
        res5 = decode "{\"db\": {\"host\": \"127.0.0.1\"}}" == Just (Config (DB "127.0.0.1" 3306) :: ConfigH Identity)
        res6 = decode "{\"db\": {\"port\": 3307}}" == Just (Config (DB "localhost" 3307) :: ConfigH Identity)
        res7 = decode "{\"db\": {\"host\": \"127.0.0.1\", \"port\": 3307}}" == Just (Config (DB "127.0.0.1" 3307) :: ConfigH Identity)
    in all id [res1, res2, res3, res4, res5, res6, res7]
  it "multiple data constructors" $
    let res1 = decode "{}" == Just (Box (Square 1.0) 1.0 :: BoxH Identity)
        res2 = decode "{\"base\": {\"tag\": \"Square\"}}" == Just (Box (Square 1.0) 1.0 :: BoxH Identity)
        res3 = decode "{\"base\": {\"tag\": \"Circle\"}}" == Just (Box (Circle 1.0) 1.0 :: BoxH Identity)
        res4 = decode "{\"base\": {\"tag\": \"Square\", \"side\": 10.0}}" == Just (Box (Square 10.0) 1.0 :: BoxH Identity)
        res5 = decode "{\"base\": {\"tag\": \"Circle\", \"redius\": 10.0}}" == Just (Box (Circle 10.0) 1.0 :: BoxH Identity)
        res6 = decode "{\"height\": 10.0}" == Just (Box (Square 1.0) 10.0 :: BoxH Identity)
     in all id [res1, res2, res3, res4, res5, res6]
  it "higher-kined container types" $
    let res1 = decode "{}" == Just (Manager mempty :: ManagerH Identity)
        res2 = decode "{\"sinks\": {}}" == Just (Manager mempty :: ManagerH Identity)
        res3 = decode "{\"sinks\": {\"root\": {}}}" == Just (Manager (MapH $ fromList [("root", Sink mempty)]) :: ManagerH Identity)
        res4 = decode "{\"sinks\": {\"root\": {}, \"root1\": {}}}" == Just (Manager (MapH $ fromList [("root", Sink mempty), ("root1", Sink mempty)]) :: ManagerH Identity)
        res5 = decode "{\"sinks\": {\"root\": {\"handlers\": []}}}" == Just (Manager (MapH $ fromList [("root", Sink mempty)]) :: ManagerH Identity)
        res6 = decode "{\"sinks\": {\"root\": {\"handlers\": [{}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "INFO" []])]) :: ManagerH Identity)
        res7 = decode "{\"sinks\": {\"root\": {\"handlers\": [{\"level\": \"DEBUG\"}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "DEBUG" []])]) :: ManagerH Identity)
        res8 = decode "{\"sinks\": {\"root\": {\"handlers\": [{\"filterer\": []}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "INFO" []])]) :: ManagerH Identity)
        res9 = decode "{\"sinks\": {\"root\": {\"handlers\": [{\"filterer\": [\"A\"]}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "INFO" ["A"]])]) :: ManagerH Identity)
        res10 = decode "{\"sinks\": {\"root\": {\"handlers\": [{\"level\": \"DEBUG\", \"filterer\": [\"A\"]}]}}}" == Just (Manager (MapH $ fromList [("root", Sink $ ListH [Handler "DEBUG" ["A"]])]) :: ManagerH Identity)
     in all id [res1, res2, res3, res4, res5, res6, res7, res8, res9, res10]

  putStrLn "\n>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>"