Servant

data Proxy a = Proxy

data Proxy a = Proxy
data Player
data Villain
data VillainLike

class HasName a where
    who :: Proxy a -> String

instance HasName Player where
    who _ = "Player"

instance HasName Villain where
    who _ = "Villain"

yaho :: HasName a => Proxy a -> IO () 
yaho x = putStrLn $ "Yaho. I am " ++ who x -- 어떤 who가 실행될지는 코드를 조립해봐야 압니다.

> yaho (Proxy :: Proxy Player)
Yaho. I am Player
> yaho (Proxy :: Proxy Villain)
Yaho. I am Villain

data Get (a :: *)

data a :<|> b = a :<|> b
infixr 8 :<|>

data (a :: k) :> (b :: *)
infixr 9 :>

data Capture (a :: *)

type famliy Server layout :: *
type instance Server (Get a) = IO a
type instance Server (a :<|> b) = (Server a, Server b)
type instance Server (a :<|> b) = Server a :<|> Server b
type instance Server ((s :: Symbol) :> r) = Server r
type instance Server (Capture a :> r) = a -> Server r

class HasServer layout where
  route :: Proxy layout -> Server layout -> [String] -> Maybe (IO String)
instance ...
instance ...
...

serve :: HasServer layout
      => Proxy layout -> Server layout -> [String] -> IO String
serve p h xs = case route p h xs of
  Nothing -> ioError (userError "404")
  Just m  -> m

route :: Proxy (Get a) -> IO a -> [String] -> Maybe (IO String)

Int :: Type -- 나중에 실제 존재하는 값이 들어갈 자리
5 :: Nat -- 타입 레벨에만 존재하고, 값이 없습니다.

{-# LANGUAGE DataKinds, PolyKinds, TypeOperators #-}
{-# LANGUAGE TypeFamilies, FlexibleInstances, ScopedTypeVariables #-}
{-# LANGUAGE InstanceSigs #-}

module TinyServant where

import Control.Applicative
import GHC.TypeLits
import Text.Read
import Data.Time

-- API specification DSL
data Get (a :: *)

data a :<|> b = a :<|> b
infixr 8 :<|>
-- 타입 매개 변수로 타입 두 개를 받는 타입입니다.
-- A :<|> B 도 하나의 타입으로, A 와 (B :<|> C) 를 받아
-- A :<|> (B :<|> C) 이렇게 써 줄 수 있습니다.
-- 오른 쪽 결합이니 괄호를 생략할 수 있습니다.
-- A :<|> B :<|> C 

data (a :: k) :> (b :: *)
-- k는 카인드 변수입니다. b는 * 카인드만 받고, a는 카인드 제한이 없다는 말입니다.
-- b는 * 카인드니 Maybe Int 같은 * -> * 는 못받는 걸로 오해할 수 있습니다.
-- Maybe는 * -> * 카인드고, 여기에 인자로 Int를 넘긴 Maybe Int 는 * 카인드입니다.
infixr 9 :>

data Capture (a :: *)

-- Example API
type MyAPI = "date" :> Get Day
        :<|> "time" :> Capture TimeZone :> Get ZonedTime

data Proxy a = Proxy

-- The Server type family
type family Server layout :: *
type instance Server (Get a) = IO a
type instance Server (a :<|> b) = Server a :<|> Server b
type instance Server ((s :: Symbol) :> r) = Server r
type instance Server (Capture a :> r) = a -> Server r

-- Handler for the example API
handleDate :: IO Day
handleDate = utctDay <$> getCurrentTime

handleTime :: TimeZone -> IO ZonedTime
handleTime tz = utcToZonedTime tz <$> getCurrentTime

handleMyAPI :: Server MyAPI
handleMyAPI = handleDate :<|> handleTime

-- The HasServer class
class HasServer layout where
  route :: Proxy layout -> Server layout -> [String] -> Maybe (IO String)

------------여기서 부턴, (팬텀) 타입들에 따라 선택될 코드들입니다.--------------
-- HasServer류의 타입을 받아, 해당 타입에 맞는 (해당 타입의 인스턴스의) route를 씁니다.
serve :: HasServer layout
      => Proxy layout -> Server layout -> [String] -> IO String
serve p h xs = case route p h xs of
  Nothing -> ioError (userError "404")
  Just m  -> m

-- The HasServer instance
type instance Server (Get a) = IO a

-- 타입들을 분해해서, 조각난 타입 각각에 맞는 route를 가져다 씁니다.
instance Show a => HasServer (Get a) where
  route :: Proxy (Get a) -> IO a -> [String] -> Maybe (IO String)
  route _ handler [] = Just (show <$> handler)
  route _ _       _  = Nothing

instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
  route :: Proxy (a :<|> b) -> (Server a :<|> Server b) -> [String] -> Maybe (IO String)
  route _ (handlera :<|> handlerb) xs =
        route (Proxy :: Proxy a) handlera xs
    <|> route (Proxy :: Proxy b) handlerb xs
  -- (A :<|> (B :<|> C)) 를 만나면, 
  -- A 타입을 위한 route를 부르고, 
  -- (B :<|> C) 타입을 위한 route를 부릅니다.  B :<|> C 도 하나의 타입입니다.

instance (KnownSymbol s, HasServer r) => HasServer ((s :: Symbol) :> r) where
  route :: Proxy (s :> r) -> Server r -> [String] -> Maybe (IO String)
  route _ handler (x : xs)
    | symbolVal (Proxy :: Proxy s) == x = route (Proxy :: Proxy r) handler xs
  route _ _       _                     = Nothing

instance (Read a, HasServer r) => HasServer (Capture a :> r) where
  route :: Proxy (Capture a :> r) -> (a -> Server r) -> [String] -> Maybe (IO String)
  route _ handler (x : xs) = do
    a <- readMaybe x
    route (Proxy :: Proxy r) (handler a) xs
  route _ _       _        = Nothing