diff --git a/lib/okapi.cabal b/lib/okapi.cabal index 5d8ab8f..4e1435c 100644 --- a/lib/okapi.cabal +++ b/lib/okapi.cabal @@ -33,7 +33,7 @@ library -- Okapi.DSL.Applicative -- Okapi.Parser.Body -- Okapi.Parser.Headers - -- Okapi.Parser.Path + Okapi.Parser.Path -- Okapi.Parser.Query -- Okapi.Parser.Request Okapi.NewDSL diff --git a/lib/src/Okapi/DSL/Alternative.hs b/lib/src/Okapi/DSL/Alternative.hs index 10ab6fc..22479c5 100644 --- a/lib/src/Okapi/DSL/Alternative.hs +++ b/lib/src/Okapi/DSL/Alternative.hs @@ -11,41 +11,41 @@ import Okapi.DSL -- 2. Some errors. Just output. Means something went wrong, but program was able to recover. -- 3. Errors. Nothing output. Means everything went wrong. -exec :: DSL expr input error => Program expr input (Tree error) (Maybe output) -> input -> (Maybe output, (input, Tree error)) -exec (FMap f prog) input = case exec prog input of - (Nothing, (input', eTree)) -> (Nothing, (input', eTree)) - (Just o, (input', eTree)) -> (Just o, (input', eTree)) -exec (Pure x) input = (Just x, (input, Nil)) -exec (Apply progF progX) input = case exec progF input of - (Just f, (input', eTreeF)) -> case exec progX input of - (Just x, (input'', eTreeX)) -> (Just $ f x, (input'', eTreeF :->: eTreeX )) - (Nothing, (input'', eTreeX)) -> (Nothing, (input'', eTreeF :->: eTreeX)) - (Nothing, (input', eTreeF)) -> (Nothing, (input', eTreeF)) -eval Empty input = (Nothing, (input, Nil)) -eval (Or progA progB) input = case exec progA input of - (Just a, (input', eTreeA)) -> (Just a, (input', eTreeA)) - (Nothing, (_, eTreeA)) -> case exec progB input of - (Just b, (input', eTreeB)) -> (Just b, (input', eTreeA :<|>: eTreeB)) - (Nothing, (input', eTreeB)) -> (Nothing, (input', eTreeA :<|>: eTreeB)) -exec (Expr expr) input = case eval expr input of - (Left error, input') -> (Nothing, (input', Leaf error)) - (Right x, input') -> (Just x, (input', Nil)) +-- exec :: DSL expr input error => Program expr input (Tree error) (Maybe output) -> input -> (Maybe output, (input, Tree error)) +-- exec (FMap f prog) input = case exec prog input of +-- (Nothing, (input', eTree)) -> (Nothing, (input', eTree)) +-- (Just o, (input', eTree)) -> (Just o, (input', eTree)) +-- exec (Pure x) input = (Just x, (input, Nil)) +-- exec (Apply progF progX) input = case exec progF input of +-- (Just f, (input', eTreeF)) -> case exec progX input of +-- (Just x, (input'', eTreeX)) -> (Just $ f x, (input'', eTreeF :->: eTreeX )) +-- (Nothing, (input'', eTreeX)) -> (Nothing, (input'', eTreeF :->: eTreeX)) +-- (Nothing, (input', eTreeF)) -> (Nothing, (input', eTreeF)) +-- eval Empty input = (Nothing, (input, Nil)) +-- eval (Or progA progB) input = case exec progA input of +-- (Just a, (input', eTreeA)) -> (Just a, (input', eTreeA)) +-- (Nothing, (_, eTreeA)) -> case exec progB input of +-- (Just b, (input', eTreeB)) -> (Just b, (input', eTreeA :<|>: eTreeB)) +-- (Nothing, (input', eTreeB)) -> (Nothing, (input', eTreeA :<|>: eTreeB)) +-- exec (Expr expr) input = case eval expr input of +-- (Left error, input') -> (Nothing, (input', Leaf error)) +-- (Right x, input') -> (Just x, (input', Nil)) -data Program expr input error output where - FMap :: (output -> output') -> Program expr input error output -> Program expr input error output' - Pure :: output -> Program expr input error output - Apply :: Program expr input error (output -> output') -> Program expr input error output -> Program expr input error output' - Empty :: Program expr input error output - Or :: Program expr input error output -> Program expr input error output -> Program expr input error output - Expr :: expr -> Program expr input error output +-- data Program expr input error output where +-- FMap :: (output -> output') -> Program expr input error output -> Program expr input error output' +-- Pure :: output -> Program expr input error output +-- Apply :: Program expr input error (output -> output') -> Program expr input error output -> Program expr input error output' +-- Empty :: Program expr input error output +-- Or :: Program expr input error output -> Program expr input error output -> Program expr input error output +-- Expr :: expr -> Program expr input error output -instance Functor (Program expr input error) where - fmap = FMap +-- instance Functor (Program expr input error) where +-- fmap = FMap -instance Applicative (Program expr input error) where - pure = Pure - (<*>) = Apply +-- instance Applicative (Program expr input error) where +-- pure = Pure +-- (<*>) = Apply -instance Alternative (Program expr input error) where - empty = Empty - (<|>) = Or +-- instance Alternative (Program expr input error) where +-- empty = Empty +-- (<|>) = Or diff --git a/lib/src/Okapi/DSL/Applicative.hs b/lib/src/Okapi/DSL/Applicative.hs index 9514450..44f1214 100644 --- a/lib/src/Okapi/DSL/Applicative.hs +++ b/lib/src/Okapi/DSL/Applicative.hs @@ -5,27 +5,27 @@ module Okapi.DSL.Applicative where import Okapi.DSL -data Program expr input error output where - FMap :: (output -> output') -> Program expr input error output -> Program expr input error output' - Pure :: output -> Program expr input error output - Apply :: Program expr input error (output -> output') -> Program expr input error output -> Program expr input error output' - Expr :: expr -> Program expr input error output +-- data Program expr input error output where +-- FMap :: (output -> output') -> Program expr input error output -> Program expr input error output' +-- Pure :: output -> Program expr input error output +-- Apply :: Program expr input error (output -> output') -> Program expr input error output -> Program expr input error output' +-- Expr :: expr -> Program expr input error output -exec :: DSL expr input error output => Program expr input error output -> input -> (Either error output, input) -exec (FMap f prog) input = case exec prog input of - (Left e, input') -> (Left e, input') - (Right o, input') -> (Right $ f o, input') -exec (Pure x) input = (Right x, input) -exec (Apply progF progX) input = case exec progF input of - (Right f, input') -> case exec progX input' of - (Right x, input'') -> (Right $ f x, input'') - (Left e, input'') -> (Left e, input'') - (Left e, input') -> (Left e, input') -exec (Expr expr) input = eval expr input +-- exec :: forall expr input error output. DSL expr input error output => Program expr input error output -> input -> (Either error output, input) +-- exec (FMap f prog) input = case exec @expr @input @error @output prog input of +-- (Left e, input') -> (Left e, input') +-- (Right o, input') -> (Right $ f o, input') +-- exec (Pure x) input = (Right x, input) +-- exec (Apply progF progX) input = case exec progF input of +-- (Right f, input') -> case exec progX input' of +-- (Right x, input'') -> (Right $ f x, input'') +-- (Left e, input'') -> (Left e, input'') +-- (Left e, input') -> (Left e, input') +-- exec (Expr expr) input = eval expr input -instance Functor (Program expr input error) where - fmap = FMap +-- instance Functor (Program expr input error) where +-- fmap = FMap -instance Applicative (Program expr input error) where - pure = Pure - (<*>) = Apply +-- instance Applicative (Program expr input error) where +-- pure = Pure +-- (<*>) = Apply diff --git a/lib/src/Okapi/NewDSL.hs b/lib/src/Okapi/NewDSL.hs index 4a612b5..c74c762 100644 --- a/lib/src/Okapi/NewDSL.hs +++ b/lib/src/Okapi/NewDSL.hs @@ -1,16 +1,38 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + module Okapi.NewDSL where +import Data.Kind (Type) -data Error = Error +type Interpreter (expr :: * -> *) state error a = state -> expr a -> (Either error a, state) -data Program a where - FMap :: (a -> a') -> Program a -> Program a' - Pure :: a -> Program a - Apply :: Program (a -> a') -> Program a -> Program a' - Expr :: Expr a -> Program a +data DSL (expr :: * -> *) state error a where + FMap :: (a -> a') -> DSL expr state error a -> DSL expr state error a' + Pure :: a -> DSL expr state error a + Apply :: DSL expr state error (a -> b) -> DSL expr state error a -> DSL expr state error b + Eval :: Interpreter expr state error a -> expr a -> DSL expr state error a -instance Functor Program where +instance Functor (DSL expr state error) where fmap = FMap -instance Applicative Program where +instance Applicative (DSL expr state error) where pure = Pure (<*>) = Apply + +exec :: state -> DSL expr state error a -> (Either error a, state) +exec state (FMap f expr) = case exec state expr of + (Left e, state') -> (Left e, state') + (Right o, state') -> (Right $ f o, state') +exec state (Pure x) = (Right x, state) +exec state (Apply progF progX) = case exec state progF of + (Right f, state') -> case exec state' progX of + (Right x, state'') -> (Right $ f x, state'') + (Left e, state'') -> (Left e, state'') + (Left e, state') -> (Left e, state') +exec state (Eval eval expr) = eval state expr diff --git a/lib/src/Okapi/Parser/Path.hs b/lib/src/Okapi/Parser/Path.hs index 59b4005..9ad092d 100644 --- a/lib/src/Okapi/Parser/Path.hs +++ b/lib/src/Okapi/Parser/Path.hs @@ -1,33 +1,47 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeApplications #-} module Okapi.Parser.Path where import Data.Text -import Okapi.DSL +import Okapi.NewDSL import qualified Web.HttpApiData as Web -data Expr where - Static :: Web.ToHttpApiData a => a -> Expr - Param :: Web.FromHttpApiData a => Expr - End :: Expr +data Expr a where + Static :: Web.ToHttpApiData a => a -> Expr () + Param :: Web.FromHttpApiData a => Expr a + End :: Expr () + +type State = [Text] data Error where Error :: Text -> Error -data Result where - StaticResult :: () -> Result - ParamResult :: Web.FromHttpApiData a => a -> Result - EndResult :: () -> Result - +interpreter :: Interpreter Expr State Error a +interpreter state expr = case expr of + Static @t x -> undefined + Param @t -> undefined + End -> undefined -instance DSL Expr [Text] Error where - eval :: Expr -> [Text] -> (Either Error Result, [Text]) - eval (Static @t x) input = (Right $ StaticResult (), []) - eval (Param @t) input = undefined - eval End [] = (Right $ EndResult (), []) +embed :: Expr a -> DSL Expr State Error a +embed = Eval interpreter + +static :: Web.ToHttpApiData a => a -> DSL Expr State Error () +static x = embed $ Static x + +param :: Web.FromHttpApiData a => DSL Expr State Error a +param = embed Param + +end :: Web.FromHttpApiData a => DSL Expr State Error () +end = embed End + +-- instance DSL Expr [Text] Error where +-- eval :: Expr -> [Text] -> (Either Error Result, [Text]) +-- eval (Static @t x) input = (Right $ StaticResult (), []) +-- eval (Param @t) input = undefined +-- eval End [] = (Right $ EndResult (), [])