Service.hs

{-# LANGUAGE OverloadedStrings #-}
module Nirum.Constructs.Service ( Method ( Method
                                         , methodAnnotations
                                         , methodDocs
                                         , methodName
                                         , parameters
                                         , returnType
                                         )
                                , Parameter(Parameter)
                                , Service(Service, methods)
                                ) where

import qualified Data.Text as T

import Nirum.Constructs (Construct(toCode))
import Nirum.Constructs.Annotation (AnnotationSet)
import Nirum.Constructs.Declaration ( Declaration(name, docs)
                                    , Docs
                                    , toCodeWithPrefix
                                    )
import Nirum.Constructs.DeclarationSet (DeclarationSet, toList)
import Nirum.Constructs.Name (Name)
import Nirum.Constructs.TypeExpression (TypeExpression)

-- | 'Method' parameter.
data Parameter = Parameter Name TypeExpression (Maybe Docs)
                 deriving (Eq, Ord, Show)

instance Construct Parameter where
    toCode (Parameter name' typeExpr docs') =
        T.concat [ toCode typeExpr
                 , " "
                 , toCode name'
                 , ","
                 , toCodeWithPrefix "\n" docs'
                 ]

instance Declaration Parameter where
    name (Parameter name' _ _) = name'
    docs (Parameter _ _ docs') = docs'

-- | 'Service' method.
data Method = Method { methodName :: Name
                     , parameters :: DeclarationSet Parameter
                     , returnType :: TypeExpression
                     , errorType  :: Maybe TypeExpression
                     , methodDocs :: Maybe Docs
                     , methodAnnotations :: AnnotationSet
                     } deriving (Eq, Ord, Show)

instance Construct Method where
    toCode method@Method { parameters = params
                         , errorType = error'
                         , methodDocs = docs'
                         , methodAnnotations = annotationSet'
                         } =
        T.concat $ [ toCode annotationSet'
                   , toCode $ returnType method
                   , " "
                   , toCode $ methodName method
                   , " ("
                   , toCodeWithPrefix "\n  " docs'
                   ] ++ case (docs', params') of
                            (Nothing, []) -> []
                            (Just _, []) -> ["\n"]
                            (Nothing, [p@(Parameter _ _ Nothing)]) ->
                                [T.dropWhileEnd (== ',') $ toCode p]
                            _ -> [ "\n"
                                 , T.intercalate "\n" $ map indentedCode params'
                                 , "\n"
                                 ]
                   ++ [")"]
                   ++ case error' of
                          Nothing -> []
                          Just e -> [" throws ", toCode e]
                   ++ [","]
      where
        params' :: [Parameter]
        params' = toList params
        indentedCode :: Construct a => a -> T.Text
        indentedCode c = T.concat [ "  "
                                  , T.intercalate "\n  " $ T.lines (toCode c)
                                  ]

instance Declaration Method where
    name = methodName
    docs = methodDocs

-- | RPC service.
data Service =
    Service { methods :: DeclarationSet Method } deriving (Eq, Ord, Show)