]> Git — Sourcephile - webc.git/blob - src/Webc/Encoder.hs
wip
[webc.git] / src / Webc / Encoder.hs
1 module Webc.Encoder where
2
3 import Control.Monad (Monad (..))
4 import Control.Monad.Trans.Reader qualified as MT
5 import Data.Either (Either (..))
6 import Data.Foldable (foldMap)
7 import Data.Function (id, ($))
8
9 -- import Data.List qualified as List
10
11 import Data.ByteString.Lazy qualified as BSL
12 import Data.Maybe (Maybe (..))
13 import Data.Monoid (Endo (..), appEndo)
14 import Data.Semigroup (Semigroup (..))
15 import Network.URI.Slug
16 import Symantic.Classes (Iso (..), IsoFunctor ((<%>)), Optionable (..), ProductFunctor ((<.>)), SumFunctor ((<+>)))
17
18 import Webc.Classes
19 import Webc.Decoder (Request (..))
20 import Webc.MIME
21
22 -- * The 'Encoder' interpreter
23
24 -- | Encode a given route to its URL.
25 newtype Encoder a = Encoder
26 { unEncoder :: MT.Reader a (Endo [Slug])
27 }
28
29 encode :: Encoder a -> a -> [Slug]
30 encode (Encoder enc) a = appEndo (MT.runReader enc a) []
31
32 instance IsoFunctor Encoder where
33 Iso{..} <%> Encoder x = Encoder (MT.withReader b2a x)
34 instance ProductFunctor Encoder where
35 Encoder x <.> Encoder y = Encoder $
36 MT.ReaderT $ \(a, b) ->
37 return $ MT.runReader x a <> MT.runReader y b
38 instance SumFunctor Encoder where
39 Encoder x <+> Encoder y = Encoder $
40 MT.ReaderT $ \case
41 Left a -> return $ MT.runReader x a
42 Right b -> return $ MT.runReader y b
43 instance Repeatable Encoder where
44 many0 x = Encoder $
45 MT.ReaderT $ \as ->
46 return $ Endo (foldMap (encode x) as <>)
47 many1 = many0
48 instance Optionable Encoder where
49 optional (Encoder x) = Encoder $
50 MT.ReaderT $ \case
51 Nothing -> return $ Endo id
52 Just a -> return $ MT.runReader x a
53 instance Slugable Encoder where
54 literalSlug s = Encoder $ return $ Endo (s :)
55 chooseSlug _s = Encoder $ MT.ReaderT $ \s -> return $ Endo (s :)
56
57 {-
58 instance ContentTypeable PlainText BSL.ByteString Encoder where
59 contentType = Encoder $ MT.ReaderT $ \a ->
60 return a
61 -}
62 -- chooseSlugs _s = Encoder $ MT.ReaderT $ \s -> return $ Endo (List.reverse s <>)
63 instance Capturable Encoder where
64 captureSlug _n = Encoder $ MT.ReaderT $ \s -> return $ Endo (s :)
65 instance Endable Encoder where
66 end = Encoder $ return $ Endo id
67
68 --chooseSlug _cs = Encoder $ MT.ReaderT $ \s -> return $ Endo (s :)
69 -- instance Fileable Encoder where
70 -- type FileableConstraint Encoder = Typeable
71 -- static = Encoder $ MT.ReaderT $ \_a ->
72 -- return $ Endo (\x -> x)