{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.Functor.Base.EDN
  ( ValueF(..)
  ) where

-- import Data.Deriving (deriveEq1, deriveShow1)
import Data.Functor.Foldable
  ( Base
  , Recursive(..)
  , Corecursive(..)
  )
import Data.Text (Text)
import GHC.Generics (Generic)

import qualified Data.Vector as V
import qualified Data.Map.Strict as M
import qualified Data.Set as S

import Data.EDN.AST.Types (Tagged(..), Value(..))

type TextTag = Maybe (Text, Text)

data ValueF f
  = NilF       TextTag
  | BooleanF   TextTag Bool
  | StringF    TextTag Text
  | CharacterF TextTag Char
  | SymbolF    TextTag Text Text
  | KeywordF   TextTag Text
  | IntegerF   TextTag Int
  | FloatingF  TextTag Double
  | ListF      TextTag [f]
  | VecF       TextTag (V.Vector f)
  | MapF       TextTag [(f, f)]
  | SetF       TextTag [f]
  deriving (Eq, Show, Generic, Functor, Foldable, Traversable)

-- TODO: $(deriveEq1 ''ValueF)
-- TODO: $(deriveShow1 ''ValueF)

type instance Base (Tagged Text Value) = ValueF

instance Recursive (Tagged Text Value) where
  project = \case
    NoTag v       -> projectV Nothing v
    Tagged ns n v -> projectV (Just (ns, n)) v
    where
      projectV t = \case
        Nil         -> NilF t
        Boolean b   -> BooleanF t b
        String s    -> StringF t s
        Character c -> CharacterF t c
        Symbol ns n -> SymbolF t ns n
        Keyword n   -> KeywordF t n
        Integer i   -> IntegerF t i
        Floating f  -> FloatingF t f
        List xs     -> ListF t xs
        Vec v       -> VecF t v
        Map m       -> MapF t (M.toList m)
        Set s       -> SetF t (S.toList s)

instance Corecursive (Tagged Text Value) where
  embed = \case
    NilF t         -> embedT t Nil
    BooleanF t b   -> embedT t $ Boolean b
    StringF t s    -> embedT t $ String s
    CharacterF t c -> embedT t $ Character c
    SymbolF t ns n -> embedT t $ Symbol ns n
    KeywordF t k   -> embedT t $ Keyword k
    IntegerF t i   -> embedT t $ Integer i
    FloatingF t f  -> embedT t $ Floating f
    ListF t xs     -> embedT t $ List xs
    VecF t v       -> embedT t $ Vec v
    MapF t ps      -> embedT t $ Map (M.fromList ps) -- XXX: fromSomethingElse?
    SetF t xs      -> embedT t $ Set (S.fromList xs) -- XXX: fromAscList?
    where
      embedT t v = case t of
        Nothing      -> NoTag v
        Just (ns, n) -> Tagged ns n v