Language/Symantic/HTTP/Command.hs

   1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   2 {-# LANGUAGE ExistentialQuantification #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE DataKinds #-}
   5 {-# LANGUAGE StrictData #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 {-# OPTIONS_GHC -fno-warn-orphans #-}
   8 module Language.Symantic.HTTP.Command where
   9
  10 import Control.Applicative (Applicative(..), Alternative(..))
  11 import Control.Monad (Monad(..), MonadPlus(..), void)
  12 import Data.Bool
  13 import Data.Either (Either(..))
  14 import Data.Eq (Eq(..))
  15 import Data.Foldable (toList)
  16 import Data.Function (($), (.), id)
  17 import Data.Functor (Functor)
  18 import Data.Maybe (Maybe(..))
  19 import Data.Ord (Ord(..))
  20 import Data.Semigroup (Semigroup(..))
  21 import Data.String (IsString(..))
  22 import Data.Tuple (fst, snd)
  23 import Prelude (Num(..), max, undefined)
  24 import System.IO (IO)
  25 import Text.Show (Show(..))
  26 import qualified Control.Monad.Trans.Reader as R
  27 import qualified Data.ByteString as BS
  28 import qualified Data.List as List
  29 import qualified Data.Set as Set
  30 import qualified Data.Text as Text
  31 import qualified Network.HTTP.Media as Media
  32 import qualified Network.HTTP.Types as HTTP
  33 import qualified Network.Wai as Wai
  34 import qualified Text.Megaparsec as P
  35
  36 import Language.Symantic.HTTP.Media
  37 import Language.Symantic.HTTP.API
  38 import Language.Symantic.HTTP.Client
  39
  40 -- Client a = R.ReaderT ClientRequest Client a
  41
  42 {-
  43 newtype FPr a end b = FPr ({-k-}(Client a -> end) -> {-cont-}b)
  44 newtype FPr a b = FPr ((String -> a) -> b)
  45 sprintf :: FPr String b -> b
  46 sprintf (FPr fmt) = fmt id
  47
  48 instance FormattingSpec FPr where
  49         lit str = FPr $ \k -> k str
  50         int     = FPr $ \k -> \x -> k (show x)
  51         char    = FPr $ \k -> \x -> k [x]
  52         fpp (PrinterParser pr _) = FPr $ \k -> \x -> k (pr x)
  53         (FPr a) ^ (FPr b)  = FPr $ \k -> a (\sa -> b (\sb -> k (sa ++ sb)))
  54 -}
  55
  56
  57 {-
  58 runRouter :: Command a -> Wai.Request -> RoutingResult a
  59 runRouter (Command rt) rq =
  60         let p = R.runReaderT rt rq in
  61         P.runParser (p <* P.eof) "<Request>" $
  62                 RouteToken_Segment <$> Wai.pathInfo rq
  63 -}
  64
  65 instance Altern Command where
  66         x <+> y = x :<|> y
  67 instance HTTP_Path Command where
  68 instance HTTP_Method Command where
  69 instance HTTP_Header Command where
  70 instance HTTP_Accept Command where
  71 instance HTTP_Query Command where
  72 instance HTTP_Version Command where
  73
  74 -- ** Type 'RouterEndpoint'
  75 newtype CommandEndpoint a
  76  =      CommandEndpoint (Client a) -- (HTTP.Status -> HTTP.ResponseHeaders -> a -> Wai.Response)
  77 instance HTTP_Endpoint Command where
  78         type Endpoint Command = CommandEndpoint
  79 -- instance HTTP_API Command