{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Ema.CLI where

import Data.Constraint.Extras.TH (deriveArgDict)
import Data.Default (Default (def))
import Data.GADT.Compare.TH
  ( DeriveGCompare (deriveGCompare),
    DeriveGEQ (deriveGEq),
  )
import Data.GADT.Show.TH (DeriveGShow (deriveGShow))
import Data.Some (Some (..))
import Ema.Server (Host, Port)
import Options.Applicative hiding (action)

-- | CLI subcommand
data Action res where
  Generate :: FilePath -> Action [FilePath]
  Run :: (Host, Port) -> Action ()

$(deriveGEq ''Action)
$(deriveGShow ''Action)
$(deriveGCompare ''Action)
$(deriveArgDict ''Action)

isLiveServer :: Some Action -> Bool
isLiveServer :: Some Action -> Bool
isLiveServer (Some (Run (Host, Port)
_)) = Bool
True
isLiveServer Some Action
_ = Bool
False

data Cli = Cli
  { Cli -> Some Action
action :: (Some Action)
  }
  deriving (Cli -> Cli -> Bool
(Cli -> Cli -> Bool) -> (Cli -> Cli -> Bool) -> Eq Cli
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cli -> Cli -> Bool
$c/= :: Cli -> Cli -> Bool
== :: Cli -> Cli -> Bool
$c== :: Cli -> Cli -> Bool
Eq, Int -> Cli -> ShowS
[Cli] -> ShowS
Cli -> String
(Int -> Cli -> ShowS)
-> (Cli -> String) -> ([Cli] -> ShowS) -> Show Cli
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cli] -> ShowS
$cshowList :: [Cli] -> ShowS
show :: Cli -> String
$cshow :: Cli -> String
showsPrec :: Int -> Cli -> ShowS
$cshowsPrec :: Int -> Cli -> ShowS
Show)

cliParser :: Parser Cli
cliParser :: Parser Cli
cliParser = do
  Some Action
action <-
    Mod CommandFields (Some Action) -> Parser (Some Action)
forall a. Mod CommandFields a -> Parser a
subparser
      (String
-> ParserInfo (Some Action) -> Mod CommandFields (Some Action)
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"gen" (Parser (Some Action)
-> InfoMod (Some Action) -> ParserInfo (Some Action)
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser (Some Action)
generate (String -> InfoMod (Some Action)
forall a. String -> InfoMod a
progDesc String
"Generate static HTML files")))
      Parser (Some Action)
-> Parser (Some Action) -> Parser (Some Action)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields (Some Action) -> Parser (Some Action)
forall a. Mod CommandFields a -> Parser a
subparser (String
-> ParserInfo (Some Action) -> Mod CommandFields (Some Action)
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"run" (Parser (Some Action)
-> InfoMod (Some Action) -> ParserInfo (Some Action)
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser (Some Action)
run (String -> InfoMod (Some Action)
forall a. String -> InfoMod a
progDesc String
"Run the live server")))
      Parser (Some Action)
-> Parser (Some Action) -> Parser (Some Action)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Some Action -> Parser (Some Action)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Action () -> Some Action
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Action () -> Some Action) -> Action () -> Some Action
forall a b. (a -> b) -> a -> b
$ (Host, Port) -> Action ()
Run (Host, Port)
forall a. Default a => a
def)
  pure Cli :: Some Action -> Cli
Cli {Some Action
action :: Some Action
action :: Some Action
..}
  where
    run :: Parser (Some Action)
    run :: Parser (Some Action)
run =
      Action () -> Some Action
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Action () -> Some Action)
-> ((Host, Port) -> Action ()) -> (Host, Port) -> Some Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Host, Port) -> Action ()
Run
        ((Host, Port) -> Some Action)
-> Parser (Host, Port) -> Parser (Some Action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (,) (Host -> Port -> (Host, Port))
-> Parser Host -> Parser (Port -> (Host, Port))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Host -> Parser Host
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields Host
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"host" Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Host
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h' Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Host
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HOST" Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Host
forall (f :: * -> *) a. String -> Mod f a
help String
"Host to bind to" Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> Host -> Mod OptionFields Host
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Host
forall a. Default a => a
def)
                Parser (Port -> (Host, Port)) -> Parser Port -> Parser (Host, Port)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Port -> Mod OptionFields Port -> Parser Port
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Port
forall a. Read a => ReadM a
auto (String -> Mod OptionFields Port
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port" Mod OptionFields Port
-> Mod OptionFields Port -> Mod OptionFields Port
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Port
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod OptionFields Port
-> Mod OptionFields Port -> Mod OptionFields Port
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Port
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT" Mod OptionFields Port
-> Mod OptionFields Port -> Mod OptionFields Port
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Port
forall (f :: * -> *) a. String -> Mod f a
help String
"Port to bind to" Mod OptionFields Port
-> Mod OptionFields Port -> Mod OptionFields Port
forall a. Semigroup a => a -> a -> a
<> Port -> Mod OptionFields Port
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Port
forall a. Default a => a
def)
            )
    generate :: Parser (Some Action)
    generate :: Parser (Some Action)
generate =
      Action [String] -> Some Action
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (Action [String] -> Some Action)
-> (String -> Action [String]) -> String -> Some Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Action [String]
Generate (String -> Some Action) -> Parser String -> Parser (Some Action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM String -> Mod ArgumentFields String -> Parser String
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM String
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DEST...")

cliAction :: IO Cli
cliAction :: IO Cli
cliAction = do
  ParserInfo Cli -> IO Cli
forall a. ParserInfo a -> IO a
execParser ParserInfo Cli
opts
  where
    opts :: ParserInfo Cli
opts =
      Parser Cli -> InfoMod Cli -> ParserInfo Cli
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (Parser Cli
cliParser Parser Cli -> Parser (Cli -> Cli) -> Parser Cli
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Cli -> Cli)
forall a. Parser (a -> a)
helper)
        ( InfoMod Cli
forall a. InfoMod a
fullDesc
            InfoMod Cli -> InfoMod Cli -> InfoMod Cli
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Cli
forall a. String -> InfoMod a
progDesc String
"Ema - static site generator"
            InfoMod Cli -> InfoMod Cli -> InfoMod Cli
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Cli
forall a. String -> InfoMod a
header String
"Ema"
        )