src/Literate/Web/Semantics/Compiler.hs

   1 -- For CompilerToF
   2 {-# LANGUAGE ConstraintKinds #-}
   3 -- For Output
   4 {-# LANGUAGE DeriveFunctor #-}
   5 -- For CompilerToF
   6 {-# LANGUAGE UndecidableInstances #-}
   7 -- For CompilerToF
   8 {-# LANGUAGE AllowAmbiguousTypes #-}
   9 -- For Output
  10 {-# LANGUAGE RankNTypes #-}
  11 -- For Dataable__
  12 {-# LANGUAGE InstanceSigs #-}
  13
  14 module Literate.Web.Semantics.Compiler where
  15
  16 import Control.Applicative (Applicative (..))
  17 import Control.Monad (Monad (..), forM, forM_, join, sequence, (>=>))
  18 import Control.Monad.Classes qualified as MC
  19 import Control.Monad.Trans.Class qualified as MT
  20 import Control.Monad.Trans.Reader qualified as MT
  21 import Data.Bool
  22 import Data.ByteString.Lazy qualified as BSL
  23 import Data.Either (Either (..))
  24 import Data.Eq (Eq (..))
  25 import Data.Foldable (toList)
  26 import Data.Function (const, id, ($), (.))
  27 import Data.Functor (Functor (..), (<$>))
  28 import Data.Kind (Constraint, Type)
  29 import Data.List qualified as List
  30 import Data.Maybe (Maybe (..))
  31 import Data.Ord (Ord (..))
  32 import Data.Proxy (Proxy (..))
  33 import Data.Semigroup (Semigroup (..))
  34 import Data.String (fromString)
  35 import Data.Text (Text)
  36 import Data.Text qualified as Text
  37 import Data.Tuple (curry, fst, snd)
  38 import GHC.Generics (Generic)
  39 import GHC.Stack (HasCallStack)
  40 import Literate.Web.Syntaxes
  41 import Literate.Web.Types.MIME
  42 import Literate.Web.Types.URL
  43 import Symantic qualified as Sym
  44 import System.Directory qualified as Sys
  45 import System.FilePath qualified as Sys
  46 import System.FilePattern.Directory qualified as Sys
  47 import System.IO qualified as Sys
  48 import Text.Show (Show (..))
  49 import Type.Reflection ((:~:) (..))
  50 import Prelude (undefined)
  51
  52 -- * Type 'Compiler'
  53 newtype Compiler m a = Compiler {unCompiler :: {-FIXME: is m required?-}m [Output a]}
  54   -- deriving (Functor)
  55
  56 compile ::
  57   MC.MonadExec Sys.IO m =>
  58   CompilerEnv ->
  59   Compiler m a ->
  60   CompilerToF a (m BSL.ByteString) ->
  61   m ()
  62 compile CompilerEnv{..} router content = do
  63   outputs <- unCompiler router
  64   MC.exec @Sys.IO $ Sys.removePathForcibly compilerEnvDest
  65   forM_ outputs $ \Output{..} -> do
  66     let destPath =
  67           ( List.intercalate "." $
  68               encodePath outputPath :
  69               ( if List.null outputExts
  70                   then ["txt"]
  71                   else Text.unpack . encodePathSegment <$> outputExts
  72               )
  73           )
  74     -- hPutStrLn stderr $ "mkdir: " <> show (Sys.takeDirectory destPath)
  75     MC.exec @Sys.IO $
  76       Sys.createDirectoryIfMissing True $
  77         compilerEnvDest Sys.</> Sys.takeDirectory destPath
  78     -- hPutStrLn stderr $ "write: " <> show destPath
  79     bsl <- outputData content
  80     MC.exec @Sys.IO $
  81       BSL.writeFile (compilerEnvDest Sys.</> destPath) $
  82         bsl
  83
  84
  85 compi :: Compiler m (m BSL.ByteString) -> Compiler m (m BSL.ByteString)
  86 compi = id
  87
  88 -- compile2 ::
  89 --   MC.MonadExec Sys.IO m =>
  90 --   CompilerEnv ->
  91 --   Compiler m (m BSL.ByteString) ->
  92 --   m ()
  93 -- compile2 CompilerEnv{..} router = do
  94 --   outputs <- unCompiler router
  95 --   MC.exec @Sys.IO $ Sys.removePathForcibly compilerEnvDest
  96 --   -- FIXME: use pipes
  97 --   forM_ outputs $ \Output{..} -> do
  98 --     let destPath =
  99 --           ( List.intercalate "." $
 100 --               encodePath outputPath :
 101 --               ( if List.null outputExts
 102 --                   then ["txt"]
 103 --                   else Text.unpack . encodePathSegment <$> outputExts
 104 --               )
 105 --           )
 106 --     -- hPutStrLn stderr $ "mkdir: " <> show (Sys.takeDirectory destPath)
 107 --     MC.exec @Sys.IO $
 108 --       Sys.createDirectoryIfMissing True $
 109 --         compilerEnvDest Sys.</> Sys.takeDirectory destPath
 110 --     -- hPutStrLn stderr $ "write: " <> show destPath
 111 --     outputBSL <- outputData content
 112 --     MC.exec @Sys.IO $
 113 --       BSL.writeFile (compilerEnvDest Sys.</> destPath) $
 114 --         outputBSL
 115
 116 manifest :: forall m a. Monad m => Compiler m a -> m [Sys.FilePath]
 117 manifest router = do
 118   outputs <- unCompiler router
 119   return
 120     [ destPath
 121     | out <- outputs
 122     , let destPath =
 123             ( List.intercalate "." $
 124                 encodePath (outputPath out) :
 125                 ( if List.null (outputExts out)
 126                     then ["txt"]
 127                     else Text.unpack . encodePathSegment <$> outputExts out
 128                 )
 129             )
 130     ]
 131
 132 -- instance Applicative m => Applicative (Compiler m) where
 133 --   pure = Compiler . pure . pure . pure
 134 --   liftA2 f (Compiler a) (Compiler b) = Compiler (liftA2 (liftA2 (liftA2 f)) a b)
 135 -- instance Monad m => Monad (Compiler m) where
 136 --   return = pure
 137 --   Compiler mloa >>= a2mlob =
 138 --     Compiler $ do
 139 --       mloa >>= \loa ->
 140 --         (join <$>) $
 141 --           forM loa $ \oa -> do
 142 --             lob <- unCompiler $ a2mlob $ outputData oa
 143 --             forM lob $ \ob ->
 144 --               return
 145 --                 ob
 146 --                   { outputPath = outputPath oa <> outputPath ob
 147 --                   , outputExts = outputExts oa <> outputExts ob
 148 --                   }
 149 instance Applicative m => Sym.ProductFunctor (Compiler m) where
 150   Compiler a <.> Compiler b = Compiler $ liftA2 (liftA2 (<.>)) a b
 151   Compiler a <. Compiler b = Compiler $ liftA2 (liftA2 (<.)) a b
 152   Compiler a .> Compiler b = Compiler $ liftA2 (liftA2 (.>)) a b
 153 --instance Applicative m => Sym.AlternativeFunctor (Compiler m) where
 154 --  Compiler a <|> Compiler b = Compiler (liftA2 (<>) a b)
 155 instance Applicative m => Sym.SumFunctor (Compiler m) where
 156   Compiler a <+> Compiler b = Compiler $ liftA2 (\as bs -> (a2e <$> as) <> (b2e <$> bs)) a b
 157     where
 158     a2e :: Output a -> Output (Either a b)
 159     a2e o = o{ outputData = outputData o . fst }
 160     b2e :: Output b -> Output (Either a b)
 161     b2e o = o{ outputData = outputData o . snd }
 162
 163 instance (Applicative m, CompilerUnToF a) => Optionable a (Compiler m) where
 164   optional (Compiler ma) = Compiler $ (\as -> (a2n <$> as) <> (a2j <$> as)) <$> ma
 165     where
 166     a2n :: Output a -> Output (Maybe a)
 167     a2n o = o{ outputData = ($ Nothing) }
 168     a2j :: Output a -> Output (Maybe a)
 169     a2j o = o{ outputData = \k -> outputData o $ compilerUnToF @(CompilerIsToF a) $ k . Just }
 170 --   optional (Compiler ma) = Compiler $ (\as -> (a2n <$> as) <> (a2j <$> as)) <$> ma
 171 --     --pure Nothing Sym.<|> (Just <$> ma)
 172 --     where
 173 --     a2n :: Output a -> Output (Maybe a)
 174 --     a2n o = o{ outputData = fst }
 175 --     a2j :: Output a -> Output (Maybe a)
 176 --     a2j o = o{ outputData = outputData o . snd }
 177 --
 178 -- ** Class 'CompilerUnToF'
 179 type CompilerUnToF a = CompilerUnToFIf (CompilerIsToF a) a
 180 class CompilerUnToFIf (t :: Bool) a where
 181   compilerUnToF :: (a -> next) -> CompilerToFIf t a next
 182 instance CompilerUnToFIf 'True () where
 183   compilerUnToF = ($ ())
 184 instance (CompilerUnToF a, CompilerUnToF b) => CompilerUnToFIf 'True (a, b) where
 185   compilerUnToF ab2n = compilerUnToF @(CompilerIsToF a) $ \a -> compilerUnToF @(CompilerIsToF b) $ \b -> ab2n (a,b)
 186 instance (CompilerUnToF a, CompilerUnToF b) => CompilerUnToFIf 'True (Either a b) where
 187   compilerUnToF e2n = ( compilerUnToF @(CompilerIsToF a) $ e2n . Left
 188                       , compilerUnToF @(CompilerIsToF b) $ e2n . Right
 189                       )
 190 instance CompilerUnToFIf 'False a where
 191   compilerUnToF = id
 192
 193 instance
 194   ( Generic a
 195   , Sym.RepOfEoT a
 196   , sem ~ Compiler m
 197   , CompilerIsToF a ~ 'False
 198   , e ~ Sym.EoT (Sym.ADT a)
 199   , CompilerUnToF e
 200   , Functor m
 201   ) => Dataable__ a (Compiler m) where
 202   data__ :: sem (Sym.EoT (Sym.ADT a)) -> sem a
 203   data__ (Compiler e) = Compiler ((data__ <$>) <$> e)
 204 instance
 205   ( Generic a
 206   --, Sym.EoTOfRep a
 207   , Sym.RepOfEoT a
 208   , sem ~ Output
 209   , CompilerIsToF a ~ 'False
 210   --, CompilerIsToF eot ~ 'False
 211   , eot ~ Sym.EoT (Sym.ADT a)
 212   , CompilerUnToF eot
 213   ) => Dataable__ a Output where
 214   data__ :: sem (Sym.EoT (Sym.ADT a)) -> sem a
 215   data__ o = o { outputData = \k -> (outputData o) $ compilerUnToF @(CompilerIsToF eot) $ k . Sym.adtOfeot }
 216 instance Applicative m => PathSegmentable (Compiler m) where
 217   pathSegment s = Compiler $ pure
 218     [
 219       Output
 220         { outputPath = [s]
 221         , outputExts = []
 222         , outputData = id
 223         }
 224     ]
 225 instance
 226   ( Show a
 227   , Monad m
 228   , n ~ m
 229   , end ~ m BSL.ByteString
 230   , MimeTypes ts (MimeEncodable a)
 231   ) =>
 232   Responsable a ts n end (Compiler m)
 233   where
 234   response = Compiler $ pure $
 235     ( \(_mediaType, MimeType (Proxy :: Proxy t)) ->
 236         Output
 237           { outputPath = []
 238           , outputExts = [decodePathSegment (fileExtension @t)]
 239           , outputData = \(Refl, Response ma) -> do
 240               a <- ma
 241               pure $ mimeEncode @_ @t a
 242           }
 243     )
 244       <$> toList (mimeTypesMap @ts @(MimeEncodable a))
 245
 246 -- ** Type 'CompilerEnv'
 247 data CompilerEnv = CompilerEnv
 248   { compilerEnvDest :: Sys.FilePath
 249   , -- , compilerEnvSource :: Sys.FilePath
 250     compilerEnvIndex :: Sys.FilePath
 251     --, compilerEnvModel :: model
 252     -- , compilerEnvPath :: [PathSegment]
 253   }
 254   deriving (Show)
 255
 256 -- ** Type 'Output'
 257 -- TODO: use Seq instead of []
 258 data Output a = Output
 259   { outputPath :: [PathSegment]
 260   , outputExts :: [PathSegment]
 261   , outputData :: forall next. CompilerToF a next -> next
 262   --, outputBSL :: BSL.ByteString
 263   -- , outputType :: MimeType (MimeEncodable a)
 264   }
 265
 266 -- instance Sym.SumFunctor Output where
 267 --   a <+> b = Output
 268 --     { outputPath = outputPath a <> outputPath b
 269 --     , outputExts = outputExts a <> outputExts b
 270 --     , outputData = \(a2n, b2n) -> outputData a a2n
 271 --     }
 272 instance Sym.ProductFunctor Output where
 273   a <.> b = Output
 274     { outputPath = outputPath a <> outputPath b
 275     , outputExts = outputExts a <> outputExts b
 276     , outputData = outputData b . outputData a
 277     }
 278   a <. b = Output
 279     { outputPath = outputPath a <> outputPath b
 280     , outputExts = outputExts a <> outputExts b
 281     , outputData = outputData b . outputData a
 282     }
 283   a .> b = Output
 284     { outputPath = outputPath a <> outputPath b
 285     , outputExts = outputExts a <> outputExts b
 286     , outputData = outputData b . outputData a
 287     }
 288 --   deriving (Functor, Show)
 289 -- instance Applicative Output where
 290 --   pure a =
 291 --     Output
 292 --       { outputPath = []
 293 --       , outputExts = []
 294 --       , outputData = a
 295 --       --, outputBSL = ""
 296 --       -- , outputType = mediaType @PlainText
 297 --       }
 298 --   oa2b <*> oa =
 299 --     Output
 300 --       { outputPath = outputPath oa2b <> outputPath oa
 301 --       , outputExts = outputExts oa2b <> outputExts oa
 302 --       , outputData = outputData oa2b (outputData oa)
 303 --       --, outputBSL = outputBSL oa2b <> outputBSL oa
 304 --       }
 305
 306
 307 -- * Type family 'CompilerToF'
 308 type CompilerToF a next = CompilerToFIf (CompilerIsToF a) a next
 309 type family CompilerToFIf t a next :: Type where
 310 -- For '<.>': curry.
 311   CompilerToFIf 'True (a, b) next = CompilerToF a (CompilerToF b next)
 312 -- For '<+>', request both branches.
 313   CompilerToFIf 'True (Either l r) next = (CompilerToF l next, CompilerToF r next)
 314   --CompilerToFIf 'True (Maybe a) next = (CompilerToF () next, CompilerToF a next)
 315 -- Useless to ask '()' as argument.
 316   CompilerToFIf 'True () next = next
 317 -- Enable a different return value for each function.
 318   CompilerToFIf 'True (Sym.Endpoint end a) next = (next :~: end, a)
 319 -- Everything else becomes a new argument.
 320   CompilerToFIf 'False a next = a -> next
 321
 322
 323 -- | This 'Bool' is added to 'ToFIf' to avoid overlapping instances.
 324 type family CompilerIsToF a :: Bool where
 325   CompilerIsToF () = 'True
 326   CompilerIsToF (a, b) = 'True
 327   CompilerIsToF (Either l r) = 'True
 328   --CompilerIsToF (Maybe a) = 'True
 329   CompilerIsToF (Sym.Endpoint end a) = 'True
 330   CompilerIsToF a = 'False
 331
 332
 333 -- -- pathSegments _ss = Compiler $
 334 -- --   MT.ReaderT $ \s ->
 335 -- --     -- TODO: assert Set.member s ss
 336 -- --     lift $
 337 -- --       MT.modify' $ \st ->
 338 -- --         st{compilerStatePath = compilerStatePath st </> Text.unpack (encodePathSegment s)}
 339 --
 340 -- {-
 341 -- instance
 342 --   TypeError (
 343 --     'Text "The instance (Capturable a Compiler)"
 344 --     ':$$: 'Text "is disabled when compiling to a static Web site."
 345 --     ':$$: 'Text "You can use (whenInterpreter @Compiler siteNotUsingCapturable siteUsingCapturable)"
 346 --     ':$$: 'Text "to replace calls to any method of Capturable."
 347 --   ) => Capturable a Compiler where
 348 --   capturePathSegment = undefined
 349 -- instance
 350 --   TypeError (
 351 --     'Text "The instance (Capturable a (Reader model Compiler))"
 352 --     ':$$: 'Text "is disabled when compiling to a static Web site."
 353 --     ':$$: 'Text "You can use (whenInterpreter @(Reader model Compiler) siteNotUsingCapturable siteUsingCapturable)"
 354 --     ':$$: 'Text "to replace calls to any method of Capturable."
 355 --   ) => Capturable a (Reader model Compiler) where
 356 --   capturePathSegment = undefined
 357 -- -}
 358 --
 359 -- -- choosePathSegments _s = Compiler $ MT.ReaderT $ \s -> return $ Endo (List.reverse s <>)
 360 -- {-
 361 -- instance Capturable Compiler where
 362 --   type CapturableConstraint Compiler =
 363 --   capturePathSegment _n = Compiler $ MT.ReaderT $ \s ->
 364 --     lift $ MT.modify' $ \st ->
 365 --       st{compilerStatePath = compilerStatePath st </> Text.unpack (encodePathSegment s)}
 366 -- -}
 367 -- {-
 368 -- instance Copyable Compiler where
 369 --   copy path = Compiler $
 370 --     lift $
 371 --       MT.ReaderT $ \env -> do
 372 --         lift $ do
 373 --           doesPathExist (compilerEnvSource env </> path) >>= \case
 374 --             True -> do
 375 --               Sys.hPutStrLn Sys.stderr $
 376 --                 "staticCopy: "
 377 --                   <> show
 378 --                     ( (compilerEnvSource env </> path)
 379 --                     , (compilerEnvDest env </> path)
 380 --                     )
 381 --               copyDirRecursively
 382 --                 path
 383 --                 (compilerEnvSource env </> path)
 384 --                 (compilerEnvDest env)
 385 --             False -> do
 386 --               Sys.hPutStrLn Sys.stderr $ "error: path does not exist: " <> (compilerEnvSource env </> path)
 387 -- instance Encodable fmt a => Contentable fmt a Compiler where
 388 --   content = Compiler $
 389 --     MT.ReaderT $ \a -> MT.ReaderT $ \env -> do
 390 --       st <- MT.get
 391 --       let destPath = compilerEnvDest env </> compilerStatePath st
 392 --       lift $ do
 393 --         -- Sys.hPutStrLn Sys.stderr $ "mkdir: " <> show (Sys.takeDirectory destPath)
 394 --         createDirectoryIfMissing True (Sys.takeDirectory destPath)
 395 --         -- Sys.hPutStrLn Sys.stderr $ "write: " <> show destPath
 396 --         BSL.writeFile destPath $ encode @fmt a
 397 -- -}
 398 -- --instance Endable Compiler where
 399 -- --  end = Compiler $ return $ Endo id
 400 --
 401 -- --pathSegments _cs = Compiler $ MT.ReaderT $ \s -> return $ Endo (s :)
 402 -- -- instance Fileable Compiler where
 403 -- --   type FileableConstraint Compiler = Typeable
 404 -- --   static = Compiler $ MT.ReaderT $ \_a ->
 405 -- --     return $ Endo (\x -> x)
 406 --
 407 -- {-
 408 -- -- * The 'Compiler' interpreter
 409 --
 410 -- -- | Create files according to the given model of type 'a'.
 411 -- newtype Compiler a = Compiler
 412 --   { unCompiler :: [Comp a]
 413 --   }
 414 --   deriving (Show, Functor)
 415 --
 416 -- instance Applicative Compiler where
 417 --   pure = Compiler . pure . pure
 418 --   Compiler f <*> Compiler x = Compiler $ (<*>) <$> f <*> x
 419 --
 420 -- -- instance Monad Compiler where
 421 -- --   return = pure
 422 -- --   Compiler x >>= f = Compiler (x >>=)
 423 --
 424 -- compile :: Show a => Renderable a => Compiler a -> CompilerEnv -> Sys.IO ()
 425 -- compile compiler conf@CompilerEnv{..} = do
 426 --   createDirectoryIfMissing True compilerEnvDest
 427 --   let router = unCompiler compiler
 428 --   when (null router) $
 429 --     error "no router, nothing to compile"
 430 --   -- Sys.hPutStrLn Sys.stderr $ "conf: " <> show conf
 431 --   -- forM_ router $ \comp -> do
 432 --   --   Sys.hPutStrLn Sys.stderr $ "route: " <> show comp
 433 --   forM_ router $ \Comp{..} -> do
 434 --     -- Sys.hPutStrLn Sys.stderr $ "route: " <> show comp
 435 --     let routePath = pathOfPathSegments compPathSegments
 436 --      in case render compData of
 437 --           Left staticPath ->
 438 --             doesPathExist (compilerEnvSource </> staticPath) >>= \case
 439 --               True -> do
 440 --                 -- TODO: In current branch, we don't expect this to be a directory.
 441 --                 -- Although the user may pass it, but review before merge.
 442 --                 Sys.hPutStrLn Sys.stderr $
 443 --                   "staticCopy: "
 444 --                     <> show
 445 --                       ( (compilerEnvSource </> staticPath)
 446 --                       , (compilerEnvDest </> staticPath)
 447 --                       )
 448 --                 copyDirRecursively
 449 --                   staticPath
 450 --                   (compilerEnvSource </> staticPath)
 451 --                   (compilerEnvDest)
 452 --               False -> do
 453 --                 Sys.hPutStrLn Sys.stderr $ "error: path does not exist: " <> (compilerEnvSource </> staticPath)
 454 --           -- log LevelWarn $ toText $ "? " <> staticPath <> " (missing)"
 455 --           Right bs -> do
 456 --             let destPath = compilerEnvDest </> routePath
 457 --                            {-
 458 --                            maybe (routePath </> compilerEnvIndex)
 459 --                                  (routePath Sys.FilePath.<.>)
 460 --                                  (compType comp)
 461 --                           -}
 462 --             -- Sys.hPutStrLn Sys.stderr $ "mkdir: " <> show (Sys.takeDirectory destPath)
 463 --             createDirectoryIfMissing True (Sys.takeDirectory destPath)
 464 --             -- Sys.hPutStrLn Sys.stderr $ "write: " <> show destPath
 465 --             BSL.writeFile destPath bs
 466 --
 467 -- -- ** Class 'Renderable'
 468 -- class Renderable a where
 469 --   render :: a -> Either Sys.FilePath BSL.ByteString
 470 -- instance Renderable () where
 471 --   render () =
 472 --     --Left $ pathOfPathSegments compPathSegments
 473 --     Right BSL.empty
 474 --
 475 -- -- ** Type 'Comp'
 476 -- data Comp a = Comp
 477 --   { compPathSegments :: [PathSegment] -- TODO: Endo? Seq?
 478 --   , compData :: a
 479 --   -- , compType :: MimeType (MimeEncodable a)
 480 --   }
 481 -- deriving instance Eq a => Eq (Comp a)
 482 -- deriving instance Ord a => Ord (Comp a)
 483 -- deriving instance Show a => Show (Comp a)
 484 -- deriving instance Functor Comp
 485 -- instance Applicative Comp where
 486 --   pure compData =
 487 --     Comp
 488 --       { compPathSegments = []
 489 --       , compData
 490 --       -- , compType = mediaType @PlainText
 491 --       }
 492 --   f <*> x =
 493 --     Comp
 494 --       { compPathSegments = compPathSegments f <> compPathSegments x
 495 --       , compData = compData f (compData x)
 496 --       -- , compType = compType f <> compType x
 497 --       }
 498 --
 499 -- instance IsoFunctor Compiler where
 500 --   (<%>) Iso{..} = (a2b <$>)
 501 -- instance ProductFunctor Compiler where
 502 --   (<.>) = liftA2 (,)
 503 --   (<.) = (<*)
 504 --   (.>) = (*>)
 505 -- instance SumFunctor Compiler where
 506 --   x <+> y =
 507 --     Compiler $
 508 --       (<>)
 509 --         ((Left <$>) <$> unCompiler x)
 510 --         ((Right <$>) <$> unCompiler y)
 511 -- instance Optionable Compiler where
 512 --   optional x =
 513 --     Compiler $
 514 --       Comp { compPathSegments = []
 515 --            , compData = Nothing
 516 --            -- , compType = Nothing
 517 --            } :
 518 --       ((Just <$>) <$> unCompiler x)
 519 -- instance PathSegmentable Compiler where
 520 --   pathSegment s = Compiler
 521 --     [
 522 --       Comp
 523 --         { compPathSegments = [s]
 524 --         , compData = ()
 525 --         -- , compType = PlainText
 526 --         }
 527 --     ]
 528 --   pathSegments ss =
 529 --     Compiler $
 530 --       [ Comp{ compPathSegments = [s]
 531 --             , compData = s
 532 --             -- , compType = Nothing
 533 --             }
 534 --       | s <- toList ss
 535 --       ]
 536 -- instance ContentTypeable PlainText () Compiler where
 537 --   contentType =
 538 --     Compiler
 539 --       [ Comp
 540 --           { compPathSegments = []
 541 --           , compData = ()
 542 --           --, compType = mediaType @PlainText
 543 --           }
 544 --       ]
 545 --
 546 -- -- instance Repeatable Compiler where
 547 -- --   many0 (Compiler x) =
 548 -- --     Compiler $
 549 -- --       ((\Comp{} -> Comp [] []) <$> x)
 550 -- --         <> ((\(Comp s a) -> Comp s [a]) <$> x)
 551 -- --         <> ((\(Comp s a) -> Comp (s <> s) [a, a]) <$> x)
 552 -- --   many1 (Compiler x) =
 553 -- --     Compiler $
 554 -- --       ((\(Comp s a) -> Comp s [a]) <$> x)
 555 -- --         <> ((\(Comp s a) -> Comp (s <> s) [a, a]) <$> x)
 556 -- -- instance Endable Compiler where
 557 -- --   end = Compiler [Comp [] ()]
 558 -- -- instance Capturable Compiler where
 559 -- --   capturePathSegment n = Compiler $ [Comp [n] n]
 560 -- -- instance Constantable c Compiler where
 561 -- --   constant = pure
 562 -- -}
 563 --
 564 copyDirRecursively ::
 565   ( --MonadIO m,
 566     --MonadUnliftIO m,
 567     --MonadLoggerIO m,
 568     HasCallStack
 569   ) =>
 570   -- | Source file path relative to CWD
 571   Sys.FilePath ->
 572   -- | Absolute path to source file to copy.
 573   Sys.FilePath ->
 574   -- | Directory *under* which the source file/dir will be copied
 575   Sys.FilePath ->
 576   Sys.IO ()
 577 copyDirRecursively srcRel srcAbs destParent = do
 578   Sys.doesFileExist srcAbs >>= \case
 579     True -> do
 580       Sys.hPutStrLn Sys.stderr $ "copyDirRecursively: " <> show ("srcAbs is a file", srcAbs)
 581       copyFileCreatingParents srcAbs (destParent Sys.</> srcRel)
 582     False ->
 583       Sys.doesDirectoryExist srcAbs >>= \case
 584         False -> do
 585           Sys.hPutStrLn Sys.stderr $ "copyDirRecursively: " <> show ("srcAbs is neither a file nor directory", srcAbs)
 586           return ()
 587         -- throw $ StaticAssetMissing srcAbs
 588         True -> do
 589           Sys.hPutStrLn Sys.stderr $ "copyDirRecursively: " <> show ("srcAbs is a directory", srcAbs)
 590           Sys.createDirectoryIfMissing True (destParent Sys.</> srcRel)
 591           fs <- Sys.getDirectoryFiles srcAbs ["**"]
 592           forM_ fs $ \fp -> do
 593             let a = srcAbs Sys.</> fp
 594                 b = destParent Sys.</> srcRel Sys.</> fp
 595             copyFileCreatingParents a b
 596   where
 597     copyFileCreatingParents a b = do
 598       Sys.createDirectoryIfMissing True (Sys.takeDirectory b)
 599       Sys.copyFile a b