{-# LANGUAGE FlexibleContexts, CPP #-}

module Main where

import Diagrams.Prelude hiding (value, option, (<>), Result)
import Diagrams.BoundingBox

import Diagrams.Backend.CmdLine (DiagramOpts(..))

#ifdef CAIRO
import Diagrams.Backend.CmdLine (mainRender, DiagramLoopOpts(..))
import Diagrams.Backend.Cairo (B)
import Diagrams.Backend.Cairo.CmdLine ()
#else
import Diagrams.Backend.SVG (B, renderSVG)
#endif

import Text.Puzzles.Puzzle
import Data.Puzzles.Compose
import Diagrams.Puzzles.Draw
import Data.Puzzles.PuzzleTypes

import Options.Applicative
import Control.Monad
import Data.Maybe
import Data.List (intercalate)

import System.FilePath
import System.Environment (getProgName)
import System.Exit

import qualified Data.Yaml as Y

data PuzzleOpts = PuzzleOpts
    { _format   :: String
    , _type     :: Maybe String
    , _puzzle   :: Bool
    , _solution :: Bool
    , _example  :: Bool
    , _input    :: FilePath
    }

puzzleOpts :: Parser PuzzleOpts
puzzleOpts = PuzzleOpts
    <$> strOption
            (long "format" <> short 'f'
             <> value (head formats)
             <> metavar "FMT"
             <> help ("Desired output format by file extension " ++ fmts))
    <*> (optional . strOption $
            (long "type" <> short 't'
             <> metavar "TYPE"
             <> help "Puzzle type, overriding type in input file"))
    <*> switch
            (long "puzzle" <> short 'p'
             <> help "Render puzzle (to base.ext")
    <*> switch
            (long "solution" <> short 's'
             <> help "Render solution (to base-sol.ext)")
    <*> switch
            (long "example" <> short 'e'
             <> help "Render example (to base.ext)")
    <*> argument str
            (metavar "INPUT"
             <> help "Puzzle file in .pzl format")
  where
    fmts = "(" ++ intercalate ", " formats ++ ")"

cmtopoint :: Double -> Double
cmtopoint = (* 28.3464567)

outputSuffix :: OutputChoice -> String
outputSuffix DrawPuzzle = ""
outputSuffix DrawSolution = "-sol"
outputSuffix DrawExample = ""

data RenderOpts = RenderOpts { _file :: FilePath, _w :: Double }

toRenderOpts :: OutputChoice -> Double -> PuzzleOpts -> RenderOpts
toRenderOpts oc w opts = RenderOpts out w'
  where
    f = _format opts
    w' = case f of "png" -> round' (40 * w)
                   _     -> cmtopoint (0.8 * w)
    base = takeBaseName (_input opts)
    out = addExtension (base ++ outputSuffix oc) f
    round' = (fromIntegral :: Int -> Double) . round

toDiagramOpts :: RenderOpts -> DiagramOpts
toDiagramOpts ropts = DiagramOpts (Just . round $ _w ropts)
                                  Nothing
                                  (_file ropts)

renderToFile :: RenderOpts -> Diagram B R2 -> IO ()
#ifdef CAIRO
renderToFile ropts = mainRender (toDiagramOpts ropts, lopts)
  where
    lopts = DiagramLoopOpts False Nothing 0
#else
renderToFile ropts = renderSVG (_file ropts) (Width $ _w ropts)
#endif

renderPuzzle :: PuzzleOpts -> (OutputChoice -> Maybe (Diagram B R2)) ->
                (OutputChoice, Bool) -> IO ()
renderPuzzle opts r (oc, req) = do
    let x = r oc
    if req && isNothing x
        then exitErr ("failed to render (no solution?): " ++ show oc)
        else return ()
    when (isJust x) $ do
        let Just x' = x
            w = fst . unr2 . boxExtents . boundingBox $ x'
            ropts = toRenderOpts oc w opts
        renderToFile ropts x'

defaultOpts :: Parser a -> IO a
defaultOpts optsParser = do
    prog <- getProgName
    let p = info (helper <*> optsParser)
                (fullDesc
                 <> progDesc "Command-line diagram generation."
                 <> header prog)
    execParser p

checkOutput :: PuzzleOpts -> IO [(OutputChoice, Bool)]
checkOutput opts
    | (p || s) && e  = exitErr "example output conflicts with puzzle/solution"
    | e              = return . map req $ [DrawExample]
    | p && s         = return . map req $ [DrawPuzzle, DrawSolution]
    | p              = return . map req $ [DrawPuzzle]
    | s              = return . map req $ [DrawSolution]
    | otherwise      = return [req DrawPuzzle, opt DrawSolution]
  where
    p = _puzzle opts
    s = _solution opts
    e = _example opts
    req x = (x, True)
    opt x = (x, False)

formats :: [String]
#ifdef CAIRO
formats = ["png", "svg", "ps", "pdf"]
#else
formats = ["svg"]
#endif

checkFormat :: PuzzleOpts -> IO ()
checkFormat opts = if f `elem` formats
                     then return ()
                     else exitErr $ "unknown format: " ++ f
  where
    f = _format opts

checkType :: Maybe String -> IO PuzzleType
checkType mt = do
    t <- maybe errno return mt
    maybe (errunk t) return (lookupType t)
  where
    errno    = exitErr $ "no puzzle type given"
    errunk t = exitErr $ "unknown puzzle type: " ++ t

readPuzzle :: FilePath -> IO (Either Y.ParseException TypedPuzzle)
readPuzzle = Y.decodeFileEither

exitErr :: String -> IO a
exitErr e = putStrLn e >> exitFailure

main :: IO ()
main = do
    opts <- defaultOpts puzzleOpts
    ocs <- checkOutput opts
    checkFormat opts
    mp <- readPuzzle (_input opts)
    TP mt pv msv <- case mp of Left  e -> exitErr $
                                          "parse failure: " ++ show e
                               Right p -> return p
    t <- checkType $ _type opts `mplus` mt
    let ps = Y.parseEither (handle drawPuzzleMaybeSol t) (pv, msv)
    case ps of Right ps' -> mapM_ (renderPuzzle opts (draw ps')) ocs
               Left    e -> exitErr e