Maybe good...?

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

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

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

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

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 (), [])