{-# LANGUAGE DuplicateRecordFields, OverloadedLists #-}
{-# OPTIONS_GHC -Wall #-}
module Data.Language.Ruby
  ( Args(..)
  , Block(..)
  , Definition(..)
  , Function(..)
  , Module(..)
  , Name(..)
  , Send(..)
  ) where

import Data.Aeson (parseJSON, Value(String, Null, Array), withArray)
import Frelude
import qualified Data.Aeson.Types as Aeson
import qualified Data.Vector as Vector

kebabCase :: String -> String
kebabCase = Aeson.camelTo2 '-'

aesonOptions :: Aeson.Options
aesonOptions = Aeson.defaultOptions
  { Aeson.sumEncoding = Aeson.ObjectWithSingleField
  , Aeson.constructorTagModifier = kebabCase
  }

newtype Block = Block [Definition]

deriving stock instance Show Block
deriving stock instance Ord Block
deriving stock instance Eq Block
deriving stock instance Generic Block
instance ToJSON Block where
  toEncoding = Aeson.genericToEncoding aesonOptions

instance FromJSON Block where
  parseJSON = withArray "Block" $ \as -> case Vector.toList as of
    (String "begin":xs) -> Block <$> traverse parseJSON xs
    _ -> Block . pure <$> parseJSON (Array as)

data Definition
  = DefModule Module
  | DefFunction Function
  | DefSend Send

deriving stock instance Show Definition
deriving stock instance Ord Definition
deriving stock instance Eq Definition
deriving stock instance Generic Definition
instance ToJSON Definition where
  toEncoding = Aeson.genericToEncoding opts
    where
    opts = opts { Aeson.constructorTagModifier = go }
    go = \case
      "DefModule" -> "module"
      "DefFunction" -> "function"
      "DefSend" -> "send"
      x -> x

instance FromJSON Definition where
  parseJSON val
    =   (DefModule <$> parseJSON val)
    <|> (DefFunction <$> parseJSON val)
    <|> (DefSend <$> parseJSON val)

data Send = Send
  { args :: Args
  , name :: Name
  }

deriving stock instance Show Send
deriving stock instance Ord Send
deriving stock instance Eq Send
deriving stock instance Generic Send
instance ToJSON Send where
  toEncoding = Aeson.genericToEncoding aesonOptions

instance FromJSON Send where
  parseJSON = withArray "Send" $ \ as -> case Vector.toList as of
    (String "send" : _ : name : args)
      ->  Send
      <$> parseJSON (Array $ Vector.fromList args)
      <*> parseJSON name
    _ -> empty

data Module = Module
  { name :: Name
  , block :: Block
  }

deriving stock instance Show Module
deriving stock instance Ord Module
deriving stock instance Eq Module
deriving stock instance Generic Module
instance ToJSON Module where
  toEncoding = Aeson.genericToEncoding aesonOptions

instance FromJSON Module where
  parseJSON = withArray "Module" $ \case
    [String "module", name, block]
      ->  Module
      <$> parseJSON name
      <*> parseMaybeBlock block
    _ -> empty

parseMaybeBlock :: Value -> Aeson.Parser Block
parseMaybeBlock = \case
  Null -> pure (Block mempty)
  x -> parseJSON x

data Function = Function
  { name :: Name
  , args :: Args
  , block :: Block
  }

deriving stock instance Show Function
deriving stock instance Ord Function
deriving stock instance Eq Function
deriving stock instance Generic Function
instance ToJSON Function where
  toEncoding = Aeson.genericToEncoding aesonOptions

newtype Args = Args Value

deriving stock instance Show Args
instance Ord Args where
  compare = error "Unimplemented"
deriving stock instance Eq Args
deriving stock instance Generic Args
instance ToJSON Args where
  toEncoding = Aeson.genericToEncoding aesonOptions

instance FromJSON Args where
  parseJSON = pure . Args

instance FromJSON Function where
  parseJSON = withArray "Function" $ \case
    [String "def", name, args, block]
      ->  Function
      <$> parseJSON name
      <*> parseJSON args
      <*> parseMaybeBlock block
    _ -> empty

newtype Name = Name Value

deriving stock instance Show Name
instance Ord Name where
  compare = error "Unimplemented"
deriving stock instance Eq Name
deriving newtype instance ToJSON Name
deriving newtype instance FromJSON Name