{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}

module Elm.Types
    ( Options (..)
    , defaultOptions
    , Primitive (..)
    , Expr (..)
    , isProduct
    , Generator (..)
    , ToElm (..)
    , genericToElm
    ) where

import           Data.Char
import           Data.Text    (Text)
import           Data.Time
import           GHC.Generics

data Options = Options
    { recordSelectorModifier :: String -> String
    , jsonSelectorModifier   :: String -> String
    }

defaultOptions :: Options
defaultOptions = Options
    { recordSelectorModifier = id
    , jsonSelectorModifier   = id
    }

data Primitive = Bool | Char | String | Float | Date | Int | Maybe | List
    deriving (Show, Eq)

data Expr = DataType String Expr
          | Record String Expr
          | Constructor String Expr
          | Selector String String Expr
          | Field Expr
          | Unit
          | Sum Expr Expr
          | Product Expr Expr
          | Primitive Primitive
    deriving (Show)

isProduct :: Expr -> Bool
isProduct (Product (Primitive List) (Primitive Char)) = False
isProduct (Product _ _) = True
isProduct _ = False

data Generator = Type | Decoder | ListDecoder | Encoder
    deriving (Show, Eq, Ord)

class ToElm a where
    toElm :: a -> Expr
    default toElm :: (Generic a, GToElm (Rep a)) => a -> Expr
    toElm = genericToElm defaultOptions

instance ToElm Bool where
    toElm _ = Primitive Bool

instance ToElm Char where
    toElm _ = Primitive Char

instance ToElm Text where
    toElm _ = Primitive String

instance ToElm Float where
    toElm _ = Primitive Float

instance ToElm Double where
    toElm _ = Primitive Float

instance ToElm UTCTime where
    toElm _ = Primitive Date

instance ToElm Int where
    toElm _ = Primitive Int

instance (ToElm a) => ToElm (Maybe a) where
    toElm _ = Product (Primitive Maybe) $ toElm (undefined :: a)

instance (ToElm a) => ToElm [a] where
    toElm _ = Product (Primitive List) $ toElm (undefined :: a)

class GToElm f where
    gToElm :: Options -> f a -> Expr

instance (GToElm f, Datatype d) => GToElm (D1 d f) where
    gToElm opts d@(M1 b) =
        DataType name expr
        where name = datatypeName d
              expr = gToElm opts b

instance (GToElm f, Constructor c) => GToElm (C1 c f) where
    gToElm opts c@(M1 s) =
        if conIsRecord c
            then Record name expr
            else Constructor name expr
        where name = conName c
              expr = gToElm opts s

instance (Selector c,GToElm f) => GToElm (S1 c f) where
    gToElm opts@(Options {..}) s@(M1 x) = Selector
        (dcFirst $ notEmpty "Record" $ recordSelectorModifier name)
        (notEmpty "Json" $ jsonSelectorModifier name) expr
        where name = selName s
              expr = gToElm opts x
              notEmpty ident as = if length as > 0
                  then as
                  else error $ ident ++ "selector modifier results in empty selector"
              dcFirst (a:as) = toLower a : as
              dcFirst _ = undefined

instance (ToElm c) => GToElm (K1 R c) where
    gToElm _ (K1 x) =
        Field $ toElm x

instance GToElm U1 where
    gToElm _ _ =
        Unit

instance (GToElm f, GToElm g) => GToElm (f :+: g) where
  gToElm opts _ =
      Sum (gToElm opts (undefined :: f p)) (gToElm opts (undefined :: g p))

instance (GToElm f, GToElm g) => GToElm (f :*: g) where
  gToElm opts _ =
      Product (gToElm opts (undefined :: f p)) (gToElm opts (undefined :: g p))

genericToElm :: (Generic a, GToElm (Rep a)) => Options -> a -> Expr
genericToElm opts = gToElm opts . from