Add GLB support to CLI app

Author: sgillespie

app/Command/GLTF/Loader/App.hs

@@ -5,7 +5,8 @@ import RIO.Process
 
 -- | Command line arguments
 data Options = Options
-  { optionsSummary :: !Bool,
+  { optionsBinary :: !Bool,
+    optionsSummary :: !Bool,
     optionsVerbose :: !Bool,
     optionsFile :: FilePath
   }
@@ -29,6 +30,11 @@ instance HasProcessContext App where
 instance HasOptions App where
   optionsL = lens appOptions (\app opts -> app { appOptions = opts })
 
+_optionsBinary :: Lens' Options Bool
+_optionsBinary = lens
+  optionsBinary
+  (\opts bin -> opts { optionsBinary = bin })
+
 _optionsSummary :: Lens' Options Bool
 _optionsSummary = lens
   optionsSummary

app/Command/GLTF/Loader/Run.hs

@@ -13,11 +13,15 @@ run :: RIO App ()
 run = do
   options <- asks (^. optionsL)
   let file = options ^. _optionsFile
+      binary = options ^. _optionsBinary
       summary = options ^. _optionsSummary
       verbose = options ^. _optionsVerbose
+      fromFile = if binary
+        then fmap (over _Right (^. _gltf)) . fromBinaryFile
+        else fromJsonFile
 
   logInfo $ "File: " <> fromString file
-  result <- liftIO $ fromJsonFile file
+  result <- liftIO $ fromFile file
 
   either reportError (reporter verbose summary) result
 

app/Main.hs

@@ -40,10 +40,16 @@ runApp processContext cliOptions logOptions appAction
 
 options :: Parser Options
 options = Options
-  <$> switch summaryOption
+  <$> switch binaryOption
+  <*> switch summaryOption
   <*> switch verboseOption
   <*> strArgument fileArg
 
+binaryOption :: Mod FlagFields Bool
+binaryOption = long "binary"
+  <> short 'b'
+  <> help "Load file as GLB (Binary glTF)"
+
 summaryOption :: Mod FlagFields Bool
 summaryOption
   = long "summary"