mirror of
https://github.com/monadicsystems/okapi.git
synced 2024-11-22 00:46:44 +03:00
Not good 2
This commit is contained in:
Rashad Gover
parent
613f599095
commit
56a024395f
96
old/Body/Alternative.hs
Normal file
96
old/Body/Alternative.hs
Normal file
@ -0,0 +1,96 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
-- module Okapi.Parser.Body.Alternative where
|
||||
|
||||
-- import Data.Bifunctor qualified as Bifunctor
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
-- import Okapi.Parser.Headers.Operation qualified as Operation
|
||||
-- import Control.Applicative (Alternative(..))
|
||||
-- import Okapi.Tree qualified as Tree
|
||||
|
||||
-- data Parser a where
|
||||
-- FMap :: (a -> b) -> Parser a -> Parser b
|
||||
-- Pure :: a -> Parser a
|
||||
-- Apply :: Parser (a -> b) -> Parser a -> Parser b
|
||||
-- Empty :: Parser a
|
||||
-- Or :: Parser a -> Parser a -> Parser a
|
||||
-- Optional :: Parser a -> Parser (Maybe a)
|
||||
-- Option :: a -> Parser a -> Parser a
|
||||
-- Operation :: Operation.Parser a -> Parser a
|
||||
|
||||
-- instance Functor Parser where
|
||||
-- fmap = FMap
|
||||
|
||||
-- instance Applicative Parser where
|
||||
-- pure = Pure
|
||||
-- (<*>) = Apply
|
||||
|
||||
-- instance Alternative Parser where
|
||||
-- empty = Empty
|
||||
-- (<|>) = Or
|
||||
|
||||
-- param :: Web.FromHttpApiData a => HTTP.HeaderName -> Parser a
|
||||
-- param = Operation . Operation.Param
|
||||
|
||||
-- cookie :: BS.ByteString -> Parser ()
|
||||
-- cookie = Operation . Operation.Cookie
|
||||
|
||||
-- optional :: Web.FromHttpApiData a => Parser a -> Parser (Maybe a)
|
||||
-- optional = Optional
|
||||
|
||||
-- option :: Web.FromHttpApiData a => a -> Parser a -> Parser a
|
||||
-- option = Option
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either (Tree.Tree Operation.Error) a, Wai.Request)
|
||||
-- eval (FMap f opX) state = case eval opX state of
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- (Right x, state') -> (Right $ f x, state')
|
||||
-- eval (Pure x) state = (Right x, state)
|
||||
-- eval (Apply opF opX) state = case eval opF state of
|
||||
-- (Right f, state') -> case eval opX state' of
|
||||
-- (Right x, state'') -> (Right $ f x, state'')
|
||||
-- (Left e, state'') -> (Left e, state'')
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- eval Empty state = (Left Tree.Nil, state)
|
||||
-- eval (Or opA opB) state = case eval opA state of
|
||||
-- (Right a, state') -> (Right a, state')
|
||||
-- (Left l, state') -> case eval opB state' of
|
||||
-- (Right b, state'') -> (Right b, state'')
|
||||
-- (Left r, state'') -> (Left (l Tree.:|: r), state'')
|
||||
-- eval (Optional op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- Operation cookie@(Operation.Cookie _) -> case Operation.eval cookie state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- _ -> case eval op state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (Left err, state') -> (Left err, state')
|
||||
-- eval (Option def op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- Operation cookie@(Operation.Cookie _) -> case Operation.eval cookie state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- _ -> eval op state
|
||||
-- eval (Operation op) state = Bifunctor.first (Bifunctor.first Tree.Leaf) $ Operation.eval op state
|
||||
|
||||
-- class FromQuery a where
|
||||
-- parser :: Parser a
|
||||
|
||||
-- parse :: FromQuery a => Wai.Request -> Either (Tree.Tree Operation.Error) a
|
||||
-- parse req = fst $ eval parser req
|
||||
81
old/Body/Applicative.hs
Normal file
81
old/Body/Applicative.hs
Normal file
@ -0,0 +1,81 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
-- module Okapi.Parser.Body.Applicative where
|
||||
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
-- import Okapi.Parser.Headers.Operation qualified as Operation
|
||||
|
||||
-- data Parser a where
|
||||
-- FMap :: (a -> b) -> Parser a -> Parser b
|
||||
-- Pure :: a -> Parser a
|
||||
-- Apply :: Parser (a -> b) -> Parser a -> Parser b
|
||||
-- Optional :: Parser a -> Parser (Maybe a)
|
||||
-- Option :: a -> Parser a -> Parser a
|
||||
-- Operation :: Operation.Parser a -> Parser a
|
||||
|
||||
-- instance Functor Parser where
|
||||
-- fmap = FMap
|
||||
|
||||
-- instance Applicative Parser where
|
||||
-- pure = Pure
|
||||
-- (<*>) = Apply
|
||||
|
||||
-- param :: Web.FromHttpApiData a => HTTP.HeaderName -> Parser a
|
||||
-- param = Operation . Operation.Param
|
||||
|
||||
-- cookie :: BS.ByteString -> Parser ()
|
||||
-- cookie = Operation . Operation.Cookie
|
||||
|
||||
-- optional :: Web.FromHttpApiData a => Parser a -> Parser (Maybe a)
|
||||
-- optional = Optional
|
||||
|
||||
-- option :: Web.FromHttpApiData a => a -> Parser a -> Parser a
|
||||
-- option = Option
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either Operation.Error a, Wai.Request)
|
||||
-- eval (FMap f opX) state = case eval opX state of
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- (Right x, state') -> (Right $ f x, state')
|
||||
-- eval (Pure x) state = (Right x, state)
|
||||
-- eval (Apply opF opX) state = case eval opF state of
|
||||
-- (Right f, state') -> case eval opX state' of
|
||||
-- (Right x, state'') -> (Right $ f x, state'')
|
||||
-- (Left e, state'') -> (Left e, state'')
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- eval (Optional op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- Operation cookie@(Operation.Cookie _) -> case Operation.eval cookie state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- _ -> case eval op state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (Left err, state') -> (Left err, state')
|
||||
-- eval (Option def op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- Operation cookie@(Operation.Cookie _) -> case Operation.eval cookie state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- _ -> eval op state
|
||||
-- eval (Operation op) state = Operation.eval op state
|
||||
|
||||
-- class FromQuery a where
|
||||
-- parser :: Parser a
|
||||
|
||||
-- parse :: FromQuery a => Wai.Request -> Either Operation.Error a
|
||||
-- parse req = fst $ eval parser req
|
||||
54
old/Body/Operation.hs
Normal file
54
old/Body/Operation.hs
Normal file
@ -0,0 +1,54 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
-- {-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- module Okapi.Parser.Body.Operation where
|
||||
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.ByteString.Lazy qualified as LBS
|
||||
-- import Data.ByteString.Builder qualified as Builder
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Web.Cookie qualified as Web
|
||||
|
||||
-- data Error
|
||||
-- = ParseFail
|
||||
-- | ParamNotFound
|
||||
-- | CookieHeaderNotFound
|
||||
-- | CookieNotFound
|
||||
-- | HeaderValueParseFail
|
||||
-- | CookieValueParseFail
|
||||
-- deriving (Eq, Show)
|
||||
|
||||
-- data Parser a where
|
||||
-- Param :: Web.FromHttpApiData a => HTTP.HeaderName -> Parser a
|
||||
-- Cookie :: Web.FromHttpApiData a => BS.ByteString -> Parser a
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either Error a, Wai.Request)
|
||||
-- eval (Param name) state = case lookup name state.requestHeaders of
|
||||
-- Nothing -> (Left ParamNotFound, state)
|
||||
-- Just vBS -> case Web.parseHeaderMaybe vBS of
|
||||
-- Nothing -> (Left HeaderValueParseFail, state)
|
||||
-- Just v -> (Right v, state {Wai.requestHeaders = List.delete (name, vBS) state.requestHeaders})
|
||||
-- eval (Cookie name) state = case lookup "Cookie" state.requestHeaders of
|
||||
-- Nothing -> (Left CookieHeaderNotFound, state) -- TODO: Cookie not found
|
||||
-- Just cookiesBS -> case lookup name $ Web.parseCookies cookiesBS of
|
||||
-- Nothing -> (Left CookieNotFound, state) -- TODO: Cookie parameter with given name not found
|
||||
-- Just valueBS -> case Web.parseHeaderMaybe valueBS of
|
||||
-- Nothing -> (Left CookieValueParseFail, state)
|
||||
-- Just value ->
|
||||
-- ( Right value,
|
||||
-- let headersWithoutCookie = List.delete ("Cookie", cookiesBS) state.requestHeaders
|
||||
-- newCookie = LBS.toStrict (Builder.toLazyByteString $ Web.renderCookies $ List.delete (name, valueBS) $ Web.parseCookies cookiesBS)
|
||||
-- in state { Wai.requestHeaders = map (\header@(headerName, _) -> if headerName == "Cookie" then ("Cookie", newCookie) else header) state.requestHeaders }
|
||||
-- -- TODO: Order of the cookie in the headers isn't preserved, but maybe this is fine??
|
||||
-- )
|
||||
96
old/Headers/Alternative.hs
Normal file
96
old/Headers/Alternative.hs
Normal file
@ -0,0 +1,96 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
-- module Okapi.Parser.Headers.Alternative where
|
||||
|
||||
-- import Data.Bifunctor qualified as Bifunctor
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
-- import Okapi.Parser.Headers.Operation qualified as Operation
|
||||
-- import Control.Applicative (Alternative(..))
|
||||
-- import Okapi.Tree qualified as Tree
|
||||
|
||||
-- data Parser a where
|
||||
-- FMap :: (a -> b) -> Parser a -> Parser b
|
||||
-- Pure :: a -> Parser a
|
||||
-- Apply :: Parser (a -> b) -> Parser a -> Parser b
|
||||
-- Empty :: Parser a
|
||||
-- Or :: Parser a -> Parser a -> Parser a
|
||||
-- Optional :: Parser a -> Parser (Maybe a)
|
||||
-- Option :: a -> Parser a -> Parser a
|
||||
-- Operation :: Operation.Parser a -> Parser a
|
||||
|
||||
-- instance Functor Parser where
|
||||
-- fmap = FMap
|
||||
|
||||
-- instance Applicative Parser where
|
||||
-- pure = Pure
|
||||
-- (<*>) = Apply
|
||||
|
||||
-- instance Alternative Parser where
|
||||
-- empty = Empty
|
||||
-- (<|>) = Or
|
||||
|
||||
-- param :: Web.FromHttpApiData a => HTTP.HeaderName -> Parser a
|
||||
-- param = Operation . Operation.Param
|
||||
|
||||
-- cookie :: BS.ByteString -> Parser ()
|
||||
-- cookie = Operation . Operation.Cookie
|
||||
|
||||
-- optional :: Web.FromHttpApiData a => Parser a -> Parser (Maybe a)
|
||||
-- optional = Optional
|
||||
|
||||
-- option :: Web.FromHttpApiData a => a -> Parser a -> Parser a
|
||||
-- option = Option
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either (Tree.Tree Operation.Error) a, Wai.Request)
|
||||
-- eval (FMap f opX) state = case eval opX state of
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- (Right x, state') -> (Right $ f x, state')
|
||||
-- eval (Pure x) state = (Right x, state)
|
||||
-- eval (Apply opF opX) state = case eval opF state of
|
||||
-- (Right f, state') -> case eval opX state' of
|
||||
-- (Right x, state'') -> (Right $ f x, state'')
|
||||
-- (Left e, state'') -> (Left e, state'')
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- eval Empty state = (Left Tree.Nil, state)
|
||||
-- eval (Or opA opB) state = case eval opA state of
|
||||
-- (Right a, state') -> (Right a, state')
|
||||
-- (Left l, state') -> case eval opB state' of
|
||||
-- (Right b, state'') -> (Right b, state'')
|
||||
-- (Left r, state'') -> (Left (l Tree.:|: r), state'')
|
||||
-- eval (Optional op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- Operation cookie@(Operation.Cookie _) -> case Operation.eval cookie state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- _ -> case eval op state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (Left err, state') -> (Left err, state')
|
||||
-- eval (Option def op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- Operation cookie@(Operation.Cookie _) -> case Operation.eval cookie state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- _ -> eval op state
|
||||
-- eval (Operation op) state = Bifunctor.first (Bifunctor.first Tree.Leaf) $ Operation.eval op state
|
||||
|
||||
-- class FromQuery a where
|
||||
-- parser :: Parser a
|
||||
|
||||
-- parse :: FromQuery a => Wai.Request -> Either (Tree.Tree Operation.Error) a
|
||||
-- parse req = fst $ eval parser req
|
||||
81
old/Headers/Applicative.hs
Normal file
81
old/Headers/Applicative.hs
Normal file
@ -0,0 +1,81 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
-- module Okapi.Parser.Headers.Applicative where
|
||||
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
-- import Okapi.Parser.Headers.Operation qualified as Operation
|
||||
|
||||
-- data Parser a where
|
||||
-- FMap :: (a -> b) -> Parser a -> Parser b
|
||||
-- Pure :: a -> Parser a
|
||||
-- Apply :: Parser (a -> b) -> Parser a -> Parser b
|
||||
-- Optional :: Parser a -> Parser (Maybe a)
|
||||
-- Option :: a -> Parser a -> Parser a
|
||||
-- Operation :: Operation.Parser a -> Parser a
|
||||
|
||||
-- instance Functor Parser where
|
||||
-- fmap = FMap
|
||||
|
||||
-- instance Applicative Parser where
|
||||
-- pure = Pure
|
||||
-- (<*>) = Apply
|
||||
|
||||
-- param :: Web.FromHttpApiData a => HTTP.HeaderName -> Parser a
|
||||
-- param = Operation . Operation.Param
|
||||
|
||||
-- cookie :: BS.ByteString -> Parser ()
|
||||
-- cookie = Operation . Operation.Cookie
|
||||
|
||||
-- optional :: Web.FromHttpApiData a => Parser a -> Parser (Maybe a)
|
||||
-- optional = Optional
|
||||
|
||||
-- option :: Web.FromHttpApiData a => a -> Parser a -> Parser a
|
||||
-- option = Option
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either Operation.Error a, Wai.Request)
|
||||
-- eval (FMap f opX) state = case eval opX state of
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- (Right x, state') -> (Right $ f x, state')
|
||||
-- eval (Pure x) state = (Right x, state)
|
||||
-- eval (Apply opF opX) state = case eval opF state of
|
||||
-- (Right f, state') -> case eval opX state' of
|
||||
-- (Right x, state'') -> (Right $ f x, state'')
|
||||
-- (Left e, state'') -> (Left e, state'')
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- eval (Optional op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- Operation cookie@(Operation.Cookie _) -> case Operation.eval cookie state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- _ -> case eval op state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (Left err, state') -> (Left err, state')
|
||||
-- eval (Option def op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- Operation cookie@(Operation.Cookie _) -> case Operation.eval cookie state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- _ -> eval op state
|
||||
-- eval (Operation op) state = Operation.eval op state
|
||||
|
||||
-- class FromQuery a where
|
||||
-- parser :: Parser a
|
||||
|
||||
-- parse :: FromQuery a => Wai.Request -> Either Operation.Error a
|
||||
-- parse req = fst $ eval parser req
|
||||
54
old/Headers/Operation.hs
Normal file
54
old/Headers/Operation.hs
Normal file
@ -0,0 +1,54 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
-- {-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- module Okapi.Parser.Headers.Operation where
|
||||
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.ByteString.Lazy qualified as LBS
|
||||
-- import Data.ByteString.Builder qualified as Builder
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Web.Cookie qualified as Web
|
||||
|
||||
-- data Error
|
||||
-- = ParseFail
|
||||
-- | ParamNotFound
|
||||
-- | CookieHeaderNotFound
|
||||
-- | CookieNotFound
|
||||
-- | HeaderValueParseFail
|
||||
-- | CookieValueParseFail
|
||||
-- deriving (Eq, Show)
|
||||
|
||||
-- data Parser a where
|
||||
-- Param :: Web.FromHttpApiData a => HTTP.HeaderName -> Parser a
|
||||
-- Cookie :: Web.FromHttpApiData a => BS.ByteString -> Parser a
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either Error a, Wai.Request)
|
||||
-- eval (Param name) state = case lookup name state.requestHeaders of
|
||||
-- Nothing -> (Left ParamNotFound, state)
|
||||
-- Just vBS -> case Web.parseHeaderMaybe vBS of
|
||||
-- Nothing -> (Left HeaderValueParseFail, state)
|
||||
-- Just v -> (Right v, state {Wai.requestHeaders = List.delete (name, vBS) state.requestHeaders})
|
||||
-- eval (Cookie name) state = case lookup "Cookie" state.requestHeaders of
|
||||
-- Nothing -> (Left CookieHeaderNotFound, state) -- TODO: Cookie not found
|
||||
-- Just cookiesBS -> case lookup name $ Web.parseCookies cookiesBS of
|
||||
-- Nothing -> (Left CookieNotFound, state) -- TODO: Cookie parameter with given name not found
|
||||
-- Just valueBS -> case Web.parseHeaderMaybe valueBS of
|
||||
-- Nothing -> (Left CookieValueParseFail, state)
|
||||
-- Just value ->
|
||||
-- ( Right value,
|
||||
-- let headersWithoutCookie = List.delete ("Cookie", cookiesBS) state.requestHeaders
|
||||
-- newCookie = LBS.toStrict (Builder.toLazyByteString $ Web.renderCookies $ List.delete (name, valueBS) $ Web.parseCookies cookiesBS)
|
||||
-- in state { Wai.requestHeaders = map (\header@(headerName, _) -> if headerName == "Cookie" then ("Cookie", newCookie) else header) state.requestHeaders }
|
||||
-- -- TODO: Order of the cookie in the headers isn't preserved, but maybe this is fine??
|
||||
-- )
|
||||
1
old/Path/Alternative.hs
Normal file
1
old/Path/Alternative.hs
Normal file
@ -0,0 +1 @@
|
||||
module Okapi.Parser.Path.Alternative where
|
||||
1
old/Path/Applicative.hs
Normal file
1
old/Path/Applicative.hs
Normal file
@ -0,0 +1 @@
|
||||
module Okapi.Parser.Path.Applicative where
|
||||
96
old/Query/Alternative.hs
Normal file
96
old/Query/Alternative.hs
Normal file
@ -0,0 +1,96 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
-- module Okapi.Parser.Query.Alternative where
|
||||
|
||||
-- import Data.Bifunctor qualified as Bifunctor
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
-- import Okapi.Parser.Query.Operation qualified as Operation
|
||||
-- import Control.Applicative (Alternative(..))
|
||||
-- import Okapi.Tree qualified as Tree
|
||||
|
||||
-- data Parser a where
|
||||
-- FMap :: (a -> b) -> Parser a -> Parser b
|
||||
-- Pure :: a -> Parser a
|
||||
-- Apply :: Parser (a -> b) -> Parser a -> Parser b
|
||||
-- Empty :: Parser a
|
||||
-- Or :: Parser a -> Parser a -> Parser a
|
||||
-- Optional :: Parser a -> Parser (Maybe a)
|
||||
-- Option :: a -> Parser a -> Parser a
|
||||
-- Operation :: Operation.Parser a -> Parser a
|
||||
|
||||
-- instance Functor Parser where
|
||||
-- fmap = FMap
|
||||
|
||||
-- instance Applicative Parser where
|
||||
-- pure = Pure
|
||||
-- (<*>) = Apply
|
||||
|
||||
-- instance Alternative Parser where
|
||||
-- empty = Empty
|
||||
-- (<|>) = Or
|
||||
|
||||
-- param :: Web.FromHttpApiData a => BS.ByteString -> Parser a
|
||||
-- param = Operation . Operation.Param
|
||||
|
||||
-- flag :: BS.ByteString -> Parser ()
|
||||
-- flag = Operation . Operation.Flag
|
||||
|
||||
-- optional :: Web.FromHttpApiData a => Parser a -> Parser (Maybe a)
|
||||
-- optional = Optional
|
||||
|
||||
-- option :: Web.FromHttpApiData a => a -> Parser a -> Parser a
|
||||
-- option = Option
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either (Tree.Tree Operation.Error) a, Wai.Request)
|
||||
-- eval (FMap f opX) state = case eval opX state of
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- (Right x, state') -> (Right $ f x, state')
|
||||
-- eval (Pure x) state = (Right x, state)
|
||||
-- eval (Apply opF opX) state = case eval opF state of
|
||||
-- (Right f, state') -> case eval opX state' of
|
||||
-- (Right x, state'') -> (Right $ f x, state'')
|
||||
-- (Left e, state'') -> (Left e, state'')
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- eval Empty state = (Left Tree.Nil, state)
|
||||
-- eval (Or opA opB) state = case eval opA state of
|
||||
-- (Right a, state') -> (Right a, state')
|
||||
-- (Left l, state') -> case eval opB state' of
|
||||
-- (Right b, state'') -> (Right b, state'')
|
||||
-- (Left r, state'') -> (Left (l Tree.:|: r), state'')
|
||||
-- eval (Optional op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- Operation flag@(Operation.Flag _) -> case Operation.eval flag state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- _ -> case eval op state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (Left err, state') -> (Left err, state')
|
||||
-- eval (Option def op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- Operation flag@(Operation.Flag _) -> case Operation.eval flag state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- _ -> eval op state
|
||||
-- eval (Operation op) state = Bifunctor.first (Bifunctor.first Tree.Leaf) $ Operation.eval op state
|
||||
|
||||
-- class FromQuery a where
|
||||
-- parser :: Parser a
|
||||
|
||||
-- parse :: FromQuery a => Wai.Request -> Either (Tree.Tree Operation.Error) a
|
||||
-- parse req = fst $ eval parser req
|
||||
81
old/Query/Applicative.hs
Normal file
81
old/Query/Applicative.hs
Normal file
@ -0,0 +1,81 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
-- module Okapi.Parser.Query.Applicative where
|
||||
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
-- import Okapi.Parser.Query.Operation qualified as Operation
|
||||
|
||||
-- data Parser a where
|
||||
-- FMap :: (a -> b) -> Parser a -> Parser b
|
||||
-- Pure :: a -> Parser a
|
||||
-- Apply :: Parser (a -> b) -> Parser a -> Parser b
|
||||
-- Optional :: Parser a -> Parser (Maybe a)
|
||||
-- Option :: a -> Parser a -> Parser a
|
||||
-- Operation :: Operation.Parser a -> Parser a
|
||||
|
||||
-- instance Functor Parser where
|
||||
-- fmap = FMap
|
||||
|
||||
-- instance Applicative Parser where
|
||||
-- pure = Pure
|
||||
-- (<*>) = Apply
|
||||
|
||||
-- param :: Web.FromHttpApiData a => BS.ByteString -> Parser a
|
||||
-- param = Operation . Operation.Param
|
||||
|
||||
-- flag :: BS.ByteString -> Parser ()
|
||||
-- flag = Operation . Operation.Flag
|
||||
|
||||
-- optional :: Web.FromHttpApiData a => Parser a -> Parser (Maybe a)
|
||||
-- optional = Optional
|
||||
|
||||
-- option :: Web.FromHttpApiData a => a -> Parser a -> Parser a
|
||||
-- option = Option
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either Operation.Error a, Wai.Request)
|
||||
-- eval (FMap f opX) state = case eval opX state of
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- (Right x, state') -> (Right $ f x, state')
|
||||
-- eval (Pure x) state = (Right x, state)
|
||||
-- eval (Apply opF opX) state = case eval opF state of
|
||||
-- (Right f, state') -> case eval opX state' of
|
||||
-- (Right x, state'') -> (Right $ f x, state'')
|
||||
-- (Left e, state'') -> (Left e, state'')
|
||||
-- (Left e, state') -> (Left e, state')
|
||||
-- eval (Optional op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- Operation flag@(Operation.Flag _) -> case Operation.eval flag state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (_, state') -> (Right Nothing, state')
|
||||
-- _ -> case eval op state of
|
||||
-- (Right result, state') -> (Right $ Just result, state')
|
||||
-- (Left err, state') -> (Left err, state')
|
||||
-- eval (Option def op) state = case op of
|
||||
-- Operation param@(Operation.Param _) -> case Operation.eval param state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- Operation flag@(Operation.Flag _) -> case Operation.eval flag state of
|
||||
-- (Right result, state') -> (Right result, state')
|
||||
-- (_, state') -> (Right def, state')
|
||||
-- _ -> eval op state
|
||||
-- eval (Operation op) state = Operation.eval op state
|
||||
|
||||
-- class FromQuery a where
|
||||
-- parser :: Parser a
|
||||
|
||||
-- parse :: FromQuery a => Wai.Request -> Either Operation.Error a
|
||||
-- parse req = fst $ eval parser req
|
||||
40
old/Query/Operation.hs
Normal file
40
old/Query/Operation.hs
Normal file
@ -0,0 +1,40 @@
|
||||
-- {-# LANGUAGE GADTs #-}
|
||||
-- {-# LANGUAGE ImportQualifiedPost #-}
|
||||
-- {-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
-- module Okapi.Parser.Query.Operation where
|
||||
|
||||
-- import Data.ByteString qualified as BS
|
||||
-- import Data.List qualified as List
|
||||
-- import Data.Text qualified as Text
|
||||
-- import Data.Text.Encoding qualified as Text
|
||||
-- import Network.HTTP.Types qualified as HTTP
|
||||
-- import Web.HttpApiData qualified as Web
|
||||
-- import Network.Wai qualified as Wai
|
||||
-- import Network.Wai.Internal qualified as Wai
|
||||
|
||||
-- data Error
|
||||
-- = ParseFail
|
||||
-- | FlagNotFound
|
||||
-- | ParamNotFound
|
||||
-- | ParamNoValue
|
||||
-- deriving (Eq, Show)
|
||||
|
||||
-- data Parser a where
|
||||
-- Param :: Web.FromHttpApiData a => BS.ByteString -> Parser a
|
||||
-- Flag :: BS.ByteString -> Parser ()
|
||||
|
||||
-- eval ::
|
||||
-- Parser a ->
|
||||
-- Wai.Request ->
|
||||
-- (Either Error a, Wai.Request)
|
||||
-- eval (Param name) state = case lookup name state.queryString of
|
||||
-- Nothing -> (Left ParamNotFound, state)
|
||||
-- Just maybeVBS -> case maybeVBS of
|
||||
-- Nothing -> (Left ParamNoValue, state)
|
||||
-- Just vBS -> case Web.parseQueryParamMaybe $ Text.decodeUtf8 vBS of
|
||||
-- Nothing -> (Left ParseFail, state)
|
||||
-- Just v -> (Right v, state { Wai.queryString = List.delete (name, Just vBS) state.queryString })
|
||||
-- eval (Flag name) state = case lookup name state.queryString of
|
||||
-- Nothing -> (Left FlagNotFound, state)
|
||||
-- Just found -> (Right (), state { Wai.queryString = List.delete (name, found) state.queryString })
|
||||
Loading…
Reference in New Issue
Block a user