    -- | @futhark literate@
    --
    -- Also contains various utility definitions used by "Futhark.CLI.Script".
    module Futhark.CLI.Literate
      ( main,
        Options (..),
        initialOptions,
        scriptCommandLineOptions,
        prepareServer,
      )
    where

    import Codec.BMP qualified as BMP
    import Control.Monad
    import Control.Monad.Except
    import Control.Monad.State hiding (State)
    import Data.Bifunctor (first, second)
    import Data.Bits
    import Data.ByteString qualified as BS
    import Data.ByteString.Lazy qualified as LBS
    import Data.Char
    import Data.Functor (($>))
    import Data.Int (Int64)
    import Data.List qualified as L
    import Data.Map qualified as M
    import Data.Maybe
    import Data.Set qualified as S
    import Data.Text qualified as T
    import Data.Text.Encoding qualified as T
    import Data.Text.IO qualified as T
    import Data.Text.Read qualified as T
    import Data.Vector.Storable qualified as SVec
    import Data.Vector.Storable.ByteString qualified as SVec
    import Data.Void
    import Data.Word (Word32, Word8)
    import Futhark.Data
    import Futhark.Script
    import Futhark.Server
    import Futhark.Test
    import Futhark.Test.Values
    import Futhark.Util
      ( directoryContents,
        fancyTerminal,
        hashText,
        nubOrd,
        runProgramWithExitCode,
        showText,
      )
    import Futhark.Util.Options
    import Futhark.Util.Pretty (prettyText, prettyTextOneLine)
    import Futhark.Util.Pretty qualified as PP
    import Futhark.Util.ProgressBar
    import System.Directory
      ( copyFile,
        createDirectoryIfMissing,
        doesFileExist,
        getCurrentDirectory,
        removePathForcibly,
        setCurrentDirectory,
      )
    import System.Environment (getExecutablePath)
    import System.Exit
    import System.FilePath
    import System.IO
    import System.IO.Error (isDoesNotExistError)
    import System.IO.Temp (withSystemTempDirectory, withSystemTempFile)
    import Text.Megaparsec hiding (State, failure, token)
    import Text.Megaparsec.Char
    import Text.Printf

    newtype ImgParams = ImgParams
      { ImgParams -> Maybe FilePath
    imgFile :: Maybe FilePath
      }
      deriving (Int -> ImgParams -> ShowS
    [ImgParams] -> ShowS
    ImgParams -> FilePath
    (Int -> ImgParams -> ShowS)
    -> (ImgParams -> FilePath)
    -> ([ImgParams] -> ShowS)
    -> Show ImgParams
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ImgParams -> ShowS
    showsPrec :: Int -> ImgParams -> ShowS
    $cshow :: ImgParams -> FilePath
    show :: ImgParams -> FilePath
    $cshowList :: [ImgParams] -> ShowS
    showList :: [ImgParams] -> ShowS
    Show)

    defaultImgParams :: ImgParams
    defaultImgParams :: ImgParams
    defaultImgParams =
      ImgParams {imgFile :: Maybe FilePath
    imgFile = Maybe FilePath
    forall a. Maybe a
    Nothing}

    data VideoParams = VideoParams
      { VideoParams -> Maybe Int
    videoFPS :: Maybe Int,
        VideoParams -> Maybe Bool
    videoLoop :: Maybe Bool,
        VideoParams -> Maybe Bool
    videoAutoplay :: Maybe Bool,
        VideoParams -> Maybe Text
    videoFormat :: Maybe T.Text,
        VideoParams -> Maybe FilePath
    videoFile :: Maybe FilePath
      }
      deriving (Int -> VideoParams -> ShowS
    [VideoParams] -> ShowS
    VideoParams -> FilePath
    (Int -> VideoParams -> ShowS)
    -> (VideoParams -> FilePath)
    -> ([VideoParams] -> ShowS)
    -> Show VideoParams
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> VideoParams -> ShowS
    showsPrec :: Int -> VideoParams -> ShowS
    $cshow :: VideoParams -> FilePath
    show :: VideoParams -> FilePath
    $cshowList :: [VideoParams] -> ShowS
    showList :: [VideoParams] -> ShowS
    Show)

    defaultVideoParams :: VideoParams
    defaultVideoParams :: VideoParams
    defaultVideoParams =
      VideoParams
        { videoFPS :: Maybe Int
    videoFPS = Maybe Int
    forall a. Maybe a
    Nothing,
          videoLoop :: Maybe Bool
    videoLoop = Maybe Bool
    forall a. Maybe a
    Nothing,
          videoAutoplay :: Maybe Bool
    videoAutoplay = Maybe Bool
    forall a. Maybe a
    Nothing,
          videoFormat :: Maybe Text
    videoFormat = Maybe Text
    forall a. Maybe a
    Nothing,
          videoFile :: Maybe FilePath
    videoFile = Maybe FilePath
    forall a. Maybe a
    Nothing
        }

    data AudioParams = AudioParams
      { AudioParams -> Maybe Int
    audioSamplingFrequency :: Maybe Int,
        AudioParams -> Maybe Text
    audioCodec :: Maybe T.Text
      }
      deriving (Int -> AudioParams -> ShowS
    [AudioParams] -> ShowS
    AudioParams -> FilePath
    (Int -> AudioParams -> ShowS)
    -> (AudioParams -> FilePath)
    -> ([AudioParams] -> ShowS)
    -> Show AudioParams
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AudioParams -> ShowS
    showsPrec :: Int -> AudioParams -> ShowS
    $cshow :: AudioParams -> FilePath
    show :: AudioParams -> FilePath
    $cshowList :: [AudioParams] -> ShowS
    showList :: [AudioParams] -> ShowS
    Show)

    defaultAudioParams :: AudioParams
    defaultAudioParams :: AudioParams
    defaultAudioParams =
      AudioParams
        { audioSamplingFrequency :: Maybe Int
    audioSamplingFrequency = Maybe Int
    forall a. Maybe a
    Nothing,
          audioCodec :: Maybe Text
    audioCodec = Maybe Text
    forall a. Maybe a
    Nothing
        }

    data Directive
      = DirectiveRes Exp
      | DirectiveBrief Directive
      | DirectiveCovert Directive
      | DirectiveImg Exp ImgParams
      | DirectivePlot Exp (Maybe (Int, Int))
      | DirectiveGnuplot Exp T.Text
      | DirectiveVideo Exp VideoParams
      | DirectiveAudio Exp AudioParams
      deriving (Int -> Directive -> ShowS
    [Directive] -> ShowS
    Directive -> FilePath
    (Int -> Directive -> ShowS)
    -> (Directive -> FilePath)
    -> ([Directive] -> ShowS)
    -> Show Directive
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Directive -> ShowS
    showsPrec :: Int -> Directive -> ShowS
    $cshow :: Directive -> FilePath
    show :: Directive -> FilePath
    $cshowList :: [Directive] -> ShowS
    showList :: [Directive] -> ShowS
    Show)

    varsInDirective :: Directive -> S.Set EntryName
    varsInDirective :: Directive -> Set Text
    varsInDirective (DirectiveRes Exp
    e) = Exp -> Set Text
    varsInExp Exp
    e
    varsInDirective (DirectiveBrief Directive
    d) = Directive -> Set Text
    varsInDirective Directive
    d
    varsInDirective (DirectiveCovert Directive
    d) = Directive -> Set Text
    varsInDirective Directive
    d
    varsInDirective (DirectiveImg Exp
    e ImgParams
    _) = Exp -> Set Text
    varsInExp Exp
    e
    varsInDirective (DirectivePlot Exp
    e Maybe (Int, Int)
    _) = Exp -> Set Text
    varsInExp Exp
    e
    varsInDirective (DirectiveGnuplot Exp
    e Text
    _) = Exp -> Set Text
    varsInExp Exp
    e
    varsInDirective (DirectiveVideo Exp
    e VideoParams
    _) = Exp -> Set Text
    varsInExp Exp
    e
    varsInDirective (DirectiveAudio Exp
    e AudioParams
    _) = Exp -> Set Text
    varsInExp Exp
    e

    pprDirective :: Bool -> Directive -> PP.Doc a
    pprDirective :: forall a. Bool -> Directive -> Doc a
    pprDirective Bool
    _ (DirectiveRes Exp
    e) =
      Doc a
    "> " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a -> Doc a
    forall ann. Doc ann -> Doc ann
    PP.align (Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e)
    pprDirective Bool
    _ (DirectiveBrief Directive
    f) =
      Bool -> Directive -> Doc a
    forall a. Bool -> Directive -> Doc a
    pprDirective Bool
    False Directive
    f
    pprDirective Bool
    _ (DirectiveCovert Directive
    f) =
      Bool -> Directive -> Doc a
    forall a. Bool -> Directive -> Doc a
    pprDirective Bool
    False Directive
    f
    pprDirective Bool
    _ (DirectiveImg Exp
    e ImgParams
    params) =
      (Doc a
    "> :img " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a -> Doc a
    forall ann. Doc ann -> Doc ann
    PP.align (Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e))
        Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> if [Doc (ZonkAny 1)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Doc (ZonkAny 1)]
    forall {ann}. [Doc ann]
    params' then Doc a
    forall a. Monoid a => a
    mempty else Doc a
    ";" Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    forall ann. Doc ann
    PP.hardline Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> [Doc a] -> Doc a
    forall a. [Doc a] -> Doc a
    PP.stack [Doc a]
    forall {ann}. [Doc ann]
    params'
      where
        params' :: [Doc ann]
    params' = [Maybe (Doc ann)] -> [Doc ann]
    forall a. [Maybe a] -> [a]
    catMaybes [Doc ann
    -> (ImgParams -> Maybe FilePath)
    -> (FilePath -> Doc ann)
    -> Maybe (Doc ann)
    forall {b} {t}.
    (Semigroup b, IsString b) =>
    b -> (ImgParams -> Maybe t) -> (t -> b) -> Maybe b
    p Doc ann
    "file" ImgParams -> Maybe FilePath
    imgFile FilePath -> Doc ann
    forall ann. FilePath -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty]
        p :: b -> (ImgParams -> Maybe t) -> (t -> b) -> Maybe b
    p b
    s ImgParams -> Maybe t
    f t -> b
    pretty = do
          x <- ImgParams -> Maybe t
    f ImgParams
    params
          Just $ s <> ": " <> pretty x
    pprDirective Bool
    True (DirectivePlot Exp
    e (Just (Int
    h, Int
    w))) =
      [Doc a] -> Doc a
    forall a. [Doc a] -> Doc a
    PP.stack
        [ Doc a
    "> :plot2d " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    ";",
          Doc a
    "size: (" Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Int -> Doc a
    forall ann. Int -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty Int
    w Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    "," Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Int -> Doc a
    forall ann. Int -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty Int
    h Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    ")"
        ]
    pprDirective Bool
    _ (DirectivePlot Exp
    e Maybe (Int, Int)
    _) =
      Doc a
    "> :plot2d " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a -> Doc a
    forall ann. Doc ann -> Doc ann
    PP.align (Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e)
    pprDirective Bool
    True (DirectiveGnuplot Exp
    e Text
    script) =
      [Doc a] -> Doc a
    forall a. [Doc a] -> Doc a
    PP.stack ([Doc a] -> Doc a) -> [Doc a] -> Doc a
    forall a b. (a -> b) -> a -> b
    $
        Doc a
    "> :gnuplot " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a -> Doc a
    forall ann. Doc ann -> Doc ann
    PP.align (Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e) Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    ";"
          Doc a -> [Doc a] -> [Doc a]
    forall a. a -> [a] -> [a]
    : (Text -> Doc a) -> [Text] -> [Doc a]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Doc a
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty (Text -> [Text]
    T.lines Text
    script)
    pprDirective Bool
    False (DirectiveGnuplot Exp
    e Text
    _) =
      Doc a
    "> :gnuplot " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a -> Doc a
    forall ann. Doc ann -> Doc ann
    PP.align (Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e)
    pprDirective Bool
    False (DirectiveVideo Exp
    e VideoParams
    _) =
      Doc a
    "> :video " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a -> Doc a
    forall ann. Doc ann -> Doc ann
    PP.align (Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e)
    pprDirective Bool
    True (DirectiveVideo Exp
    e VideoParams
    params) =
      (Doc a
    "> :video " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e)
        Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> if [Doc (ZonkAny 2)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Doc (ZonkAny 2)]
    forall {ann}. [Doc ann]
    params' then Doc a
    forall a. Monoid a => a
    mempty else Doc a
    ";" Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    forall ann. Doc ann
    PP.hardline Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> [Doc a] -> Doc a
    forall a. [Doc a] -> Doc a
    PP.stack [Doc a]
    forall {ann}. [Doc ann]
    params'
      where
        params' :: [Doc ann]
    params' =
          [Maybe (Doc ann)] -> [Doc ann]
    forall a. [Maybe a] -> [a]
    catMaybes
            [ Doc ann
    -> (VideoParams -> Maybe Int)
    -> (Int -> Doc ann)
    -> Maybe (Doc ann)
    forall {b} {t}.
    (Semigroup b, IsString b) =>
    b -> (VideoParams -> Maybe t) -> (t -> b) -> Maybe b
    p Doc ann
    "fps" VideoParams -> Maybe Int
    videoFPS Int -> Doc ann
    forall ann. Int -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty,
              Doc ann
    -> (VideoParams -> Maybe Bool)
    -> (Bool -> Doc ann)
    -> Maybe (Doc ann)
    forall {b} {t}.
    (Semigroup b, IsString b) =>
    b -> (VideoParams -> Maybe t) -> (t -> b) -> Maybe b
    p Doc ann
    "loop" VideoParams -> Maybe Bool
    videoLoop Bool -> Doc ann
    forall {a}. IsString a => Bool -> a
    ppBool,
              Doc ann
    -> (VideoParams -> Maybe Bool)
    -> (Bool -> Doc ann)
    -> Maybe (Doc ann)
    forall {b} {t}.
    (Semigroup b, IsString b) =>
    b -> (VideoParams -> Maybe t) -> (t -> b) -> Maybe b
    p Doc ann
    "autoplay" VideoParams -> Maybe Bool
    videoAutoplay Bool -> Doc ann
    forall {a}. IsString a => Bool -> a
    ppBool,
              Doc ann
    -> (VideoParams -> Maybe Text)
    -> (Text -> Doc ann)
    -> Maybe (Doc ann)
    forall {b} {t}.
    (Semigroup b, IsString b) =>
    b -> (VideoParams -> Maybe t) -> (t -> b) -> Maybe b
    p Doc ann
    "format" VideoParams -> Maybe Text
    videoFormat Text -> Doc ann
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty,
              Doc ann
    -> (VideoParams -> Maybe FilePath)
    -> (FilePath -> Doc ann)
    -> Maybe (Doc ann)
    forall {b} {t}.
    (Semigroup b, IsString b) =>
    b -> (VideoParams -> Maybe t) -> (t -> b) -> Maybe b
    p Doc ann
    "file" VideoParams -> Maybe FilePath
    videoFile FilePath -> Doc ann
    forall ann. FilePath -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty
            ]
        ppBool :: Bool -> a
    ppBool Bool
    b = if Bool
    b then a
    "true" else a
    "false"
        p :: b -> (VideoParams -> Maybe t) -> (t -> b) -> Maybe b
    p b
    s VideoParams -> Maybe t
    f t -> b
    pretty = do
          x <- VideoParams -> Maybe t
    f VideoParams
    params
          Just $ s <> ": " <> pretty x
    pprDirective Bool
    _ (DirectiveAudio Exp
    e AudioParams
    params) =
      (Doc a
    "> :audio " Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Exp -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Exp -> Doc ann
    PP.pretty Exp
    e)
        Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> if [Doc (ZonkAny 3)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Doc (ZonkAny 3)]
    forall {ann}. [Doc ann]
    params' then Doc a
    forall a. Monoid a => a
    mempty else Doc a
    ";" Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    forall ann. Doc ann
    PP.hardline Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> [Doc a] -> Doc a
    forall a. [Doc a] -> Doc a
    PP.stack [Doc a]
    forall {ann}. [Doc ann]
    params'
      where
        params' :: [Doc ann]
    params' =
          [Maybe (Doc ann)] -> [Doc ann]
    forall a. [Maybe a] -> [a]
    catMaybes
            [ Doc ann
    -> (AudioParams -> Maybe Int)
    -> (Int -> Doc ann)
    -> Maybe (Doc ann)
    forall {b} {t}.
    (Semigroup b, IsString b) =>
    b -> (AudioParams -> Maybe t) -> (t -> b) -> Maybe b
    p Doc ann
    "sampling_frequency" AudioParams -> Maybe Int
    audioSamplingFrequency Int -> Doc ann
    forall ann. Int -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty,
              Doc ann
    -> (AudioParams -> Maybe Text)
    -> (Text -> Doc ann)
    -> Maybe (Doc ann)
    forall {b} {t}.
    (Semigroup b, IsString b) =>
    b -> (AudioParams -> Maybe t) -> (t -> b) -> Maybe b
    p Doc ann
    "codec" AudioParams -> Maybe Text
    audioCodec Text -> Doc ann
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    PP.pretty
            ]
        p :: b -> (AudioParams -> Maybe t) -> (t -> b) -> Maybe b
    p b
    s AudioParams -> Maybe t
    f t -> b
    pretty = do
          x <- AudioParams -> Maybe t
    f AudioParams
    params
          Just $ s <> ": " <> pretty x

    instance PP.Pretty Directive where
      pretty :: forall ann. Directive -> Doc ann
    pretty = Bool -> Directive -> Doc ann
    forall a. Bool -> Directive -> Doc a
    pprDirective Bool
    True

    data Block
      = BlockCode T.Text
      | BlockComment T.Text
      | BlockDirective Directive T.Text
      deriving (Int -> Block -> ShowS
    [Block] -> ShowS
    Block -> FilePath
    (Int -> Block -> ShowS)
    -> (Block -> FilePath) -> ([Block] -> ShowS) -> Show Block
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Block -> ShowS
    showsPrec :: Int -> Block -> ShowS
    $cshow :: Block -> FilePath
    show :: Block -> FilePath
    $cshowList :: [Block] -> ShowS
    showList :: [Block] -> ShowS
    Show)

    varsInScripts :: [Block] -> S.Set EntryName
    varsInScripts :: [Block] -> Set Text
    varsInScripts = (Block -> Set Text) -> [Block] -> Set Text
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Block -> Set Text
    varsInBlock
      where
        varsInBlock :: Block -> Set Text
    varsInBlock (BlockDirective Directive
    d Text
    _) = Directive -> Set Text
    varsInDirective Directive
    d
        varsInBlock BlockCode {} = Set Text
    forall a. Monoid a => a
    mempty
        varsInBlock BlockComment {} = Set Text
    forall a. Monoid a => a
    mempty

    type Parser = Parsec Void T.Text

    postlexeme :: Parser ()
    postlexeme :: Parser ()
    postlexeme = ParsecT Void Text Identity (Maybe ()) -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT Void Text Identity (Maybe ()) -> Parser ())
    -> ParsecT Void Text Identity (Maybe ()) -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Parser ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    hspace Parser ()
    -> ParsecT Void Text Identity (Maybe ())
    -> ParsecT Void Text Identity (Maybe ())
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser () -> ParsecT Void Text Identity (Maybe ())
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser () -> Parser ()
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity Text
    "--" ParsecT Void Text Identity Text -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ()
    postlexeme)

    lexeme :: Parser a -> Parser a
    lexeme :: forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    lexeme Parser a
    p = Parser a
    p Parser a -> Parser () -> Parser a
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ()
    postlexeme

    token :: T.Text -> Parser ()
    token :: Text -> Parser ()
    token = ParsecT Void Text Identity Text -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT Void Text Identity Text -> Parser ())
    -> (Text -> ParsecT Void Text Identity Text) -> Text -> Parser ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT Void Text Identity Text
     -> ParsecT Void Text Identity Text)
    -> (Text -> ParsecT Void Text Identity Text)
    -> Text
    -> ParsecT Void Text Identity Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    lexeme (ParsecT Void Text Identity Text
     -> ParsecT Void Text Identity Text)
    -> (Text -> ParsecT Void Text Identity Text)
    -> Text
    -> ParsecT Void Text Identity Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ParsecT Void Text Identity Text
    Tokens Text -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string

    parseInt :: Parser Int
    parseInt :: Parser Int
    parseInt = Parser Int -> Parser Int
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    lexeme (Parser Int -> Parser Int) -> Parser Int -> Parser Int
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int
    forall a. Read a => FilePath -> a
    read (FilePath -> Int)
    -> ParsecT Void Text Identity FilePath -> Parser Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Char
    -> ParsecT Void Text Identity FilePath
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    (Token s -> Bool) -> m (Token s)
    satisfy Char -> Bool
    Token Text -> Bool
    isDigit)

    restOfLine :: Parser T.Text
    restOfLine :: ParsecT Void Text Identity Text
    restOfLine = Maybe FilePath
    -> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
    takeWhileP Maybe FilePath
    forall a. Maybe a
    Nothing (Token Text -> Token Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    Token Text
    '\n') ParsecT Void Text Identity Text
    -> Parser () -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* (ParsecT Void Text Identity (Tokens Text) -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol Parser () -> Parser () -> Parser ()
    forall a.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof)

    parseBlockComment :: Parser T.Text
    parseBlockComment :: ParsecT Void Text Identity Text
    parseBlockComment = [Text] -> Text
    T.unlines ([Text] -> Text)
    -> ParsecT Void Text Identity [Text]
    -> ParsecT Void Text Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity [Text]
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    some ParsecT Void Text Identity Text
    line
      where
        line :: ParsecT Void Text Identity Text
    line = ParsecT Void Text Identity Text
    "--" ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity (Maybe Text)
    -> ParsecT Void Text Identity (Maybe Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity (Maybe Text)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional ParsecT Void Text Identity Text
    " " ParsecT Void Text Identity (Maybe Text)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity Text
    restOfLine

    parseTestBlock :: Parser T.Text
    parseTestBlock :: ParsecT Void Text Identity Text
    parseTestBlock =
      [Text] -> Text
    T.unlines ([Text] -> Text)
    -> ParsecT Void Text Identity [Text]
    -> ParsecT Void Text Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((:) (Text -> [Text] -> [Text])
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity ([Text] -> [Text])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Text
    header ParsecT Void Text Identity ([Text] -> [Text])
    -> ParsecT Void Text Identity [Text]
    -> ParsecT Void Text Identity [Text]
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParsecT Void Text Identity [Text]
    remainder)
      where
        header :: ParsecT Void Text Identity Text
    header = ParsecT Void Text Identity Text
    "-- ==" ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol
        remainder :: ParsecT Void Text Identity [Text]
    remainder = (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text
    "-- " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    T.lines (Text -> [Text])
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Text
    parseBlockComment

    parseBlockCode :: Parser T.Text
    parseBlockCode :: ParsecT Void Text Identity Text
    parseBlockCode = [Text] -> Text
    T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> [Text]
    noblanks ([Text] -> Text)
    -> ParsecT Void Text Identity [Text]
    -> ParsecT Void Text Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity [Text]
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    some ParsecT Void Text Identity Text
    line
      where
        noblanks :: [Text] -> [Text]
    noblanks = [Text] -> [Text]
    forall a. [a] -> [a]
    reverse ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Text -> Bool
    T.null ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> [Text]
    forall a. [a] -> [a]
    reverse ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Text -> Bool
    T.null
        line :: ParsecT Void Text Identity Text
    line = Parser () -> Parser ()
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (ParsecT Void Text Identity Text -> Parser ()
    forall a. ParsecT Void Text Identity a -> Parser ()
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
    notFollowedBy ParsecT Void Text Identity Text
    "--") Parser () -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser () -> Parser ()
    forall a. ParsecT Void Text Identity a -> Parser ()
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
    notFollowedBy Parser ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof Parser ()
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity Text
    restOfLine

    parsePlotParams :: Parser (Maybe (Int, Int))
    parsePlotParams :: Parser (Maybe (Int, Int))
    parsePlotParams =
      ParsecT Void Text Identity (Int, Int) -> Parser (Maybe (Int, Int))
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (ParsecT Void Text Identity (Int, Int)
     -> Parser (Maybe (Int, Int)))
    -> ParsecT Void Text Identity (Int, Int)
    -> Parser (Maybe (Int, Int))
    forall a b. (a -> b) -> a -> b
    $
        ParsecT Void Text Identity Text
    ";"
          ParsecT Void Text Identity Text -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    hspace
          Parser ()
    -> ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol
          ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Text -> Parser ()
    token Text
    "-- size:"
          Parser () -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Text -> Parser ()
    token Text
    "("
          Parser ()
    -> ParsecT Void Text Identity (Int, Int)
    -> ParsecT Void Text Identity (Int, Int)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ((,) (Int -> Int -> (Int, Int))
    -> Parser Int -> ParsecT Void Text Identity (Int -> (Int, Int))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Int
    parseInt ParsecT Void Text Identity (Int -> (Int, Int))
    -> Parser () -> ParsecT Void Text Identity (Int -> (Int, Int))
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Text -> Parser ()
    token Text
    "," ParsecT Void Text Identity (Int -> (Int, Int))
    -> Parser Int -> ParsecT Void Text Identity (Int, Int)
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Int
    parseInt)
          ParsecT Void Text Identity (Int, Int)
    -> Parser () -> ParsecT Void Text Identity (Int, Int)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Text -> Parser ()
    token Text
    ")"

    withPredicate :: (a -> Bool) -> String -> Parser a -> Parser a
    withPredicate :: forall a. (a -> Bool) -> FilePath -> Parser a -> Parser a
    withPredicate a -> Bool
    f FilePath
    msg Parser a
    p = do
      r <- Parser a -> Parser a
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    lookAhead Parser a
    p
      if f r then p else fail msg

    parseFilePath :: Parser FilePath
    parseFilePath :: ParsecT Void Text Identity FilePath
    parseFilePath =
      (FilePath -> Bool)
    -> FilePath
    -> ParsecT Void Text Identity FilePath
    -> ParsecT Void Text Identity FilePath
    forall a. (a -> Bool) -> FilePath -> Parser a -> Parser a
    withPredicate FilePath -> Bool
    ok FilePath
    "filename must not have directory component" ParsecT Void Text Identity FilePath
    p
      where
        p :: ParsecT Void Text Identity FilePath
    p = Text -> FilePath
    T.unpack (Text -> FilePath)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    lexeme (Maybe FilePath
    -> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
    takeWhileP Maybe FilePath
    forall a. Maybe a
    Nothing (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace))
        ok :: FilePath -> Bool
    ok FilePath
    f = ShowS
    takeFileName FilePath
    f FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    f

    parseImgParams :: Parser ImgParams
    parseImgParams :: Parser ImgParams
    parseImgParams =
      (Maybe ImgParams -> ImgParams)
    -> ParsecT Void Text Identity (Maybe ImgParams) -> Parser ImgParams
    forall a b.
    (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ImgParams -> Maybe ImgParams -> ImgParams
    forall a. a -> Maybe a -> a
    fromMaybe ImgParams
    defaultImgParams) (ParsecT Void Text Identity (Maybe ImgParams) -> Parser ImgParams)
    -> ParsecT Void Text Identity (Maybe ImgParams) -> Parser ImgParams
    forall a b. (a -> b) -> a -> b
    $
        Parser ImgParams -> ParsecT Void Text Identity (Maybe ImgParams)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser ImgParams -> ParsecT Void Text Identity (Maybe ImgParams))
    -> Parser ImgParams -> ParsecT Void Text Identity (Maybe ImgParams)
    forall a b. (a -> b) -> a -> b
    $
          ParsecT Void Text Identity Text
    ";" ParsecT Void Text Identity Text -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    hspace Parser ()
    -> ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity Text
    "-- " ParsecT Void Text Identity Text
    -> Parser ImgParams -> Parser ImgParams
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ImgParams -> Parser ImgParams
    parseParams ImgParams
    defaultImgParams
      where
        parseParams :: ImgParams -> Parser ImgParams
    parseParams ImgParams
    params =
          [Parser ImgParams] -> Parser ImgParams
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ [Parser ImgParams] -> Parser ImgParams
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
                [ImgParams -> Parser ImgParams
    pFile ImgParams
    params]
                Parser ImgParams
    -> (ImgParams -> Parser ImgParams) -> Parser ImgParams
    forall a b.
    ParsecT Void Text Identity a
    -> (a -> ParsecT Void Text Identity b)
    -> ParsecT Void Text Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ImgParams -> Parser ImgParams
    parseParams,
              ImgParams -> Parser ImgParams
    forall a. a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ImgParams
    params
            ]
        pFile :: ImgParams -> Parser ImgParams
    pFile ImgParams
    params = do
          Text -> Parser ()
    token Text
    "file:"
          b <- ParsecT Void Text Identity FilePath
    parseFilePath
          pure params {imgFile = Just b}

    parseVideoParams :: Parser VideoParams
    parseVideoParams :: Parser VideoParams
    parseVideoParams =
      (Maybe VideoParams -> VideoParams)
    -> ParsecT Void Text Identity (Maybe VideoParams)
    -> Parser VideoParams
    forall a b.
    (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (VideoParams -> Maybe VideoParams -> VideoParams
    forall a. a -> Maybe a -> a
    fromMaybe VideoParams
    defaultVideoParams) (ParsecT Void Text Identity (Maybe VideoParams)
     -> Parser VideoParams)
    -> ParsecT Void Text Identity (Maybe VideoParams)
    -> Parser VideoParams
    forall a b. (a -> b) -> a -> b
    $
        Parser VideoParams
    -> ParsecT Void Text Identity (Maybe VideoParams)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser VideoParams
     -> ParsecT Void Text Identity (Maybe VideoParams))
    -> Parser VideoParams
    -> ParsecT Void Text Identity (Maybe VideoParams)
    forall a b. (a -> b) -> a -> b
    $
          ParsecT Void Text Identity Text
    ";" ParsecT Void Text Identity Text -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    hspace Parser ()
    -> ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity Text
    "-- " ParsecT Void Text Identity Text
    -> Parser VideoParams -> Parser VideoParams
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> VideoParams -> Parser VideoParams
    parseParams VideoParams
    defaultVideoParams
      where
        parseParams :: VideoParams -> Parser VideoParams
    parseParams VideoParams
    params =
          [Parser VideoParams] -> Parser VideoParams
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ [Parser VideoParams] -> Parser VideoParams
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
                [VideoParams -> Parser VideoParams
    pLoop VideoParams
    params, VideoParams -> Parser VideoParams
    pFPS VideoParams
    params, VideoParams -> Parser VideoParams
    pAutoplay VideoParams
    params, VideoParams -> Parser VideoParams
    pFormat VideoParams
    params]
                Parser VideoParams
    -> (VideoParams -> Parser VideoParams) -> Parser VideoParams
    forall a b.
    ParsecT Void Text Identity a
    -> (a -> ParsecT Void Text Identity b)
    -> ParsecT Void Text Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= VideoParams -> Parser VideoParams
    parseParams,
              VideoParams -> Parser VideoParams
    forall a. a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure VideoParams
    params
            ]
        parseBool :: ParsecT Void Text Identity Bool
    parseBool = Text -> Parser ()
    token Text
    "true" Parser () -> Bool -> ParsecT Void Text Identity Bool
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Bool
    True ParsecT Void Text Identity Bool
    -> ParsecT Void Text Identity Bool
    -> ParsecT Void Text Identity Bool
    forall a.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Text -> Parser ()
    token Text
    "false" Parser () -> Bool -> ParsecT Void Text Identity Bool
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Bool
    False
        pLoop :: VideoParams -> Parser VideoParams
    pLoop VideoParams
    params = do
          Text -> Parser ()
    token Text
    "loop:"
          b <- ParsecT Void Text Identity Bool
    parseBool
          pure params {videoLoop = Just b}
        pFPS :: VideoParams -> Parser VideoParams
    pFPS VideoParams
    params = do
          Text -> Parser ()
    token Text
    "fps:"
          fps <- Parser Int
    parseInt
          pure params {videoFPS = Just fps}
        pAutoplay :: VideoParams -> Parser VideoParams
    pAutoplay VideoParams
    params = do
          Text -> Parser ()
    token Text
    "autoplay:"
          b <- ParsecT Void Text Identity Bool
    parseBool
          pure params {videoAutoplay = Just b}
        pFormat :: VideoParams -> Parser VideoParams
    pFormat VideoParams
    params = do
          Text -> Parser ()
    token Text
    "format:"
          s <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    lexeme (ParsecT Void Text Identity Text
     -> ParsecT Void Text Identity Text)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b. (a -> b) -> a -> b
    $ Maybe FilePath
    -> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
    takeWhileP Maybe FilePath
    forall a. Maybe a
    Nothing (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace)
          pure params {videoFormat = Just s}

    parseAudioParams :: Parser AudioParams
    parseAudioParams :: Parser AudioParams
    parseAudioParams =
      (Maybe AudioParams -> AudioParams)
    -> ParsecT Void Text Identity (Maybe AudioParams)
    -> Parser AudioParams
    forall a b.
    (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (AudioParams -> Maybe AudioParams -> AudioParams
    forall a. a -> Maybe a -> a
    fromMaybe AudioParams
    defaultAudioParams) (ParsecT Void Text Identity (Maybe AudioParams)
     -> Parser AudioParams)
    -> ParsecT Void Text Identity (Maybe AudioParams)
    -> Parser AudioParams
    forall a b. (a -> b) -> a -> b
    $
        Parser AudioParams
    -> ParsecT Void Text Identity (Maybe AudioParams)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser AudioParams
     -> ParsecT Void Text Identity (Maybe AudioParams))
    -> Parser AudioParams
    -> ParsecT Void Text Identity (Maybe AudioParams)
    forall a b. (a -> b) -> a -> b
    $
          ParsecT Void Text Identity Text
    ";" ParsecT Void Text Identity Text -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    hspace Parser ()
    -> ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity Text
    "-- " ParsecT Void Text Identity Text
    -> Parser AudioParams -> Parser AudioParams
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> AudioParams -> Parser AudioParams
    parseParams AudioParams
    defaultAudioParams
      where
        parseParams :: AudioParams -> Parser AudioParams
    parseParams AudioParams
    params =
          [Parser AudioParams] -> Parser AudioParams
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ [Parser AudioParams] -> Parser AudioParams
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
                [AudioParams -> Parser AudioParams
    pSamplingFrequency AudioParams
    params, AudioParams -> Parser AudioParams
    pCodec AudioParams
    params]
                Parser AudioParams
    -> (AudioParams -> Parser AudioParams) -> Parser AudioParams
    forall a b.
    ParsecT Void Text Identity a
    -> (a -> ParsecT Void Text Identity b)
    -> ParsecT Void Text Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= AudioParams -> Parser AudioParams
    parseParams,
              AudioParams -> Parser AudioParams
    forall a. a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure AudioParams
    params
            ]
        pSamplingFrequency :: AudioParams -> Parser AudioParams
    pSamplingFrequency AudioParams
    params = do
          Text -> Parser ()
    token Text
    "sampling_frequency:"
          hz <- Parser Int
    parseInt
          pure params {audioSamplingFrequency = Just hz}
        pCodec :: AudioParams -> Parser AudioParams
    pCodec AudioParams
    params = do
          Text -> Parser ()
    token Text
    "codec:"
          s <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    lexeme (ParsecT Void Text Identity Text
     -> ParsecT Void Text Identity Text)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b. (a -> b) -> a -> b
    $ Maybe FilePath
    -> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
    takeWhileP Maybe FilePath
    forall a. Maybe a
    Nothing (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace)
          pure params {audioCodec = Just s}

    atStartOfLine :: Parser ()
    atStartOfLine :: Parser ()
    atStartOfLine = do
      col <- SourcePos -> Pos
    sourceColumn (SourcePos -> Pos)
    -> ParsecT Void Text Identity SourcePos
    -> ParsecT Void Text Identity Pos
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity SourcePos
    forall s e (m :: * -> *).
    (TraversableStream s, MonadParsec e s m) =>
    m SourcePos
    getSourcePos
      when (col /= pos1) empty

    afterExp :: Parser ()
    afterExp :: Parser ()
    afterExp = [Parser ()] -> Parser ()
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice [Parser ()
    atStartOfLine, [Parser ()] -> Parser ()
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice [ParsecT Void Text Identity (Tokens Text) -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol, Parser ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof]]

    withParsedSource :: Parser a -> (a -> T.Text -> b) -> Parser b
    withParsedSource :: forall a b. Parser a -> (a -> Text -> b) -> Parser b
    withParsedSource Parser a
    p a -> Text -> b
    f = do
      s <- ParsecT Void Text Identity Text
    forall e s (m :: * -> *). MonadParsec e s m => m s
    getInput
      bef <- getOffset
      x <- p
      aft <- getOffset
      pure $ f x $ T.take (aft - bef) s

    stripCommentPrefix :: T.Text -> T.Text
    stripCommentPrefix :: Text -> Text
    stripCommentPrefix = [Text] -> Text
    T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    onLine ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    T.lines
      where
        onLine :: Text -> Text
    onLine Text
    s
          | Text
    "-- " Text -> Text -> Bool
    `T.isPrefixOf` Text
    s = Int -> Text -> Text
    T.drop Int
    3 Text
    s
          | Bool
    otherwise = Int -> Text -> Text
    T.drop Int
    2 Text
    s

    parseBlock :: Parser Block
    parseBlock :: Parser Block
    parseBlock =
      [Parser Block] -> Parser Block
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
        [ Parser Directive -> (Directive -> Text -> Block) -> Parser Block
    forall a b. Parser a -> (a -> Text -> b) -> Parser b
    withParsedSource (Text -> Parser ()
    token Text
    "-- >" Parser () -> Parser Directive -> Parser Directive
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser Directive
    parseDirective) ((Directive -> Text -> Block) -> Parser Block)
    -> (Directive -> Text -> Block) -> Parser Block
    forall a b. (a -> b) -> a -> b
    $ \Directive
    d Text
    s ->
            Directive -> Text -> Block
    BlockDirective Directive
    d (Text -> Block) -> Text -> Block
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    stripCommentPrefix Text
    s,
          Text -> Block
    BlockCode (Text -> Block) -> ParsecT Void Text Identity Text -> Parser Block
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Text
    parseTestBlock,
          Text -> Block
    BlockCode (Text -> Block) -> ParsecT Void Text Identity Text -> Parser Block
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Text
    parseBlockCode,
          Text -> Block
    BlockComment (Text -> Block) -> ParsecT Void Text Identity Text -> Parser Block
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity Text
    parseBlockComment
        ]
      where
        parseDirective :: Parser Directive
    parseDirective =
          [Parser Directive] -> Parser Directive
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ Exp -> Directive
    DirectiveRes (Exp -> Directive)
    -> ParsecT Void Text Identity Exp -> Parser Directive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser () -> ParsecT Void Text Identity Exp
    parseExp Parser ()
    postlexeme Parser Directive -> Parser () -> Parser Directive
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ()
    afterExp,
              Text -> Parser ()
    directiveName Text
    "covert"
                Parser ()
    -> (Directive -> Directive)
    -> ParsecT Void Text Identity (Directive -> Directive)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Directive -> Directive
    DirectiveCovert
                ParsecT Void Text Identity (Directive -> Directive)
    -> Parser Directive -> Parser Directive
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Directive
    parseDirective,
              Text -> Parser ()
    directiveName Text
    "brief"
                Parser ()
    -> (Directive -> Directive)
    -> ParsecT Void Text Identity (Directive -> Directive)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Directive -> Directive
    DirectiveBrief
                ParsecT Void Text Identity (Directive -> Directive)
    -> Parser Directive -> Parser Directive
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Directive
    parseDirective,
              Text -> Parser ()
    directiveName Text
    "img"
                Parser ()
    -> (Exp -> ImgParams -> Directive)
    -> ParsecT Void Text Identity (Exp -> ImgParams -> Directive)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Exp -> ImgParams -> Directive
    DirectiveImg
                ParsecT Void Text Identity (Exp -> ImgParams -> Directive)
    -> ParsecT Void Text Identity Exp
    -> ParsecT Void Text Identity (ImgParams -> Directive)
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser () -> ParsecT Void Text Identity Exp
    parseExp Parser ()
    postlexeme
                ParsecT Void Text Identity (ImgParams -> Directive)
    -> Parser ImgParams -> Parser Directive
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser ImgParams
    parseImgParams
                Parser Directive -> Parser () -> Parser Directive
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* [Parser ()] -> Parser ()
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice [ParsecT Void Text Identity (Tokens Text) -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol, Parser ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof],
              Text -> Parser ()
    directiveName Text
    "plot2d"
                Parser ()
    -> (Exp -> Maybe (Int, Int) -> Directive)
    -> ParsecT
         Void Text Identity (Exp -> Maybe (Int, Int) -> Directive)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Exp -> Maybe (Int, Int) -> Directive
    DirectivePlot
                ParsecT Void Text Identity (Exp -> Maybe (Int, Int) -> Directive)
    -> ParsecT Void Text Identity Exp
    -> ParsecT Void Text Identity (Maybe (Int, Int) -> Directive)
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser () -> ParsecT Void Text Identity Exp
    parseExp Parser ()
    postlexeme
                ParsecT Void Text Identity (Maybe (Int, Int) -> Directive)
    -> Parser (Maybe (Int, Int)) -> Parser Directive
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser (Maybe (Int, Int))
    parsePlotParams
                Parser Directive -> Parser () -> Parser Directive
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* [Parser ()] -> Parser ()
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice [ParsecT Void Text Identity (Tokens Text) -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol, Parser ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof],
              Text -> Parser ()
    directiveName Text
    "gnuplot"
                Parser ()
    -> (Exp -> Text -> Directive)
    -> ParsecT Void Text Identity (Exp -> Text -> Directive)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Exp -> Text -> Directive
    DirectiveGnuplot
                ParsecT Void Text Identity (Exp -> Text -> Directive)
    -> ParsecT Void Text Identity Exp
    -> ParsecT Void Text Identity (Text -> Directive)
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser () -> ParsecT Void Text Identity Exp
    parseExp Parser ()
    postlexeme
                ParsecT Void Text Identity (Text -> Directive)
    -> ParsecT Void Text Identity Text -> Parser Directive
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (ParsecT Void Text Identity Text
    ";" ParsecT Void Text Identity Text -> Parser () -> Parser ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    hspace Parser ()
    -> ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Text
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity Text
    parseBlockComment),
              (Text -> Parser ()
    directiveName Text
    "video" Parser () -> Parser () -> Parser ()
    forall a.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Text -> Parser ()
    directiveName Text
    "video")
                Parser ()
    -> (Exp -> VideoParams -> Directive)
    -> ParsecT Void Text Identity (Exp -> VideoParams -> Directive)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Exp -> VideoParams -> Directive
    DirectiveVideo
                ParsecT Void Text Identity (Exp -> VideoParams -> Directive)
    -> ParsecT Void Text Identity Exp
    -> ParsecT Void Text Identity (VideoParams -> Directive)
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser () -> ParsecT Void Text Identity Exp
    parseExp Parser ()
    postlexeme
                ParsecT Void Text Identity (VideoParams -> Directive)
    -> Parser VideoParams -> Parser Directive
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser VideoParams
    parseVideoParams
                Parser Directive
    -> ParsecT Void Text Identity (Tokens Text) -> Parser Directive
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol,
              Text -> Parser ()
    directiveName Text
    "audio"
                Parser ()
    -> (Exp -> AudioParams -> Directive)
    -> ParsecT Void Text Identity (Exp -> AudioParams -> Directive)
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Exp -> AudioParams -> Directive
    DirectiveAudio
                ParsecT Void Text Identity (Exp -> AudioParams -> Directive)
    -> ParsecT Void Text Identity Exp
    -> ParsecT Void Text Identity (AudioParams -> Directive)
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser () -> ParsecT Void Text Identity Exp
    parseExp Parser ()
    postlexeme
                ParsecT Void Text Identity (AudioParams -> Directive)
    -> Parser AudioParams -> Parser Directive
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser AudioParams
    parseAudioParams
                Parser Directive -> Parser () -> Parser Directive
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* [Parser ()] -> Parser ()
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice [ParsecT Void Text Identity (Tokens Text) -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    eol, Parser ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof]
            ]
        directiveName :: Text -> Parser ()
    directiveName Text
    s = Parser () -> Parser ()
    forall a.
    ParsecT Void Text Identity a -> ParsecT Void Text Identity a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    token (Text
    ":" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s)

    parseProg :: FilePath -> T.Text -> Either T.Text [Block]
    parseProg :: FilePath -> Text -> Either Text [Block]
    parseProg FilePath
    fname Text
    s =
      (ParseErrorBundle Text Void -> Either Text [Block])
    -> ([Block] -> Either Text [Block])
    -> Either (ParseErrorBundle Text Void) [Block]
    -> Either Text [Block]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Text -> Either Text [Block]
    forall a b. a -> Either a b
    Left (Text -> Either Text [Block])
    -> (ParseErrorBundle Text Void -> Text)
    -> ParseErrorBundle Text Void
    -> Either Text [Block]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Text
    T.pack (FilePath -> Text)
    -> (ParseErrorBundle Text Void -> FilePath)
    -> ParseErrorBundle Text Void
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseErrorBundle Text Void -> FilePath
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> FilePath
    errorBundlePretty) [Block] -> Either Text [Block]
    forall a b. b -> Either a b
    Right (Either (ParseErrorBundle Text Void) [Block]
     -> Either Text [Block])
    -> Either (ParseErrorBundle Text Void) [Block]
    -> Either Text [Block]
    forall a b. (a -> b) -> a -> b
    $
        Parsec Void Text [Block]
    -> FilePath -> Text -> Either (ParseErrorBundle Text Void) [Block]
    forall e s a.
    Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
    parse (Parser Block -> Parsec Void Text [Block]
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    many Parser Block
    parseBlock Parsec Void Text [Block] -> Parser () -> Parsec Void Text [Block]
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    eof) FilePath
    fname Text
    s

    parseProgFile :: FilePath -> IO [Block]
    parseProgFile :: FilePath -> IO [Block]
    parseProgFile FilePath
    prog = do
      pres <- FilePath -> Text -> Either Text [Block]
    parseProg FilePath
    prog (Text -> Either Text [Block])
    -> IO Text -> IO (Either Text [Block])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> IO Text
    T.readFile FilePath
    prog
      case pres of
        Left Text
    err -> do
          Handle -> Text -> IO ()
    T.hPutStr Handle
    stderr Text
    err
          IO [Block]
    forall a. IO a
    exitFailure
        Right [Block]
    script ->
          [Block] -> IO [Block]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Block]
    script

    -- | The collection of file paths (all inside the image directory)
    -- produced during directive execution.
    type Files = S.Set FilePath

    newtype State = State {State -> Files
    stateFiles :: Files}

    newtype ScriptM a = ScriptM (ExceptT T.Text (StateT State IO) a)
      deriving
        ( (forall a b. (a -> b) -> ScriptM a -> ScriptM b)
    -> (forall a b. a -> ScriptM b -> ScriptM a) -> Functor ScriptM
    forall a b. a -> ScriptM b -> ScriptM a
    forall a b. (a -> b) -> ScriptM a -> ScriptM b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> ScriptM a -> ScriptM b
    fmap :: forall a b. (a -> b) -> ScriptM a -> ScriptM b
    $c<$ :: forall a b. a -> ScriptM b -> ScriptM a
    <$ :: forall a b. a -> ScriptM b -> ScriptM a
    Functor,
          Functor ScriptM
    Functor ScriptM =>
    (forall a. a -> ScriptM a)
    -> (forall a b. ScriptM (a -> b) -> ScriptM a -> ScriptM b)
    -> (forall a b c.
        (a -> b -> c) -> ScriptM a -> ScriptM b -> ScriptM c)
    -> (forall a b. ScriptM a -> ScriptM b -> ScriptM b)
    -> (forall a b. ScriptM a -> ScriptM b -> ScriptM a)
    -> Applicative ScriptM
    forall a. a -> ScriptM a
    forall a b. ScriptM a -> ScriptM b -> ScriptM a
    forall a b. ScriptM a -> ScriptM b -> ScriptM b
    forall a b. ScriptM (a -> b) -> ScriptM a -> ScriptM b
    forall a b c. (a -> b -> c) -> ScriptM a -> ScriptM b -> ScriptM c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> ScriptM a
    pure :: forall a. a -> ScriptM a
    $c<*> :: forall a b. ScriptM (a -> b) -> ScriptM a -> ScriptM b
    <*> :: forall a b. ScriptM (a -> b) -> ScriptM a -> ScriptM b
    $cliftA2 :: forall a b c. (a -> b -> c) -> ScriptM a -> ScriptM b -> ScriptM c
    liftA2 :: forall a b c. (a -> b -> c) -> ScriptM a -> ScriptM b -> ScriptM c
    $c*> :: forall a b. ScriptM a -> ScriptM b -> ScriptM b
    *> :: forall a b. ScriptM a -> ScriptM b -> ScriptM b
    $c<* :: forall a b. ScriptM a -> ScriptM b -> ScriptM a
    <* :: forall a b. ScriptM a -> ScriptM b -> ScriptM a
    Applicative,
          Applicative ScriptM
    Applicative ScriptM =>
    (forall a b. ScriptM a -> (a -> ScriptM b) -> ScriptM b)
    -> (forall a b. ScriptM a -> ScriptM b -> ScriptM b)
    -> (forall a. a -> ScriptM a)
    -> Monad ScriptM
    forall a. a -> ScriptM a
    forall a b. ScriptM a -> ScriptM b -> ScriptM b
    forall a b. ScriptM a -> (a -> ScriptM b) -> ScriptM b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. ScriptM a -> (a -> ScriptM b) -> ScriptM b
    >>= :: forall a b. ScriptM a -> (a -> ScriptM b) -> ScriptM b
    $c>> :: forall a b. ScriptM a -> ScriptM b -> ScriptM b
    >> :: forall a b. ScriptM a -> ScriptM b -> ScriptM b
    $creturn :: forall a. a -> ScriptM a
    return :: forall a. a -> ScriptM a
    Monad,
          MonadError T.Text,
          Monad ScriptM
    Monad ScriptM =>
    (forall a. FilePath -> ScriptM a) -> MonadFail ScriptM
    forall a. FilePath -> ScriptM a
    forall (m :: * -> *).
    Monad m =>
    (forall a. FilePath -> m a) -> MonadFail m
    $cfail :: forall a. FilePath -> ScriptM a
    fail :: forall a. FilePath -> ScriptM a
    MonadFail,
          Monad ScriptM
    Monad ScriptM => (forall a. IO a -> ScriptM a) -> MonadIO ScriptM
    forall a. IO a -> ScriptM a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> ScriptM a
    liftIO :: forall a. IO a -> ScriptM a
    MonadIO,
          MonadState State
        )

    runScriptM :: ScriptM a -> IO (Either T.Text a, Files)
    runScriptM :: forall a. ScriptM a -> IO (Either Text a, Files)
    runScriptM (ScriptM ExceptT Text (StateT State IO) a
    m) = (State -> Files)
    -> (Either Text a, State) -> (Either Text a, Files)
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second State -> Files
    stateFiles ((Either Text a, State) -> (Either Text a, Files))
    -> IO (Either Text a, State) -> IO (Either Text a, Files)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT State IO (Either Text a)
    -> State -> IO (Either Text a, State)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (ExceptT Text (StateT State IO) a -> StateT State IO (Either Text a)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT ExceptT Text (StateT State IO) a
    m) State
    s
      where
        s :: State
    s = Files -> State
    State Files
    forall a. Monoid a => a
    mempty

    withTempFile :: (FilePath -> ScriptM a) -> ScriptM a
    withTempFile :: forall a. (FilePath -> ScriptM a) -> ScriptM a
    withTempFile FilePath -> ScriptM a
    f =
      ScriptM (ScriptM a) -> ScriptM a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (ScriptM (ScriptM a) -> ScriptM a)
    -> ((FilePath -> Handle -> IO (ScriptM a)) -> ScriptM (ScriptM a))
    -> (FilePath -> Handle -> IO (ScriptM a))
    -> ScriptM a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (ScriptM a) -> ScriptM (ScriptM a)
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ScriptM a) -> ScriptM (ScriptM a))
    -> ((FilePath -> Handle -> IO (ScriptM a)) -> IO (ScriptM a))
    -> (FilePath -> Handle -> IO (ScriptM a))
    -> ScriptM (ScriptM a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath
    -> (FilePath -> Handle -> IO (ScriptM a)) -> IO (ScriptM a)
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    FilePath -> (FilePath -> Handle -> m a) -> m a
    withSystemTempFile FilePath
    "futhark-literate" ((FilePath -> Handle -> IO (ScriptM a)) -> ScriptM a)
    -> (FilePath -> Handle -> IO (ScriptM a)) -> ScriptM a
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    tmpf Handle
    tmpf_h -> do
        Handle -> IO ()
    hClose Handle
    tmpf_h
        (res, files) <- ScriptM a -> IO (Either Text a, Files)
    forall a. ScriptM a -> IO (Either Text a, Files)
    runScriptM (FilePath -> ScriptM a
    f FilePath
    tmpf)
        pure $ do
          modify $ \State
    s -> State
    s {stateFiles = files <> stateFiles s}
          either throwError pure res

    withTempDir :: (FilePath -> ScriptM a) -> ScriptM a
    withTempDir :: forall a. (FilePath -> ScriptM a) -> ScriptM a
    withTempDir FilePath -> ScriptM a
    f =
      ScriptM (ScriptM a) -> ScriptM a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (ScriptM (ScriptM a) -> ScriptM a)
    -> ((FilePath -> IO (ScriptM a)) -> ScriptM (ScriptM a))
    -> (FilePath -> IO (ScriptM a))
    -> ScriptM a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (ScriptM a) -> ScriptM (ScriptM a)
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ScriptM a) -> ScriptM (ScriptM a))
    -> ((FilePath -> IO (ScriptM a)) -> IO (ScriptM a))
    -> (FilePath -> IO (ScriptM a))
    -> ScriptM (ScriptM a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> (FilePath -> IO (ScriptM a)) -> IO (ScriptM a)
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    FilePath -> (FilePath -> m a) -> m a
    withSystemTempDirectory FilePath
    "futhark-literate" ((FilePath -> IO (ScriptM a)) -> ScriptM a)
    -> (FilePath -> IO (ScriptM a)) -> ScriptM a
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    dir -> do
        (res, files) <- ScriptM a -> IO (Either Text a, Files)
    forall a. ScriptM a -> IO (Either Text a, Files)
    runScriptM (FilePath -> ScriptM a
    f FilePath
    dir)
        pure $ do
          modify $ \State
    s -> State
    s {stateFiles = files <> stateFiles s}
          either throwError pure res

    greyFloatToImg ::
      (RealFrac a, SVec.Storable a) =>
      SVec.Vector a ->
      SVec.Vector Word32
    greyFloatToImg :: forall a. (RealFrac a, Storable a) => Vector a -> Vector Word32
    greyFloatToImg = (a -> Word32) -> Vector a -> Vector Word32
    forall a b.
    (Storable a, Storable b) =>
    (a -> b) -> Vector a -> Vector b
    SVec.map a -> Word32
    forall {a} {p}. (Bits a, RealFrac p, Integral a) => p -> a
    grey
      where
        grey :: p -> a
    grey p
    i =
          let i' :: a
    i' = p -> a
    forall b. Integral b => p -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (p
    i p -> p -> p
    forall a. Num a => a -> a -> a
    * p
    255) a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a
    0xFF
           in (a
    i' a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    16) a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. (a
    i' a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8) a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. a
    i'

    greyByteToImg ::
      (Integral a, SVec.Storable a) =>
      SVec.Vector a ->
      SVec.Vector Word32
    greyByteToImg :: forall a. (Integral a, Storable a) => Vector a -> Vector Word32
    greyByteToImg = (a -> Word32) -> Vector a -> Vector Word32
    forall a b.
    (Storable a, Storable b) =>
    (a -> b) -> Vector a -> Vector b
    SVec.map a -> Word32
    forall {a} {a}. (Bits a, Integral a, Num a) => a -> a
    grey
      where
        grey :: a -> a
    grey a
    i =
          (a -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    i a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    16) a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. (a -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    i a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8) a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. a -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    i

    -- BMPs are RGBA and bottom-up where we assumes images are top-down
    -- and ARGB.  We fix this up before encoding the BMP.  This is
    -- probably a little slower than it has to be.
    vecToBMP :: Int -> Int -> SVec.Vector Word32 -> LBS.ByteString
    vecToBMP :: Int -> Int -> Vector Word32 -> ByteString
    vecToBMP Int
    h Int
    w = BMP -> ByteString
    BMP.renderBMP (BMP -> ByteString)
    -> (Vector Word32 -> BMP) -> Vector Word32 -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> ByteString -> BMP
    BMP.packRGBA32ToBMP24 Int
    w Int
    h (ByteString -> BMP)
    -> (Vector Word32 -> ByteString) -> Vector Word32 -> BMP
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Word8 -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString (Vector Word8 -> ByteString)
    -> (Vector Word32 -> Vector Word8) -> Vector Word32 -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Word32 -> Vector Word8
    forall {a}.
    (Integral a, Storable a, Bits a) =>
    Vector a -> Vector Word8
    frobVec
      where
        frobVec :: Vector a -> Vector Word8
    frobVec Vector a
    vec = Int -> (Int -> Word8) -> Vector Word8
    forall a. Storable a => Int -> (Int -> a) -> Vector a
    SVec.generate (Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4) (Vector a -> Int -> Word8
    forall {a}.
    (Integral a, Storable a, Bits a) =>
    Vector a -> Int -> Word8
    pix Vector a
    vec)
        pix :: Vector a -> Int -> Word8
    pix Vector a
    vec Int
    l =
          let (Int
    i, Int
    j) = (Int
    l Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    4) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    w
              argb :: a
    argb = Vector a
    vec Vector a -> Int -> a
    forall a. Storable a => Vector a -> Int -> a
    SVec.! ((Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    j)
              c :: a
    c = (a
    argb a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftR` (Int
    24 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - ((Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    4) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8)) a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a
    0xFF
           in a -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    c :: Word8

    valueToBMP :: Value -> Maybe LBS.ByteString
    valueToBMP :: Value -> Maybe ByteString
    valueToBMP v :: Value
    v@(U32Value Vector Int
    _ Vector Word32
    bytes)
      | [Int
    h, Int
    w] <- Value -> [Int]
    valueShape Value
    v =
          ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Vector Word32 -> ByteString
    vecToBMP Int
    h Int
    w Vector Word32
    bytes
    valueToBMP v :: Value
    v@(I32Value Vector Int
    _ Vector Int32
    bytes)
      | [Int
    h, Int
    w] <- Value -> [Int]
    valueShape Value
    v =
          ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Vector Word32 -> ByteString
    vecToBMP Int
    h Int
    w (Vector Word32 -> ByteString) -> Vector Word32 -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Int32 -> Word32) -> Vector Int32 -> Vector Word32
    forall a b.
    (Storable a, Storable b) =>
    (a -> b) -> Vector a -> Vector b
    SVec.map Int32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Vector Int32
    bytes
    valueToBMP v :: Value
    v@(F32Value Vector Int
    _ Vector Float
    bytes)
      | [Int
    h, Int
    w] <- Value -> [Int]
    valueShape Value
    v =
          ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Vector Word32 -> ByteString
    vecToBMP Int
    h Int
    w (Vector Word32 -> ByteString) -> Vector Word32 -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Float -> Vector Word32
    forall a. (RealFrac a, Storable a) => Vector a -> Vector Word32
    greyFloatToImg Vector Float
    bytes
    valueToBMP v :: Value
    v@(U8Value Vector Int
    _ Vector Word8
    bytes)
      | [Int
    h, Int
    w] <- Value -> [Int]
    valueShape Value
    v =
          ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Vector Word32 -> ByteString
    vecToBMP Int
    h Int
    w (Vector Word32 -> ByteString) -> Vector Word32 -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Word8 -> Vector Word32
    forall a. (Integral a, Storable a) => Vector a -> Vector Word32
    greyByteToImg Vector Word8
    bytes
    valueToBMP v :: Value
    v@(F64Value Vector Int
    _ Vector Double
    bytes)
      | [Int
    h, Int
    w] <- Value -> [Int]
    valueShape Value
    v =
          ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Vector Word32 -> ByteString
    vecToBMP Int
    h Int
    w (Vector Word32 -> ByteString) -> Vector Word32 -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Double -> Vector Word32
    forall a. (RealFrac a, Storable a) => Vector a -> Vector Word32
    greyFloatToImg Vector Double
    bytes
    valueToBMP v :: Value
    v@(BoolValue Vector Int
    _ Vector Bool
    bytes)
      | [Int
    h, Int
    w] <- Value -> [Int]
    valueShape Value
    v =
          ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Vector Word32 -> ByteString
    vecToBMP Int
    h Int
    w (Vector Word32 -> ByteString) -> Vector Word32 -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Int -> Vector Word32
    forall a. (Integral a, Storable a) => Vector a -> Vector Word32
    greyByteToImg (Vector Int -> Vector Word32) -> Vector Int -> Vector Word32
    forall a b. (a -> b) -> a -> b
    $ (Bool -> Int) -> Vector Bool -> Vector Int
    forall a b.
    (Storable a, Storable b) =>
    (a -> b) -> Vector a -> Vector b
    SVec.map (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (*) Int
    255 (Int -> Int) -> (Bool -> Int) -> Bool -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum) Vector Bool
    bytes
    valueToBMP Value
    _ = Maybe ByteString
    forall a. Maybe a
    Nothing

    valueToBMPs :: Value -> Maybe [LBS.ByteString]
    valueToBMPs :: Value -> Maybe [ByteString]
    valueToBMPs = (Value -> Maybe ByteString) -> [Value] -> Maybe [ByteString]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Value -> Maybe ByteString
    valueToBMP ([Value] -> Maybe [ByteString])
    -> (Value -> [Value]) -> Value -> Maybe [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> [Value]
    valueElems

    system ::
      (MonadIO m, MonadError T.Text m) =>
      FilePath ->
      [String] ->
      T.Text ->
      m T.Text
    system :: forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system FilePath
    prog [FilePath]
    options Text
    input = do
      res <- IO (Either IOError (ExitCode, FilePath, FilePath))
    -> m (Either IOError (ExitCode, FilePath, FilePath))
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either IOError (ExitCode, FilePath, FilePath))
     -> m (Either IOError (ExitCode, FilePath, FilePath)))
    -> IO (Either IOError (ExitCode, FilePath, FilePath))
    -> m (Either IOError (ExitCode, FilePath, FilePath))
    forall a b. (a -> b) -> a -> b
    $ FilePath
    -> [FilePath]
    -> ByteString
    -> IO (Either IOError (ExitCode, FilePath, FilePath))
    runProgramWithExitCode FilePath
    prog [FilePath]
    options (ByteString -> IO (Either IOError (ExitCode, FilePath, FilePath)))
    -> ByteString -> IO (Either IOError (ExitCode, FilePath, FilePath))
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    T.encodeUtf8 Text
    input
      case res of
        Left IOError
    err ->
          Text -> m Text
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> m Text) -> Text -> m Text
    forall a b. (a -> b) -> a -> b
    $ Text
    prog' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " failed: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> IOError -> Text
    forall a. Show a => a -> Text
    showText IOError
    err
        Right (ExitCode
    ExitSuccess, FilePath
    stdout_t, FilePath
    _) ->
          Text -> m Text
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Text -> m Text) -> Text -> m Text
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text
    T.pack FilePath
    stdout_t
        Right (ExitFailure Int
    code', FilePath
    _, FilePath
    stderr_t) ->
          Text -> m Text
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> m Text) -> Text -> m Text
    forall a b. (a -> b) -> a -> b
    $
            Text
    prog'
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " failed with exit code "
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    code'
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " and stderr:\n"
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    stderr_t
      where
        prog' :: Text
    prog' = Text
    "'" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    prog Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'"

    formatDataForGnuplot :: [Value] -> T.Text
    formatDataForGnuplot :: [Value] -> Text
    formatDataForGnuplot = [Text] -> Text
    T.unlines ([Text] -> Text) -> ([Value] -> [Text]) -> [Value] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Value] -> Text) -> [[Value]] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map [Value] -> Text
    line ([[Value]] -> [Text])
    -> ([Value] -> [[Value]]) -> [Value] -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Value]] -> [[Value]]
    forall a. [[a]] -> [[a]]
    L.transpose ([[Value]] -> [[Value]])
    -> ([Value] -> [[Value]]) -> [Value] -> [[Value]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> [Value]) -> [Value] -> [[Value]]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> [Value]
    valueElems
      where
        line :: [Value] -> Text
    line = [Text] -> Text
    T.unwords ([Text] -> Text) -> ([Value] -> [Text]) -> [Value] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> Text) -> [Value] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Text
    forall a. Pretty a => a -> Text
    prettyText

    imgBlock :: FilePath -> T.Text
    imgBlock :: FilePath -> Text
    imgBlock FilePath
    f = Text
    "![](" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    f Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")\n"

    videoBlock :: VideoParams -> FilePath -> T.Text
    videoBlock :: VideoParams -> FilePath -> Text
    videoBlock VideoParams
    opts FilePath
    f = Text
    "![](" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    f Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    opts' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n"
      where
        opts' :: Text
    opts'
          | (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Text -> Bool
    T.null [Text
    loop, Text
    autoplay] =
              Text
    forall a. Monoid a => a
    mempty
          | Bool
    otherwise =
              Text
    "{" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    T.unwords [Text
    loop, Text
    autoplay] Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "}"
        boolOpt :: a -> (VideoParams -> Maybe Bool) -> a
    boolOpt a
    s VideoParams -> Maybe Bool
    prop
          | Just Bool
    b <- VideoParams -> Maybe Bool
    prop VideoParams
    opts =
              if Bool
    b then a
    s a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    "=\"true\"" else a
    s a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    "=\"false\""
          | Bool
    otherwise =
              a
    forall a. Monoid a => a
    mempty
        loop :: Text
    loop = Text -> (VideoParams -> Maybe Bool) -> Text
    forall {a}.
    (IsString a, Monoid a) =>
    a -> (VideoParams -> Maybe Bool) -> a
    boolOpt Text
    "loop" VideoParams -> Maybe Bool
    videoLoop
        autoplay :: Text
    autoplay = Text -> (VideoParams -> Maybe Bool) -> Text
    forall {a}.
    (IsString a, Monoid a) =>
    a -> (VideoParams -> Maybe Bool) -> a
    boolOpt Text
    "autoplay" VideoParams -> Maybe Bool
    videoAutoplay

    plottable :: CompoundValue -> Maybe [Value]
    plottable :: CompoundValue -> Maybe [Value]
    plottable (ValueTuple [CompoundValue]
    vs) = do
      (vs', ns') <- (CompoundValue -> Maybe (Value, Int))
    -> [CompoundValue] -> Maybe ([Value], [Int])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM CompoundValue -> Maybe (Value, Int)
    inspect [CompoundValue]
    vs
      guard $ length (nubOrd ns') == 1
      Just vs'
      where
        inspect :: CompoundValue -> Maybe (Value, Int)
    inspect (ValueAtom Value
    v)
          | [Int
    n] <- Value -> [Int]
    valueShape Value
    v = (Value, Int) -> Maybe (Value, Int)
    forall a. a -> Maybe a
    Just (Value
    v, Int
    n)
        inspect CompoundValue
    _ = Maybe (Value, Int)
    forall a. Maybe a
    Nothing
    plottable CompoundValue
    _ = Maybe [Value]
    forall a. Maybe a
    Nothing

    withGnuplotData ::
      [(T.Text, T.Text)] ->
      [(T.Text, [Value])] ->
      ([T.Text] -> [T.Text] -> ScriptM a) ->
      ScriptM a
    withGnuplotData :: forall a.
    [(Text, Text)]
    -> [(Text, [Value])]
    -> ([Text] -> [Text] -> ScriptM a)
    -> ScriptM a
    withGnuplotData [(Text, Text)]
    sets [] [Text] -> [Text] -> ScriptM a
    cont = ([Text] -> [Text] -> ScriptM a) -> ([Text], [Text]) -> ScriptM a
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry [Text] -> [Text] -> ScriptM a
    cont (([Text], [Text]) -> ScriptM a) -> ([Text], [Text]) -> ScriptM a
    forall a b. (a -> b) -> a -> b
    $ [(Text, Text)] -> ([Text], [Text])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Text, Text)] -> ([Text], [Text]))
    -> [(Text, Text)] -> ([Text], [Text])
    forall a b. (a -> b) -> a -> b
    $ [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a]
    reverse [(Text, Text)]
    sets
    withGnuplotData [(Text, Text)]
    sets ((Text
    f, [Value]
    vs) : [(Text, [Value])]
    xys) [Text] -> [Text] -> ScriptM a
    cont =
      (FilePath -> ScriptM a) -> ScriptM a
    forall a. (FilePath -> ScriptM a) -> ScriptM a
    withTempFile ((FilePath -> ScriptM a) -> ScriptM a)
    -> (FilePath -> ScriptM a) -> ScriptM a
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    fname -> do
        IO () -> ScriptM ()
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ScriptM ()) -> IO () -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text -> IO ()
    T.writeFile FilePath
    fname (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Value] -> Text
    formatDataForGnuplot [Value]
    vs
        [(Text, Text)]
    -> [(Text, [Value])]
    -> ([Text] -> [Text] -> ScriptM a)
    -> ScriptM a
    forall a.
    [(Text, Text)]
    -> [(Text, [Value])]
    -> ([Text] -> [Text] -> ScriptM a)
    -> ScriptM a
    withGnuplotData ((Text
    f, Text
    f Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "='" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    fname Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall a. a -> [a] -> [a]
    : [(Text, Text)]
    sets) [(Text, [Value])]
    xys [Text] -> [Text] -> ScriptM a
    cont

    loadBMP :: FilePath -> ScriptM (Compound Value)
    loadBMP :: FilePath -> ScriptM CompoundValue
    loadBMP FilePath
    bmpfile = do
      res <- IO (Either Error BMP) -> ScriptM (Either Error BMP)
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either Error BMP) -> ScriptM (Either Error BMP))
    -> IO (Either Error BMP) -> ScriptM (Either Error BMP)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO (Either Error BMP)
    BMP.readBMP FilePath
    bmpfile
      case res of
        Left Error
    err ->
          Text -> ScriptM CompoundValue
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM CompoundValue) -> Text -> ScriptM CompoundValue
    forall a b. (a -> b) -> a -> b
    $ Text
    "Failed to read BMP:\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Error -> Text
    forall a. Show a => a -> Text
    showText Error
    err
        Right BMP
    bmp -> do
          let bmp_bs :: ByteString
    bmp_bs = BMP -> ByteString
    BMP.unpackBMPToRGBA32 BMP
    bmp
              (Int
    w, Int
    h) = BMP -> (Int, Int)
    BMP.bmpDimensions BMP
    bmp
              shape :: Vector Int
    shape = [Int] -> Vector Int
    forall a. Storable a => [a] -> Vector a
    SVec.fromList [Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    h, Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    w]
              pix :: Int -> a
    pix Int
    l =
                let (Int
    i, Int
    j) = Int
    l Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    w
                    l' :: Int
    l' = (Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    j
                    r :: a
    r = Word8 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> a) -> Word8 -> a
    forall a b. (a -> b) -> a -> b
    $ ByteString
    bmp_bs HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `BS.index` (Int
    l' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4)
                    g :: a
    g = Word8 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> a) -> Word8 -> a
    forall a b. (a -> b) -> a -> b
    $ ByteString
    bmp_bs HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `BS.index` (Int
    l' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                    b :: a
    b = Word8 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> a) -> Word8 -> a
    forall a b. (a -> b) -> a -> b
    $ ByteString
    bmp_bs HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `BS.index` (Int
    l' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)
                    a :: a
    a = Word8 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> a) -> Word8 -> a
    forall a b. (a -> b) -> a -> b
    $ ByteString
    bmp_bs HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `BS.index` (Int
    l' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)
                 in (a
    a a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    24) a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. (a
    r a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    16) a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. (a
    g a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8) a -> a -> a
    forall a. Bits a => a -> a -> a
    .|. a
    b
          CompoundValue -> ScriptM CompoundValue
    forall a. a -> ScriptM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CompoundValue -> ScriptM CompoundValue)
    -> CompoundValue -> ScriptM CompoundValue
    forall a b. (a -> b) -> a -> b
    $ Value -> CompoundValue
    forall v. v -> Compound v
    ValueAtom (Value -> CompoundValue) -> Value -> CompoundValue
    forall a b. (a -> b) -> a -> b
    $ Vector Int -> Vector Word32 -> Value
    U32Value Vector Int
    shape (Vector Word32 -> Value) -> Vector Word32 -> Value
    forall a b. (a -> b) -> a -> b
    $ Int -> (Int -> Word32) -> Vector Word32
    forall a. Storable a => Int -> (Int -> a) -> Vector a
    SVec.generate (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    h) Int -> Word32
    forall {a}. (Bits a, Num a) => Int -> a
    pix

    loadImage :: FilePath -> ScriptM (Compound Value)
    loadImage :: FilePath -> ScriptM CompoundValue
    loadImage FilePath
    imgfile =
      (FilePath -> ScriptM CompoundValue) -> ScriptM CompoundValue
    forall a. (FilePath -> ScriptM a) -> ScriptM a
    withTempDir ((FilePath -> ScriptM CompoundValue) -> ScriptM CompoundValue)
    -> (FilePath -> ScriptM CompoundValue) -> ScriptM CompoundValue
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    dir -> do
        let bmpfile :: FilePath
    bmpfile = FilePath
    dir FilePath -> ShowS
    </> ShowS
    takeBaseName FilePath
    imgfile FilePath -> ShowS
    `replaceExtension` FilePath
    "bmp"
        ScriptM Text -> ScriptM ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ScriptM Text -> ScriptM ()) -> ScriptM Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath] -> Text -> ScriptM Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system FilePath
    "convert" [FilePath
    imgfile, FilePath
    "-type", FilePath
    "TrueColorAlpha", FilePath
    bmpfile] Text
    forall a. Monoid a => a
    mempty
        FilePath -> ScriptM CompoundValue
    loadBMP FilePath
    bmpfile

    loadPCM :: Int -> FilePath -> ScriptM (Compound Value)
    loadPCM :: Int -> FilePath -> ScriptM CompoundValue
    loadPCM Int
    num_channels FilePath
    pcmfile = do
      contents <- IO ByteString -> ScriptM ByteString
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> ScriptM ByteString)
    -> IO ByteString -> ScriptM ByteString
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO ByteString
    LBS.readFile FilePath
    pcmfile
      let v = ByteString -> Vector Double
    forall a. Storable a => ByteString -> Vector a
    SVec.byteStringToVector (ByteString -> Vector Double) -> ByteString -> Vector Double
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    LBS.toStrict ByteString
    contents
          channel_length = Vector Double -> Int
    forall a. Storable a => Vector a -> Int
    SVec.length Vector Double
    v Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    num_channels
          shape =
            [Int] -> Vector Int
    forall a. Storable a => [a] -> Vector a
    SVec.fromList
              [ Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    num_channels,
                Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    channel_length
              ]
          -- ffmpeg outputs audio data in column-major format. `backPermuter` computes the
          -- tranposed indexes for a backpermutation.
          backPermuter Int
    i = (Int
    i Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    channel_length) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    num_channels Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    channel_length
          perm = Int -> (Int -> Int) -> Vector Int
    forall a. Storable a => Int -> (Int -> a) -> Vector a
    SVec.generate (Vector Double -> Int
    forall a. Storable a => Vector a -> Int
    SVec.length Vector Double
    v) Int -> Int
    backPermuter
      pure $ ValueAtom $ F64Value shape $ SVec.backpermute v perm

    loadAudio :: FilePath -> ScriptM (Compound Value)
    loadAudio :: FilePath -> ScriptM CompoundValue
    loadAudio FilePath
    audiofile = do
      s <- FilePath -> [FilePath] -> Text -> ScriptM Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system FilePath
    "ffprobe" [FilePath
    audiofile, FilePath
    "-show_entries", FilePath
    "stream=channels", FilePath
    "-select_streams", FilePath
    "a", FilePath
    "-of", FilePath
    "compact=p=0:nk=1", FilePath
    "-v", FilePath
    "0"] Text
    forall a. Monoid a => a
    mempty
      case T.decimal s of
        Right (Int
    num_channels, Text
    _) -> do
          (FilePath -> ScriptM CompoundValue) -> ScriptM CompoundValue
    forall a. (FilePath -> ScriptM a) -> ScriptM a
    withTempDir ((FilePath -> ScriptM CompoundValue) -> ScriptM CompoundValue)
    -> (FilePath -> ScriptM CompoundValue) -> ScriptM CompoundValue
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    dir -> do
            let pcmfile :: FilePath
    pcmfile = FilePath
    dir FilePath -> ShowS
    </> ShowS
    takeBaseName FilePath
    audiofile FilePath -> ShowS
    `replaceExtension` FilePath
    "pcm"
            ScriptM Text -> ScriptM ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ScriptM Text -> ScriptM ()) -> ScriptM Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath] -> Text -> ScriptM Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system FilePath
    "ffmpeg" [FilePath
    "-i", FilePath
    audiofile, FilePath
    "-c:a", FilePath
    "pcm_f64le", FilePath
    "-map", FilePath
    "0", FilePath
    "-f", FilePath
    "data", FilePath
    pcmfile] Text
    forall a. Monoid a => a
    mempty
            Int -> FilePath -> ScriptM CompoundValue
    loadPCM Int
    num_channels FilePath
    pcmfile
        Either FilePath (Int, Text)
    _ -> Text -> ScriptM CompoundValue
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError Text
    "$loadImg failed to detect the number of channels in the audio input"

    literateBuiltin :: EvalBuiltin ScriptM
    literateBuiltin :: EvalBuiltin ScriptM
    literateBuiltin Text
    "loadimg" [CompoundValue]
    vs =
      case [CompoundValue]
    vs of
        [ValueAtom Value
    v]
          | Just [Word8]
    path <- Value -> Maybe [Word8]
    forall t. GetValue t => Value -> Maybe t
    getValue Value
    v -> do
              let path' :: FilePath
    path' = (Word8 -> Char) -> [Word8] -> FilePath
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Char
    chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) ([Word8]
    path :: [Word8])
              FilePath -> ScriptM CompoundValue
    loadImage FilePath
    path'
        [CompoundValue]
    _ ->
          Text -> ScriptM CompoundValue
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM CompoundValue) -> Text -> ScriptM CompoundValue
    forall a b. (a -> b) -> a -> b
    $
            Text
    "$loadimg does not accept arguments of types: "
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Text] -> Text
    T.intercalate Text
    ", " ((CompoundValue -> Text) -> [CompoundValue] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Compound ValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText (Compound ValueType -> Text)
    -> (CompoundValue -> Compound ValueType) -> CompoundValue -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> ValueType) -> CompoundValue -> Compound ValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> ValueType
    valueType) [CompoundValue]
    vs)
    literateBuiltin Text
    "loadaudio" [CompoundValue]
    vs =
      case [CompoundValue]
    vs of
        [ValueAtom Value
    v]
          | Just [Word8]
    path <- Value -> Maybe [Word8]
    forall t. GetValue t => Value -> Maybe t
    getValue Value
    v -> do
              let path' :: FilePath
    path' = (Word8 -> Char) -> [Word8] -> FilePath
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Char
    chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) ([Word8]
    path :: [Word8])
              FilePath -> ScriptM CompoundValue
    loadAudio FilePath
    path'
        [CompoundValue]
    _ ->
          Text -> ScriptM CompoundValue
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM CompoundValue) -> Text -> ScriptM CompoundValue
    forall a b. (a -> b) -> a -> b
    $
            Text
    "$loadaudio does not accept arguments of types: "
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> [Text] -> Text
    T.intercalate Text
    ", " ((CompoundValue -> Text) -> [CompoundValue] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Compound ValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText (Compound ValueType -> Text)
    -> (CompoundValue -> Compound ValueType) -> CompoundValue -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> ValueType) -> CompoundValue -> Compound ValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> ValueType
    valueType) [CompoundValue]
    vs)
    literateBuiltin Text
    f [CompoundValue]
    vs =
      FilePath -> EvalBuiltin ScriptM
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> EvalBuiltin m
    scriptBuiltin FilePath
    "." Text
    f [CompoundValue]
    vs

    -- | Some of these only make sense for @futhark literate@, but enough
    -- are also sensible for @futhark script@ that we can share them.
    data Options = Options
      { Options -> FilePath
    scriptBackend :: String,
        Options -> Maybe FilePath
    scriptFuthark :: Maybe FilePath,
        Options -> [FilePath]
    scriptExtraOptions :: [String],
        Options -> [FilePath]
    scriptCompilerOptions :: [String],
        Options -> Bool
    scriptSkipCompilation :: Bool,
        Options -> Maybe FilePath
    scriptOutput :: Maybe FilePath,
        Options -> Int
    scriptVerbose :: Int,
        Options -> Bool
    scriptStopOnError :: Bool,
        Options -> Bool
    scriptBinary :: Bool,
        Options -> [Either FilePath Text]
    scriptExps :: [Either FilePath T.Text]
      }

    -- | The configuration before any user-provided options are processed.
    initialOptions :: Options
    initialOptions :: Options
    initialOptions =
      Options
        { scriptBackend :: FilePath
    scriptBackend = FilePath
    "c",
          scriptFuthark :: Maybe FilePath
    scriptFuthark = Maybe FilePath
    forall a. Maybe a
    Nothing,
          scriptExtraOptions :: [FilePath]
    scriptExtraOptions = [],
          scriptCompilerOptions :: [FilePath]
    scriptCompilerOptions = [],
          scriptSkipCompilation :: Bool
    scriptSkipCompilation = Bool
    False,
          scriptOutput :: Maybe FilePath
    scriptOutput = Maybe FilePath
    forall a. Maybe a
    Nothing,
          scriptVerbose :: Int
    scriptVerbose = Int
    0,
          scriptStopOnError :: Bool
    scriptStopOnError = Bool
    False,
          scriptBinary :: Bool
    scriptBinary = Bool
    False,
          scriptExps :: [Either FilePath Text]
    scriptExps = []
        }

    data Env = Env
      { Env -> FilePath
    envImgDir :: FilePath,
        Env -> Options
    envOpts :: Options,
        Env -> ScriptServer
    envServer :: ScriptServer,
        Env -> Text
    envHash :: T.Text
      }

    newFile :: Env -> (Maybe FilePath, FilePath) -> (FilePath -> ScriptM ()) -> ScriptM FilePath
    newFile :: Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM FilePath
    newFile Env
    env (Maybe FilePath
    fname_desired, FilePath
    template) FilePath -> ScriptM ()
    m = do
      let fname_base :: FilePath
    fname_base = FilePath -> Maybe FilePath -> FilePath
    forall a. a -> Maybe a -> a
    fromMaybe (Text -> FilePath
    T.unpack (Env -> Text
    envHash Env
    env) FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "-" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    template) Maybe FilePath
    fname_desired
          fname :: FilePath
    fname = Env -> FilePath
    envImgDir Env
    env FilePath -> ShowS
    </> FilePath
    fname_base
      exists <- IO Bool -> ScriptM Bool
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> ScriptM Bool) -> IO Bool -> ScriptM Bool
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO Bool
    doesFileExist FilePath
    fname
      liftIO $ createDirectoryIfMissing True $ envImgDir env
      when (exists && scriptVerbose (envOpts env) > 0) $
        liftIO . T.hPutStrLn stderr $
          "Using existing file: " <> T.pack fname
      unless exists $ do
        when (scriptVerbose (envOpts env) > 0) $
          liftIO . T.hPutStrLn stderr $
            "Generating new file: " <> T.pack fname
        m fname
      modify $ \State
    s -> State
    s {stateFiles = S.insert fname $ stateFiles s}
      pure fname

    newFileContents :: Env -> (Maybe FilePath, FilePath) -> (FilePath -> ScriptM ()) -> ScriptM T.Text
    newFileContents :: Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM Text
    newFileContents Env
    env (Maybe FilePath, FilePath)
    f FilePath -> ScriptM ()
    m =
      IO Text -> ScriptM Text
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Text -> ScriptM Text)
    -> (FilePath -> IO Text) -> FilePath -> ScriptM Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> IO Text
    T.readFile (FilePath -> ScriptM Text) -> ScriptM FilePath -> ScriptM Text
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM FilePath
    newFile Env
    env (Maybe FilePath, FilePath)
    f FilePath -> ScriptM ()
    m

    processDirective :: Env -> Directive -> ScriptM T.Text
    processDirective :: Env -> Directive -> ScriptM Text
    processDirective Env
    env (DirectiveBrief Directive
    d) =
      Env -> Directive -> ScriptM Text
    processDirective Env
    env Directive
    d
    processDirective Env
    env (DirectiveCovert Directive
    d) =
      Env -> Directive -> ScriptM Text
    processDirective Env
    env Directive
    d
    processDirective Env
    env (DirectiveRes Exp
    e) = do
      result <-
        Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM Text
    newFileContents Env
    env (Maybe FilePath
    forall a. Maybe a
    Nothing, FilePath
    "eval.txt") ((FilePath -> ScriptM ()) -> ScriptM Text)
    -> (FilePath -> ScriptM ()) -> ScriptM Text
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    resultf -> do
          v <- (Compound ScriptValueType -> ScriptM CompoundValue)
    -> (CompoundValue -> ScriptM CompoundValue)
    -> Either (Compound ScriptValueType) CompoundValue
    -> ScriptM CompoundValue
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Compound ScriptValueType -> ScriptM CompoundValue
    forall {m :: * -> *} {a} {a}.
    (MonadError Text m, Pretty a) =>
    a -> m a
    nope CompoundValue -> ScriptM CompoundValue
    forall a. a -> ScriptM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Compound ScriptValueType) CompoundValue
     -> ScriptM CompoundValue)
    -> ScriptM (Either (Compound ScriptValueType) CompoundValue)
    -> ScriptM CompoundValue
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< EvalBuiltin ScriptM
    -> ScriptServer
    -> Exp
    -> ScriptM (Either (Compound ScriptValueType) CompoundValue)
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    EvalBuiltin m
    -> ScriptServer
    -> Exp
    -> m (Either (Compound ScriptValueType) CompoundValue)
    evalExpToGround EvalBuiltin ScriptM
    literateBuiltin (Env -> ScriptServer
    envServer Env
    env) Exp
    e
          liftIO $ T.writeFile resultf $ prettyText v
      pure $ T.unlines ["```", result, "```"]
      where
        nope :: a -> m a
    nope a
    t =
          Text -> m a
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> m a) -> Text -> m a
    forall a b. (a -> b) -> a -> b
    $ Text
    "Cannot show value of type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Pretty a => a -> Text
    prettyText a
    t
    --
    processDirective Env
    env (DirectiveImg Exp
    e ImgParams
    params) = do
      (FilePath -> Text) -> ScriptM FilePath -> ScriptM Text
    forall a b. (a -> b) -> ScriptM a -> ScriptM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> Text
    imgBlock (ScriptM FilePath -> ScriptM Text)
    -> ((FilePath -> ScriptM ()) -> ScriptM FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM FilePath
    newFile Env
    env (ImgParams -> Maybe FilePath
    imgFile ImgParams
    params, FilePath
    "img.png") ((FilePath -> ScriptM ()) -> ScriptM Text)
    -> (FilePath -> ScriptM ()) -> ScriptM Text
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    pngfile -> do
        maybe_v <- EvalBuiltin ScriptM
    -> ScriptServer
    -> Exp
    -> ScriptM (Either (Compound ScriptValueType) CompoundValue)
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    EvalBuiltin m
    -> ScriptServer
    -> Exp
    -> m (Either (Compound ScriptValueType) CompoundValue)
    evalExpToGround EvalBuiltin ScriptM
    literateBuiltin (Env -> ScriptServer
    envServer Env
    env) Exp
    e
        case maybe_v of
          Right (ValueAtom Value
    v)
            | Just ByteString
    bmp <- Value -> Maybe ByteString
    valueToBMP Value
    v -> do
                (FilePath -> ScriptM ()) -> ScriptM ()
    forall a. (FilePath -> ScriptM a) -> ScriptM a
    withTempDir ((FilePath -> ScriptM ()) -> ScriptM ())
    -> (FilePath -> ScriptM ()) -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    dir -> do
                  let bmpfile :: FilePath
    bmpfile = FilePath
    dir FilePath -> ShowS
    </> FilePath
    "img.bmp"
                  IO () -> ScriptM ()
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ScriptM ()) -> IO () -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString -> IO ()
    LBS.writeFile FilePath
    bmpfile ByteString
    bmp
                  ScriptM Text -> ScriptM ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ScriptM Text -> ScriptM ()) -> ScriptM Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath] -> Text -> ScriptM Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system FilePath
    "convert" [FilePath
    bmpfile, FilePath
    pngfile] Text
    forall a. Monoid a => a
    mempty
          Right CompoundValue
    v ->
            Compound ValueType -> ScriptM ()
    forall {m :: * -> *} {a} {a}.
    (MonadError Text m, Pretty a) =>
    a -> m a
    nope (Compound ValueType -> ScriptM ())
    -> Compound ValueType -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ (Value -> ValueType) -> CompoundValue -> Compound ValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> ValueType
    valueType CompoundValue
    v
          Left Compound ScriptValueType
    t ->
            Compound ScriptValueType -> ScriptM ()
    forall {m :: * -> *} {a} {a}.
    (MonadError Text m, Pretty a) =>
    a -> m a
    nope Compound ScriptValueType
    t
      where
        nope :: a -> m a
    nope a
    t =
          Text -> m a
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> m a) -> Text -> m a
    forall a b. (a -> b) -> a -> b
    $
            Text
    "Cannot create image from value of type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> a -> Text
    forall a. Pretty a => a -> Text
    prettyText a
    t
    --
    processDirective Env
    env (DirectivePlot Exp
    e Maybe (Int, Int)
    size) = do
      (FilePath -> Text) -> ScriptM FilePath -> ScriptM Text
    forall a b. (a -> b) -> ScriptM a -> ScriptM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> Text
    imgBlock (ScriptM FilePath -> ScriptM Text)
    -> ((FilePath -> ScriptM ()) -> ScriptM FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM FilePath
    newFile Env
    env (Maybe FilePath
    forall a. Maybe a
    Nothing, FilePath
    "plot.png") ((FilePath -> ScriptM ()) -> ScriptM Text)
    -> (FilePath -> ScriptM ()) -> ScriptM Text
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    pngfile -> do
        maybe_v <- EvalBuiltin ScriptM
    -> ScriptServer
    -> Exp
    -> ScriptM (Either (Compound ScriptValueType) CompoundValue)
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    EvalBuiltin m
    -> ScriptServer
    -> Exp
    -> m (Either (Compound ScriptValueType) CompoundValue)
    evalExpToGround EvalBuiltin ScriptM
    literateBuiltin (Env -> ScriptServer
    envServer Env
    env) Exp
    e
        case maybe_v of
          Right CompoundValue
    v
            | Just [Value]
    vs <- CompoundValue -> Maybe [Value]
    plottable2d CompoundValue
    v ->
                [(Maybe Text, [Value])] -> FilePath -> ScriptM ()
    plotWith [(Maybe Text
    forall a. Maybe a
    Nothing, [Value]
    vs)] FilePath
    pngfile
          Right (ValueRecord Map Text CompoundValue
    m)
            | Just Map Text [Value]
    m' <- (CompoundValue -> Maybe [Value])
    -> Map Text CompoundValue -> Maybe (Map Text [Value])
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map Text a -> f (Map Text b)
    traverse CompoundValue -> Maybe [Value]
    plottable2d Map Text CompoundValue
    m -> do
                [(Maybe Text, [Value])] -> FilePath -> ScriptM ()
    plotWith (((Text, [Value]) -> (Maybe Text, [Value]))
    -> [(Text, [Value])] -> [(Maybe Text, [Value])]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text -> Maybe Text) -> (Text, [Value]) -> (Maybe Text, [Value])
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first Text -> Maybe Text
    forall a. a -> Maybe a
    Just) ([(Text, [Value])] -> [(Maybe Text, [Value])])
    -> [(Text, [Value])] -> [(Maybe Text, [Value])]
    forall a b. (a -> b) -> a -> b
    $ Map Text [Value] -> [(Text, [Value])]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Text [Value]
    m') FilePath
    pngfile
          Right CompoundValue
    v ->
            Text -> ScriptM ()
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM ()) -> Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Cannot plot value of type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Compound ValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText ((Value -> ValueType) -> CompoundValue -> Compound ValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> ValueType
    valueType CompoundValue
    v)
          Left Compound ScriptValueType
    t ->
            Text -> ScriptM ()
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM ()) -> Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Cannot plot opaque value of type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Compound ScriptValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText Compound ScriptValueType
    t
      where
        plottable2d :: CompoundValue -> Maybe [Value]
    plottable2d CompoundValue
    v = do
          [x, y] <- CompoundValue -> Maybe [Value]
    plottable CompoundValue
    v
          Just [x, y]

        tag :: (Maybe Text, b) -> Int -> (Text, b)
    tag (Maybe Text
    Nothing, b
    xys) Int
    j = (Text
    "data" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText (Int
    j :: Int), b
    xys)
        tag (Just Text
    f, b
    xys) Int
    _ = (Text
    f, b
    xys)

        plotWith :: [(Maybe Text, [Value])] -> FilePath -> ScriptM ()
    plotWith [(Maybe Text, [Value])]
    xys FilePath
    pngfile =
          [(Text, Text)]
    -> [(Text, [Value])]
    -> ([Text] -> [Text] -> ScriptM ())
    -> ScriptM ()
    forall a.
    [(Text, Text)]
    -> [(Text, [Value])]
    -> ([Text] -> [Text] -> ScriptM a)
    -> ScriptM a
    withGnuplotData [] (((Maybe Text, [Value]) -> Int -> (Text, [Value]))
    -> [(Maybe Text, [Value])] -> [Int] -> [(Text, [Value])]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Maybe Text, [Value]) -> Int -> (Text, [Value])
    forall {b}. (Maybe Text, b) -> Int -> (Text, b)
    tag [(Maybe Text, [Value])]
    xys [Int
    0 ..]) (([Text] -> [Text] -> ScriptM ()) -> ScriptM ())
    -> ([Text] -> [Text] -> ScriptM ()) -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ \[Text]
    fs [Text]
    sets -> do
            let size' :: Text
    size' = FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $
                  case Maybe (Int, Int)
    size of
                    Maybe (Int, Int)
    Nothing -> FilePath
    "500,500"
                    Just (Int
    w, Int
    h) -> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    w FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "," FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    h
                plotCmd :: a -> Maybe a -> a
    plotCmd a
    f Maybe a
    title =
                  let title' :: a
    title' = case Maybe a
    title of
                        Maybe a
    Nothing -> a
    "notitle"
                        Just a
    x -> a
    "title '" a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    x a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    "'"
                   in a
    f a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    " " a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    title' a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    " with lines"
                cmds :: Text
    cmds = Text -> [Text] -> Text
    T.intercalate Text
    ", " ((Text -> Maybe Text -> Text) -> [Text] -> [Maybe Text] -> [Text]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Text -> Maybe Text -> Text
    forall {a}. (IsString a, Semigroup a) => a -> Maybe a -> a
    plotCmd [Text]
    fs (((Maybe Text, [Value]) -> Maybe Text)
    -> [(Maybe Text, [Value])] -> [Maybe Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe Text, [Value]) -> Maybe Text
    forall a b. (a, b) -> a
    fst [(Maybe Text, [Value])]
    xys))
                script :: Text
    script =
                  [Text] -> Text
    T.unlines
                    [ Text
    "set terminal png size " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    size' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " enhanced",
                      Text
    "set output '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    pngfile Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'",
                      Text
    "set key outside",
                      [Text] -> Text
    T.unlines [Text]
    sets,
                      Text
    "plot " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    cmds
                    ]
            ScriptM Text -> ScriptM ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ScriptM Text -> ScriptM ()) -> ScriptM Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath] -> Text -> ScriptM Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system FilePath
    "gnuplot" [] Text
    script
    --
    processDirective Env
    env (DirectiveGnuplot Exp
    e Text
    script) = do
      (FilePath -> Text) -> ScriptM FilePath -> ScriptM Text
    forall a b. (a -> b) -> ScriptM a -> ScriptM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> Text
    imgBlock (ScriptM FilePath -> ScriptM Text)
    -> ((FilePath -> ScriptM ()) -> ScriptM FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM FilePath
    newFile Env
    env (Maybe FilePath
    forall a. Maybe a
    Nothing, FilePath
    "plot.png") ((FilePath -> ScriptM ()) -> ScriptM Text)
    -> (FilePath -> ScriptM ()) -> ScriptM Text
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    pngfile -> do
        maybe_v <- EvalBuiltin ScriptM
    -> ScriptServer
    -> Exp
    -> ScriptM (Either (Compound ScriptValueType) CompoundValue)
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    EvalBuiltin m
    -> ScriptServer
    -> Exp
    -> m (Either (Compound ScriptValueType) CompoundValue)
    evalExpToGround EvalBuiltin ScriptM
    literateBuiltin (Env -> ScriptServer
    envServer Env
    env) Exp
    e
        case maybe_v of
          Right (ValueRecord Map Text CompoundValue
    m)
            | Just Map Text [Value]
    m' <- (CompoundValue -> Maybe [Value])
    -> Map Text CompoundValue -> Maybe (Map Text [Value])
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map Text a -> f (Map Text b)
    traverse CompoundValue -> Maybe [Value]
    plottable Map Text CompoundValue
    m ->
                [(Text, [Value])] -> FilePath -> ScriptM ()
    plotWith (Map Text [Value] -> [(Text, [Value])]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Text [Value]
    m') FilePath
    pngfile
          Right CompoundValue
    v ->
            Text -> ScriptM ()
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM ()) -> Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Cannot plot value of type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Compound ValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText ((Value -> ValueType) -> CompoundValue -> Compound ValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> ValueType
    valueType CompoundValue
    v)
          Left Compound ScriptValueType
    t ->
            Text -> ScriptM ()
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM ()) -> Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Cannot plot opaque value of type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Compound ScriptValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText Compound ScriptValueType
    t
      where
        plotWith :: [(Text, [Value])] -> FilePath -> ScriptM ()
    plotWith [(Text, [Value])]
    xys FilePath
    pngfile = [(Text, Text)]
    -> [(Text, [Value])]
    -> ([Text] -> [Text] -> ScriptM ())
    -> ScriptM ()
    forall a.
    [(Text, Text)]
    -> [(Text, [Value])]
    -> ([Text] -> [Text] -> ScriptM a)
    -> ScriptM a
    withGnuplotData [] [(Text, [Value])]
    xys (([Text] -> [Text] -> ScriptM ()) -> ScriptM ())
    -> ([Text] -> [Text] -> ScriptM ()) -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ \[Text]
    _ [Text]
    sets -> do
          let script' :: Text
    script' =
                [Text] -> Text
    T.unlines
                  [ Text
    "set terminal png enhanced",
                    Text
    "set output '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    pngfile Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'",
                    [Text] -> Text
    T.unlines [Text]
    sets,
                    Text
    script
                  ]
          ScriptM Text -> ScriptM ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ScriptM Text -> ScriptM ()) -> ScriptM Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath] -> Text -> ScriptM Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system FilePath
    "gnuplot" [] Text
    script'
    --
    processDirective Env
    env (DirectiveVideo Exp
    e VideoParams
    params) = do
      Bool -> ScriptM () -> ScriptM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text
    format Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text
    "webm", Text
    "gif"]) (ScriptM () -> ScriptM ()) -> ScriptM () -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $
        Text -> ScriptM ()
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM ()) -> Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $
          Text
    "Unknown video format: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    format

      let file :: (Maybe FilePath, FilePath)
    file = (VideoParams -> Maybe FilePath
    videoFile VideoParams
    params, FilePath
    "video" FilePath -> ShowS
    <.> Text -> FilePath
    T.unpack Text
    format)
      (FilePath -> Text) -> ScriptM FilePath -> ScriptM Text
    forall a b. (a -> b) -> ScriptM a -> ScriptM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (VideoParams -> FilePath -> Text
    videoBlock VideoParams
    params) (ScriptM FilePath -> ScriptM Text)
    -> ((FilePath -> ScriptM ()) -> ScriptM FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM FilePath
    newFile Env
    env (Maybe FilePath, FilePath)
    file ((FilePath -> ScriptM ()) -> ScriptM Text)
    -> (FilePath -> ScriptM ()) -> ScriptM Text
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    videofile -> do
        v <- EvalBuiltin ScriptM -> ScriptServer -> Exp -> ScriptM ExpValue
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    EvalBuiltin m -> ScriptServer -> Exp -> m ExpValue
    evalExp EvalBuiltin ScriptM
    literateBuiltin (Env -> ScriptServer
    envServer Env
    env) Exp
    e
        let nope =
              Text -> ScriptM a
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM a) -> Text -> ScriptM a
    forall a b. (a -> b) -> a -> b
    $
                Text
    "Cannot produce video from value of type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Compound ScriptValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText ((ScriptValue ValOrVar -> ScriptValueType)
    -> ExpValue -> Compound ScriptValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ScriptValue ValOrVar -> ScriptValueType
    forall v. ScriptValue v -> ScriptValueType
    scriptValueType ExpValue
    v)
        case v of
          ValueAtom SValue {} -> do
            ValueAtom arr <- ScriptServer -> ExpValue -> ScriptM CompoundValue
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    ScriptServer -> ExpValue -> m CompoundValue
    getExpValue (Env -> ScriptServer
    envServer Env
    env) ExpValue
    v
            case valueToBMPs arr of
              Maybe [ByteString]
    Nothing -> ScriptM ()
    forall {a}. ScriptM a
    nope
              Just [ByteString]
    bmps ->
                (FilePath -> ScriptM ()) -> ScriptM ()
    forall a. (FilePath -> ScriptM a) -> ScriptM a
    withTempDir ((FilePath -> ScriptM ()) -> ScriptM ())
    -> (FilePath -> ScriptM ()) -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    dir -> do
                  (Int -> ByteString -> ScriptM ())
    -> [Int] -> [ByteString] -> ScriptM ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (FilePath -> Int -> ByteString -> ScriptM ()
    forall {m :: * -> *}.
    MonadIO m =>
    FilePath -> Int -> ByteString -> m ()
    writeBMPFile FilePath
    dir) [Int
    0 ..] [ByteString]
    bmps
                  FilePath -> FilePath -> ScriptM ()
    forall {f :: * -> *}.
    (MonadIO f, MonadError Text f) =>
    FilePath -> FilePath -> f ()
    onWebM FilePath
    videofile (FilePath -> ScriptM ()) -> ScriptM FilePath -> ScriptM ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< FilePath -> ScriptM FilePath
    forall {m :: * -> *}.
    (MonadIO m, MonadError Text m) =>
    FilePath -> m FilePath
    bmpsToVideo FilePath
    dir
          ValueTuple [ExpValue
    stepfun, ExpValue
    initial, ExpValue
    num_frames]
            | ValueAtom (SFun Text
    stepfun' [Text]
    _ [Text
    _, Text
    _] [ScriptValue ValOrVar]
    closure) <- ExpValue
    stepfun,
              ValueAtom (SValue Text
    "i64" ValOrVar
    _) <- ExpValue
    num_frames -> do
                Just (ValueAtom num_frames') <-
                  (Value -> Maybe Int64) -> CompoundValue -> Maybe (Compound Int64)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Compound a -> m (Compound b)
    mapM Value -> Maybe Int64
    forall t. GetValue t => Value -> Maybe t
    getValue (CompoundValue -> Maybe (Compound Int64))
    -> ScriptM CompoundValue -> ScriptM (Maybe (Compound Int64))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ScriptServer -> ExpValue -> ScriptM CompoundValue
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    ScriptServer -> ExpValue -> m CompoundValue
    getExpValue (Env -> ScriptServer
    envServer Env
    env) ExpValue
    num_frames
                withTempDir $ \FilePath
    dir -> do
                  let num_frames_int :: Int
    num_frames_int = Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64
    num_frames' :: Int64)
                  FilePath -> (Text, [ExpValue]) -> ExpValue -> Int -> ScriptM ()
    renderFrames FilePath
    dir (Text
    stepfun', (ScriptValue ValOrVar -> ExpValue)
    -> [ScriptValue ValOrVar] -> [ExpValue]
    forall a b. (a -> b) -> [a] -> [b]
    map ScriptValue ValOrVar -> ExpValue
    forall v. v -> Compound v
    ValueAtom [ScriptValue ValOrVar]
    closure) ExpValue
    initial Int
    num_frames_int
                  FilePath -> FilePath -> ScriptM ()
    forall {f :: * -> *}.
    (MonadIO f, MonadError Text f) =>
    FilePath -> FilePath -> f ()
    onWebM FilePath
    videofile (FilePath -> ScriptM ()) -> ScriptM FilePath -> ScriptM ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< FilePath -> ScriptM FilePath
    forall {m :: * -> *}.
    (MonadIO m, MonadError Text m) =>
    FilePath -> m FilePath
    bmpsToVideo FilePath
    dir
          ExpValue
    _ ->
            ScriptM ()
    forall {a}. ScriptM a
    nope
      where
        framerate :: Int
    framerate = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    30 (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ VideoParams -> Maybe Int
    videoFPS VideoParams
    params
        format :: Text
    format = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "webm" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ VideoParams -> Maybe Text
    videoFormat VideoParams
    params
        bmpfile :: FilePath -> Int -> FilePath
    bmpfile FilePath
    dir Int
    j = FilePath
    dir FilePath -> ShowS
    </> FilePath -> Int -> FilePath
    forall r. PrintfType r => FilePath -> r
    printf FilePath
    "frame%010d.bmp" (Int
    j :: Int)

        (Int -> Int -> ScriptM ()
    progressStep, ScriptM ()
    progressDone)
          | Bool
    fancyTerminal,
            Options -> Int
    scriptVerbose (Env -> Options
    envOpts Env
    env) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 =
              ( \Int
    j Int
    num_frames -> IO () -> ScriptM ()
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ScriptM ()) -> IO () -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ do
                  Text -> IO ()
    T.putStr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    Text
    "\r"
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ProgressBar -> Text
    progressBar
                        (Int -> Double -> Double -> ProgressBar
    ProgressBar Int
    40 (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    num_frames Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    1) (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    j))
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "generating frame "
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Pretty a => a -> Text
    prettyText (Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "/"
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Pretty a => a -> Text
    prettyText Int
    num_frames
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " "
                  Handle -> IO ()
    hFlush Handle
    stdout,
                IO () -> ScriptM ()
    forall a. IO a -> ScriptM a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ScriptM ()) -> IO () -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> IO ()
    T.putStrLn Text
    ""
              )
          | Bool
    otherwise =
              (\Int
    _ Int
    _ -> () -> ScriptM ()
    forall a. a -> ScriptM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (), () -> ScriptM ()
    forall a. a -> ScriptM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())

        renderFrames :: FilePath -> (Text, [ExpValue]) -> ExpValue -> Int -> ScriptM ()
    renderFrames FilePath
    dir (Text
    stepfun, [ExpValue]
    closure) ExpValue
    initial Int
    num_frames = do
          (ExpValue -> Int -> ScriptM ExpValue)
    -> ExpValue -> [Int] -> ScriptM ()
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m ()
    foldM_ ExpValue -> Int -> ScriptM ExpValue
    frame ExpValue
    initial [Int
    0 .. Int
    num_frames Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
          ScriptM ()
    progressDone
          where
            frame :: ExpValue -> Int -> ScriptM ExpValue
    frame ExpValue
    old_state Int
    j = do
              Int -> Int -> ScriptM ()
    progressStep Int
    j Int
    num_frames
              v <-
                EvalBuiltin ScriptM -> ScriptServer -> Exp -> ScriptM ExpValue
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    EvalBuiltin m -> ScriptServer -> Exp -> m ExpValue
    evalExp EvalBuiltin ScriptM
    literateBuiltin (Env -> ScriptServer
    envServer Env
    env)
                  (Exp -> ScriptM ExpValue)
    -> ([ExpValue] -> Exp) -> [ExpValue] -> ScriptM ExpValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Func -> [Exp] -> Exp
    Call (Text -> Func
    FuncFut Text
    stepfun)
                  ([Exp] -> Exp) -> ([ExpValue] -> [Exp]) -> [ExpValue] -> Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ExpValue -> Exp) -> [ExpValue] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map ExpValue -> Exp
    valueToExp
                  ([ExpValue] -> ScriptM ExpValue) -> [ExpValue] -> ScriptM ExpValue
    forall a b. (a -> b) -> a -> b
    $ [ExpValue]
    closure [ExpValue] -> [ExpValue] -> [ExpValue]
    forall a. [a] -> [a] -> [a]
    ++ [ExpValue
    old_state]
              freeValue (envServer env) old_state

              let nope =
                    Text -> ScriptM a
    forall a. Text -> ScriptM a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ScriptM a) -> Text -> ScriptM a
    forall a b. (a -> b) -> a -> b
    $
                      Text
    "Cannot handle step function return type: "
                        Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Compound ScriptValueType -> Text
    forall a. Pretty a => a -> Text
    prettyText ((ScriptValue ValOrVar -> ScriptValueType)
    -> ExpValue -> Compound ScriptValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ScriptValue ValOrVar -> ScriptValueType
    forall v. ScriptValue v -> ScriptValueType
    scriptValueType ExpValue
    v)

              case v of
                ValueTuple [arr_v :: ExpValue
    arr_v@(ValueAtom SValue {}), ExpValue
    new_state] -> do
                  ValueAtom arr <- ScriptServer -> ExpValue -> ScriptM CompoundValue
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    ScriptServer -> ExpValue -> m CompoundValue
    getExpValue (Env -> ScriptServer
    envServer Env
    env) ExpValue
    arr_v
                  freeValue (envServer env) arr_v
                  case valueToBMP arr of
                    Maybe ByteString
    Nothing -> ScriptM ExpValue
    forall {a}. ScriptM a
    nope
                    Just ByteString
    bmp -> do
                      FilePath -> Int -> ByteString -> ScriptM ()
    forall {m :: * -> *}.
    MonadIO m =>
    FilePath -> Int -> ByteString -> m ()
    writeBMPFile FilePath
    dir Int
    j ByteString
    bmp
                      ExpValue -> ScriptM ExpValue
    forall a. a -> ScriptM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ExpValue
    new_state
                ExpValue
    _ -> ScriptM ExpValue
    forall {a}. ScriptM a
    nope

        writeBMPFile :: FilePath -> Int -> ByteString -> m ()
    writeBMPFile FilePath
    dir Int
    j ByteString
    bmp =
          IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString -> IO ()
    LBS.writeFile (FilePath -> Int -> FilePath
    bmpfile FilePath
    dir Int
    j) ByteString
    bmp

        bmpsToVideo :: FilePath -> m FilePath
    bmpsToVideo FilePath
    dir = do
          m Text -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m Text -> m ()) -> m Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
            FilePath -> [FilePath] -> Text -> m Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system
              FilePath
    "ffmpeg"
              [ FilePath
    "-y",
                FilePath
    "-r",
                Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    framerate,
                FilePath
    "-i",
                FilePath
    dir FilePath -> ShowS
    </> FilePath
    "frame%010d.bmp",
                FilePath
    "-c:v",
                FilePath
    "libvpx-vp9",
                FilePath
    "-pix_fmt",
                FilePath
    "yuv420p",
                FilePath
    "-b:v",
                FilePath
    "2M",
                FilePath
    dir FilePath -> ShowS
    </> FilePath
    "video.webm"
              ]
              Text
    forall a. Monoid a => a
    mempty
          FilePath -> m FilePath
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> m FilePath) -> FilePath -> m FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    dir FilePath -> ShowS
    </> FilePath
    "video.webm"

        onWebM :: FilePath -> FilePath -> f ()
    onWebM FilePath
    videofile FilePath
    webmfile
          | Text
    format Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "gif" =
              f Text -> f ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (f Text -> f ()) -> f Text -> f ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath] -> Text -> f Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system FilePath
    "ffmpeg" [FilePath
    "-i", FilePath
    webmfile, FilePath
    videofile] Text
    forall a. Monoid a => a
    mempty
          | Bool
    otherwise =
              IO () -> f ()
    forall a. IO a -> f a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> f ()) -> IO () -> f ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> IO ()
    copyFile FilePath
    webmfile FilePath
    videofile

    --
    processDirective Env
    env (DirectiveAudio Exp
    e AudioParams
    params) = do
      (FilePath -> Text) -> ScriptM FilePath -> ScriptM Text
    forall a b. (a -> b) -> ScriptM a -> ScriptM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> Text
    imgBlock (ScriptM FilePath -> ScriptM Text)
    -> ((FilePath -> ScriptM ()) -> ScriptM FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env
    -> (Maybe FilePath, FilePath)
    -> (FilePath -> ScriptM ())
    -> ScriptM FilePath
    newFile Env
    env (Maybe FilePath
    forall a. Maybe a
    Nothing, FilePath
    "output." FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> FilePath
    T.unpack Text
    output_format) ((FilePath -> ScriptM ()) -> ScriptM Text)
    -> (FilePath -> ScriptM ()) -> ScriptM Text
    forall a b. (a -> b) -> a -> b
    $
        \FilePath
    audiofile -> do
          (FilePath -> ScriptM ()) -> ScriptM ()
    forall a. (FilePath -> ScriptM a) -> ScriptM a
    withTempDir ((FilePath -> ScriptM ()) -> ScriptM ())
    -> (FilePath -> ScriptM ()) -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    dir -> do
            maybe_v <- EvalBuiltin ScriptM
    -> ScriptServer
    -> Exp
    -> ScriptM (Either (Compound ScriptValueType) CompoundValue)
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    EvalBuiltin m
    -> ScriptServer
    -> Exp
    -> m (Either (Compound ScriptValueType) CompoundValue)
    evalExpToGround EvalBuiltin ScriptM
    literateBuiltin (Env -> ScriptServer
    envServer Env
    env) Exp
    e
            maybe_raw_files <- toRawFiles dir maybe_v
            case maybe_raw_files of
              (FilePath
    input_format, [FilePath]
    raw_files) -> do
                ScriptM Text -> ScriptM ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ScriptM Text -> ScriptM ()) -> ScriptM Text -> ScriptM ()
    forall a b. (a -> b) -> a -> b
    $
                  FilePath -> [FilePath] -> Text -> ScriptM Text
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    FilePath -> [FilePath] -> Text -> m Text
    system
                    FilePath
    "ffmpeg"
                    ( (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap
                        ( \FilePath
    raw_file ->
                            [ FilePath
    "-f",
                              FilePath
    input_format,
                              FilePath
    "-ar",
                              Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    sampling_frequency,
                              FilePath
    "-i",
                              FilePath
    raw_file
                            ]
                        )
                        [FilePath]
    raw_files
                        [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [ FilePath
    "-f",
                             Text -> FilePath
    T.unpack Text
    output_format,
                             FilePath
    "-filter_complex",
                             (Int -> FilePath) -> [Int] -> FilePath
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap
                               (\Int
    i -> FilePath
    "[" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    i FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    ":a]")
                               [Int
    0 .. [FilePath] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [FilePath]
    raw_files Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                               FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "amerge=inputs="
                               FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show ([FilePath] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [FilePath]
    raw_files)
                               FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "[a]",
                             FilePath
    "-map",
                             FilePath
    "[a]",
                             FilePath
    audiofile
                           ]
                    )
                    Text
    forall a. Monoid a => a
    mempty
      where
        writeRaw :: FilePath -> FilePath -> Value -> m ()
    writeRaw FilePath
    dir FilePath
    name Value
    v = do
          let rawfile :: FilePath
    rawfile = FilePath
    dir FilePath -> ShowS
    </> FilePath
    name
          let Just ByteString
    bytes = Value -> Maybe ByteString
    toBytes Value
    v
          IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString -> IO ()
    LBS.writeFile FilePath
    rawfile (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    LBS.fromStrict ByteString
    bytes

        toRawFiles :: FilePath -> Either a CompoundValue -> m (a, [FilePath])
    toRawFiles FilePath
    dir (Right (ValueAtom Value
    v))
          | [Int] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Value -> [Int]
    valueShape Value
    v) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1,
            Just a
    input_format <- Value -> Maybe a
    forall {a}. IsString a => Value -> Maybe a
    toFfmpegFormat Value
    v = do
              FilePath -> FilePath -> Value -> m ()
    forall {m :: * -> *}.
    MonadIO m =>
    FilePath -> FilePath -> Value -> m ()
    writeRaw FilePath
    dir FilePath
    "raw.pcm" Value
    v
              (a, [FilePath]) -> m (a, [FilePath])
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    input_format, [FilePath
    dir FilePath -> ShowS
    </> FilePath
    "raw.pcm"])
          | [Int] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Value -> [Int]
    valueShape Value
    v) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2,
            Just a
    input_format <- Value -> Maybe a
    forall {a}. IsString a => Value -> Maybe a
    toFfmpegFormat Value
    v = do
              (a
    input_format,)
                ([FilePath] -> (a, [FilePath]))
    -> m [FilePath] -> m (a, [FilePath])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> Int -> m FilePath) -> [Value] -> [Int] -> m [FilePath]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM
                  ( \Value
    v' Int
    i -> do
                      let file_name :: FilePath
    file_name = FilePath
    "raw-" FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    i FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    ".pcm"
                      FilePath -> FilePath -> Value -> m ()
    forall {m :: * -> *}.
    MonadIO m =>
    FilePath -> FilePath -> Value -> m ()
    writeRaw FilePath
    dir FilePath
    file_name Value
    v'
                      FilePath -> m FilePath
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath -> m FilePath) -> FilePath -> m FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    dir FilePath -> ShowS
    </> FilePath
    file_name
                  )
                  (Value -> [Value]
    valueElems Value
    v)
                  [Int
    0 :: Int ..]
        toRawFiles FilePath
    _ Either a CompoundValue
    v = Either a (Compound ValueType) -> m (a, [FilePath])
    forall {e} {m :: * -> *} {p} {a}.
    (MonadError e m, IsString e) =>
    p -> m a
    nope (Either a (Compound ValueType) -> m (a, [FilePath]))
    -> Either a (Compound ValueType) -> m (a, [FilePath])
    forall a b. (a -> b) -> a -> b
    $ (CompoundValue -> Compound ValueType)
    -> Either a CompoundValue -> Either a (Compound ValueType)
    forall a b. (a -> b) -> Either a a -> Either a b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Value -> ValueType) -> CompoundValue -> Compound ValueType
    forall a b. (a -> b) -> Compound a -> Compound b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Value -> ValueType
    valueType) Either a CompoundValue
    v

        toFfmpegFormat :: Value -> Maybe a
    toFfmpegFormat I8Value {} = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "s8"
        toFfmpegFormat U8Value {} = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "u8"
        toFfmpegFormat I16Value {} = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "s16le"
        toFfmpegFormat U16Value {} = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "u16le"
        toFfmpegFormat I32Value {} = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "s32le"
        toFfmpegFormat U32Value {} = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "u32le"
        toFfmpegFormat F32Value {} = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "f32le"
        toFfmpegFormat F64Value {} = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    "f64le"
        toFfmpegFormat Value
    _ = Maybe a
    forall a. Maybe a
    Nothing

        toBytes :: Value -> Maybe ByteString
    toBytes (I8Value Vector Int
    _ Vector Int8
    bytes) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Int8 -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString Vector Int8
    bytes
        toBytes (U8Value Vector Int
    _ Vector Word8
    bytes) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Word8 -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString Vector Word8
    bytes
        toBytes (I16Value Vector Int
    _ Vector Int16
    bytes) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Int16 -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString Vector Int16
    bytes
        toBytes (U16Value Vector Int
    _ Vector Word16
    bytes) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Word16 -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString Vector Word16
    bytes
        toBytes (I32Value Vector Int
    _ Vector Int32
    bytes) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Int32 -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString Vector Int32
    bytes
        toBytes (U32Value Vector Int
    _ Vector Word32
    bytes) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Word32 -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString Vector Word32
    bytes
        toBytes (F32Value Vector Int
    _ Vector Float
    bytes) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Float -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString Vector Float
    bytes
        toBytes (F64Value Vector Int
    _ Vector Double
    bytes) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Vector Double -> ByteString
    forall a. Storable a => Vector a -> ByteString
    SVec.vectorToByteString Vector Double
    bytes
        toBytes Value
    _ = Maybe ByteString
    forall a. Maybe a
    Nothing

        output_format :: Text
    output_format = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "wav" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ AudioParams -> Maybe Text
    audioCodec AudioParams
    params
        sampling_frequency :: Int
    sampling_frequency = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    44100 (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ AudioParams -> Maybe Int
    audioSamplingFrequency AudioParams
    params
        nope :: p -> m a
    nope p
    _ = e -> m a
    forall a. e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError e
    "Cannot create audio from value"

    -- Did this script block succeed or fail?
    data Failure = Failure | Success
      deriving (Failure -> Failure -> Bool
    (Failure -> Failure -> Bool)
    -> (Failure -> Failure -> Bool) -> Eq Failure
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Failure -> Failure -> Bool
    == :: Failure -> Failure -> Bool
    $c/= :: Failure -> Failure -> Bool
    /= :: Failure -> Failure -> Bool
    Eq, Eq Failure
    Eq Failure =>
    (Failure -> Failure -> Ordering)
    -> (Failure -> Failure -> Bool)
    -> (Failure -> Failure -> Bool)
    -> (Failure -> Failure -> Bool)
    -> (Failure -> Failure -> Bool)
    -> (Failure -> Failure -> Failure)
    -> (Failure -> Failure -> Failure)
    -> Ord Failure
    Failure -> Failure -> Bool
    Failure -> Failure -> Ordering
    Failure -> Failure -> Failure
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Failure -> Failure -> Ordering
    compare :: Failure -> Failure -> Ordering
    $c< :: Failure -> Failure -> Bool
    < :: Failure -> Failure -> Bool
    $c<= :: Failure -> Failure -> Bool
    <= :: Failure -> Failure -> Bool
    $c> :: Failure -> Failure -> Bool
    > :: Failure -> Failure -> Bool
    $c>= :: Failure -> Failure -> Bool
    >= :: Failure -> Failure -> Bool
    $cmax :: Failure -> Failure -> Failure
    max :: Failure -> Failure -> Failure
    $cmin :: Failure -> Failure -> Failure
    min :: Failure -> Failure -> Failure
    Ord, Int -> Failure -> ShowS
    [Failure] -> ShowS
    Failure -> FilePath
    (Int -> Failure -> ShowS)
    -> (Failure -> FilePath) -> ([Failure] -> ShowS) -> Show Failure
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Failure -> ShowS
    showsPrec :: Int -> Failure -> ShowS
    $cshow :: Failure -> FilePath
    show :: Failure -> FilePath
    $cshowList :: [Failure] -> ShowS
    showList :: [Failure] -> ShowS
    Show)

    processBlock :: Env -> Block -> IO (Failure, T.Text, Files)
    processBlock :: Env -> Block -> IO (Failure, Text, Files)
    processBlock Env
    _ (BlockCode Text
    code)
      | Text -> Bool
    T.null Text
    code = (Failure, Text, Files) -> IO (Failure, Text, Files)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Failure
    Success, Text
    forall a. Monoid a => a
    mempty, Files
    forall a. Monoid a => a
    mempty)
      | Bool
    otherwise = (Failure, Text, Files) -> IO (Failure, Text, Files)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Failure
    Success, Text
    "```futhark\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    code Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "```\n", Files
    forall a. Monoid a => a
    mempty)
    processBlock Env
    _ (BlockComment Text
    pretty) =
      (Failure, Text, Files) -> IO (Failure, Text, Files)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Failure
    Success, Text
    pretty, Files
    forall a. Monoid a => a
    mempty)
    processBlock Env
    env (BlockDirective Directive
    directive Text
    text) = do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Options -> Int
    scriptVerbose (Env -> Options
    envOpts Env
    env) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr (Text -> IO ())
    -> (Doc (ZonkAny 0) -> Text) -> Doc (ZonkAny 0) -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc (ZonkAny 0) -> Text
    forall a. Doc a -> Text
    PP.docText (Doc (ZonkAny 0) -> IO ()) -> Doc (ZonkAny 0) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Doc (ZonkAny 0)
    "Processing " Doc (ZonkAny 0) -> Doc (ZonkAny 0) -> Doc (ZonkAny 0)
    forall a. Semigroup a => a -> a -> a
    <> Doc (ZonkAny 0) -> Doc (ZonkAny 0)
    forall ann. Doc ann -> Doc ann
    PP.align (Directive -> Doc (ZonkAny 0)
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Directive -> Doc ann
    PP.pretty Directive
    directive) Doc (ZonkAny 0) -> Doc (ZonkAny 0) -> Doc (ZonkAny 0)
    forall a. Semigroup a => a -> a -> a
    <> Doc (ZonkAny 0)
    "..."
      let prompt :: Text
    prompt = case Directive
    directive of
            DirectiveCovert Directive
    _ -> Text
    forall a. Monoid a => a
    mempty
            DirectiveBrief Directive
    _ ->
              Text
    "```\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Doc (ZonkAny 4) -> Text
    forall a. Doc a -> Text
    PP.docText (Bool -> Directive -> Doc (ZonkAny 4)
    forall a. Bool -> Directive -> Doc a
    pprDirective Bool
    False Directive
    directive) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n```\n"
            Directive
    _ ->
              Text
    "```\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    text Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "```\n"
          env' :: Env
    env' = Env
    env {envHash = hashText (envHash env <> prettyText directive)}
      (r, files) <- ScriptM Text -> IO (Either Text Text, Files)
    forall a. ScriptM a -> IO (Either Text a, Files)
    runScriptM (ScriptM Text -> IO (Either Text Text, Files))
    -> ScriptM Text -> IO (Either Text Text, Files)
    forall a b. (a -> b) -> a -> b
    $ Env -> Directive -> ScriptM Text
    processDirective Env
    env' Directive
    directive
      case r of
        Left Text
    err -> Text -> Text -> Files -> IO (Failure, Text, Files)
    forall {c}. Text -> Text -> c -> IO (Failure, Text, c)
    failed Text
    prompt Text
    err Files
    files
        Right Text
    t -> (Failure, Text, Files) -> IO (Failure, Text, Files)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Failure
    Success, Text
    prompt Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t, Files
    files)
      where
        failed :: Text -> Text -> c -> IO (Failure, Text, c)
    failed Text
    prompt Text
    err c
    files = do
          let message :: Text
    message = Directive -> Text
    forall a. Pretty a => a -> Text
    prettyTextOneLine Directive
    directive Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " failed:\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    err Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n"
          IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> Text -> IO ()
    T.hPutStr Handle
    stderr Text
    message
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Options -> Bool
    scriptStopOnError (Env -> Options
    envOpts Env
    env)) IO ()
    forall a. IO a
    exitFailure
          (Failure, Text, c) -> IO (Failure, Text, c)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
            ( Failure
    Failure,
              [Text] -> Text
    T.unlines [Text
    prompt, Text
    "**FAILED**", Text
    "```", Text
    err, Text
    "```"],
              c
    files
            )

    -- Delete all files in the given directory that are not contained in
    -- 'files'.
    cleanupImgDir :: Env -> Files -> IO ()
    cleanupImgDir :: Env -> Files -> IO ()
    cleanupImgDir Env
    env Files
    keep_files =
      (FilePath -> IO ()) -> [FilePath] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ FilePath -> IO ()
    toRemove ([FilePath] -> IO ())
    -> ([FilePath] -> [FilePath]) -> [FilePath] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath -> Files -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Files
    keep_files))
        ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (FilePath -> IO [FilePath]
    directoryContents (Env -> FilePath
    envImgDir Env
    env) IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
    forall a. IO a -> (IOError -> IO a) -> IO a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` IOError -> IO [FilePath]
    forall {f :: * -> *} {a}. MonadError IOError f => IOError -> f [a]
    onError)
      where
        onError :: IOError -> f [a]
    onError IOError
    e
          | IOError -> Bool
    isDoesNotExistError IOError
    e = [a] -> f [a]
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
          | Bool
    otherwise = IOError -> f [a]
    forall a. IOError -> f a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError IOError
    e
        toRemove :: FilePath -> IO ()
    toRemove FilePath
    f = do
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Options -> Int
    scriptVerbose (Env -> Options
    envOpts Env
    env) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              Text
    "Deleting unused file: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    f
          FilePath -> IO ()
    removePathForcibly FilePath
    f

    processScript :: Env -> [Block] -> IO (Failure, T.Text)
    processScript :: Env -> [Block] -> IO (Failure, Text)
    processScript Env
    env [Block]
    script = do
      (failures, outputs, files) <-
        [(Failure, Text, Files)] -> ([Failure], [Text], [Files])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([(Failure, Text, Files)] -> ([Failure], [Text], [Files]))
    -> IO [(Failure, Text, Files)] -> IO ([Failure], [Text], [Files])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Block -> IO (Failure, Text, Files))
    -> [Block] -> IO [(Failure, Text, Files)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Env -> Block -> IO (Failure, Text, Files)
    processBlock Env
    env) [Block]
    script
      cleanupImgDir env $ mconcat files
      pure (L.foldl' min Success failures, T.intercalate "\n" outputs)

    -- | Common command line options that transform 'Options'.
    scriptCommandLineOptions :: [FunOptDescr Options]
    scriptCommandLineOptions :: [FunOptDescr Options]
    scriptCommandLineOptions =
      [ FilePath
    -> [FilePath]
    -> ArgDescr (Either (IO ()) (Options -> Options))
    -> FilePath
    -> FunOptDescr Options
    forall a.
    FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
    Option
          []
          [FilePath
    "backend"]
          ( (FilePath -> Either (IO ()) (Options -> Options))
    -> FilePath -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a. (FilePath -> a) -> FilePath -> ArgDescr a
    ReqArg
              (\FilePath
    backend -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. b -> Either a b
    Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
    -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. (a -> b) -> a -> b
    $ \Options
    config -> Options
    config {scriptBackend = backend})
              FilePath
    "PROGRAM"
          )
          FilePath
    "The compiler used (defaults to 'c').",
        FilePath
    -> [FilePath]
    -> ArgDescr (Either (IO ()) (Options -> Options))
    -> FilePath
    -> FunOptDescr Options
    forall a.
    FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
    Option
          []
          [FilePath
    "futhark"]
          ( (FilePath -> Either (IO ()) (Options -> Options))
    -> FilePath -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a. (FilePath -> a) -> FilePath -> ArgDescr a
    ReqArg
              (\FilePath
    prog -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. b -> Either a b
    Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
    -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. (a -> b) -> a -> b
    $ \Options
    config -> Options
    config {scriptFuthark = Just prog})
              FilePath
    "PROGRAM"
          )
          FilePath
    "The binary used for operations (defaults to same binary as 'futhark script').",
        FilePath
    -> [FilePath]
    -> ArgDescr (Either (IO ()) (Options -> Options))
    -> FilePath
    -> FunOptDescr Options
    forall a.
    FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
    Option
          FilePath
    "p"
          [FilePath
    "pass-option"]
          ( (FilePath -> Either (IO ()) (Options -> Options))
    -> FilePath -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a. (FilePath -> a) -> FilePath -> ArgDescr a
    ReqArg
              ( \FilePath
    opt ->
                  (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. b -> Either a b
    Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
    -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. (a -> b) -> a -> b
    $ \Options
    config ->
                    Options
    config {scriptExtraOptions = opt : scriptExtraOptions config}
              )
              FilePath
    "OPT"
          )
          FilePath
    "Pass this option to programs being run.",
        FilePath
    -> [FilePath]
    -> ArgDescr (Either (IO ()) (Options -> Options))
    -> FilePath
    -> FunOptDescr Options
    forall a.
    FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
    Option
          []
          [FilePath
    "pass-compiler-option"]
          ( (FilePath -> Either (IO ()) (Options -> Options))
    -> FilePath -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a. (FilePath -> a) -> FilePath -> ArgDescr a
    ReqArg
              ( \FilePath
    opt ->
                  (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. b -> Either a b
    Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
    -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. (a -> b) -> a -> b
    $ \Options
    config ->
                    Options
    config {scriptCompilerOptions = opt : scriptCompilerOptions config}
              )
              FilePath
    "OPT"
          )
          FilePath
    "Pass this option to the compiler.",
        FilePath
    -> [FilePath]
    -> ArgDescr (Either (IO ()) (Options -> Options))
    -> FilePath
    -> FunOptDescr Options
    forall a.
    FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
    Option
          []
          [FilePath
    "skip-compilation"]
          (Either (IO ()) (Options -> Options)
    -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (Options -> Options)
     -> ArgDescr (Either (IO ()) (Options -> Options)))
    -> Either (IO ()) (Options -> Options)
    -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a b. (a -> b) -> a -> b
    $ (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. b -> Either a b
    Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
    -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. (a -> b) -> a -> b
    $ \Options
    config -> Options
    config {scriptSkipCompilation = True})
          FilePath
    "Use already compiled program.",
        FilePath
    -> [FilePath]
    -> ArgDescr (Either (IO ()) (Options -> Options))
    -> FilePath
    -> FunOptDescr Options
    forall a.
    FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
    Option
          FilePath
    "v"
          [FilePath
    "verbose"]
          (Either (IO ()) (Options -> Options)
    -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (Options -> Options)
     -> ArgDescr (Either (IO ()) (Options -> Options)))
    -> Either (IO ()) (Options -> Options)
    -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a b. (a -> b) -> a -> b
    $ (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. b -> Either a b
    Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
    -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. (a -> b) -> a -> b
    $ \Options
    config -> Options
    config {scriptVerbose = scriptVerbose config + 1})
          FilePath
    "Enable logging. Pass multiple times for more."
      ]

    commandLineOptions :: [FunOptDescr Options]
    commandLineOptions :: [FunOptDescr Options]
    commandLineOptions =
      [FunOptDescr Options]
    scriptCommandLineOptions
        [FunOptDescr Options]
    -> [FunOptDescr Options] -> [FunOptDescr Options]
    forall a. Semigroup a => a -> a -> a
    <> [ FilePath
    -> [FilePath]
    -> ArgDescr (Either (IO ()) (Options -> Options))
    -> FilePath
    -> FunOptDescr Options
    forall a.
    FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
    Option
               FilePath
    "o"
               [FilePath
    "output"]
               ((FilePath -> Either (IO ()) (Options -> Options))
    -> FilePath -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a. (FilePath -> a) -> FilePath -> ArgDescr a
    ReqArg (\FilePath
    opt -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. b -> Either a b
    Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
    -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. (a -> b) -> a -> b
    $ \Options
    config -> Options
    config {scriptOutput = Just opt}) FilePath
    "FILE")
               FilePath
    "Override output file. Image directory is set to basename appended with -img/.",
             FilePath
    -> [FilePath]
    -> ArgDescr (Either (IO ()) (Options -> Options))
    -> FilePath
    -> FunOptDescr Options
    forall a.
    FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
    Option
               []
               [FilePath
    "stop-on-error"]
               (Either (IO ()) (Options -> Options)
    -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (Options -> Options)
     -> ArgDescr (Either (IO ()) (Options -> Options)))
    -> Either (IO ()) (Options -> Options)
    -> ArgDescr (Either (IO ()) (Options -> Options))
    forall a b. (a -> b) -> a -> b
    $ (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. b -> Either a b
    Right ((Options -> Options) -> Either (IO ()) (Options -> Options))
    -> (Options -> Options) -> Either (IO ()) (Options -> Options)
    forall a b. (a -> b) -> a -> b
    $ \Options
    config -> Options
    config {scriptStopOnError = True})
               FilePath
    "Stop and do not produce output file if any directive fails."
           ]

    -- | Start up (and eventually shut down) a Futhark server
    -- corresponding to the provided program. If the program has a @.fut@
    -- extension, it will be compiled automatically.
    prepareServer :: FilePath -> Options -> (ScriptServer -> IO a) -> IO a
    prepareServer :: forall a. FilePath -> Options -> (ScriptServer -> IO a) -> IO a
    prepareServer FilePath
    prog Options
    opts ScriptServer -> IO a
    f = do
      futhark <- IO FilePath
    -> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO FilePath
    getExecutablePath FilePath -> IO FilePath
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ Options -> Maybe FilePath
    scriptFuthark Options
    opts

      let is_fut = ShowS
    takeExtension FilePath
    prog FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    ".fut"

      unless (scriptSkipCompilation opts || not is_fut) $ do
        let compile_options = FilePath
    "--server" FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : Options -> [FilePath]
    scriptCompilerOptions Options
    opts
        when (scriptVerbose opts > 0) $
          T.hPutStrLn stderr $
            "Compiling " <> T.pack prog <> "..."
        when (scriptVerbose opts > 1) $
          T.hPutStrLn stderr $
            T.pack $
              unwords compile_options

        let onError Text
    err = do
              Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    err
              IO b
    forall a. IO a
    exitFailure

        void $
          either onError pure <=< runExceptT $
            compileProgram compile_options (FutharkExe futhark) (scriptBackend opts) prog

      let run_options = Options -> [FilePath]
    scriptExtraOptions Options
    opts
          onLine a
    "call" Text
    l = Text -> IO ()
    T.putStrLn Text
    l
          onLine a
    "startup" Text
    l = Text -> IO ()
    T.putStrLn Text
    l
          onLine a
    _ Text
    _ = () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
          prog' = if Bool
    is_fut then ShowS
    dropExtension FilePath
    prog else FilePath
    prog
          cfg =
            (FilePath -> [FilePath] -> ServerCfg
    futharkServerCfg (FilePath
    "." FilePath -> ShowS
    </> FilePath
    prog') [FilePath]
    run_options)
              { cfgOnLine =
                  if scriptVerbose opts > 0
                    then onLine
                    else const . const $ pure ()
              }

      withScriptServer cfg f

    -- | Run @futhark literate@.
    main :: String -> [String] -> IO ()
    main :: FilePath -> [FilePath] -> IO ()
    main = Options
    -> [FunOptDescr Options]
    -> FilePath
    -> ([FilePath] -> Options -> Maybe (IO ()))
    -> FilePath
    -> [FilePath]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> FilePath
    -> ([FilePath] -> cfg -> Maybe (IO ()))
    -> FilePath
    -> [FilePath]
    -> IO ()
    mainWithOptions Options
    initialOptions [FunOptDescr Options]
    commandLineOptions FilePath
    "program" (([FilePath] -> Options -> Maybe (IO ()))
     -> FilePath -> [FilePath] -> IO ())
    -> ([FilePath] -> Options -> Maybe (IO ()))
    -> FilePath
    -> [FilePath]
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[FilePath]
    args Options
    opts ->
      case [FilePath]
    args of
        [FilePath
    prog] -> IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ do
          futhark <- IO FilePath
    -> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO FilePath
    getExecutablePath FilePath -> IO FilePath
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ Options -> Maybe FilePath
    scriptFuthark Options
    opts
          let onError Text
    err = do
                Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr Text
    err
                IO b
    forall a. IO a
    exitFailure
          proghash <-
            either onError pure <=< runExceptT $
              system futhark ["hash", prog] mempty
          script <- parseProgFile prog

          orig_dir <- getCurrentDirectory
          let entryOpt Text
    v = FilePath
    "--entry-point=" FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> FilePath
    T.unpack Text
    v
              opts' =
                Options
    opts
                  { scriptCompilerOptions =
                      map entryOpt (S.toList (varsInScripts script))
                        <> scriptCompilerOptions opts
                  }
          prepareServer prog opts' $ \ScriptServer
    server -> do
            let mdfile :: FilePath
    mdfile = FilePath -> Maybe FilePath -> FilePath
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath
    prog FilePath -> ShowS
    `replaceExtension` FilePath
    "md") (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Options -> Maybe FilePath
    scriptOutput Options
    opts
                prog_dir :: FilePath
    prog_dir = ShowS
    takeDirectory FilePath
    prog
                imgdir :: FilePath
    imgdir = ShowS
    dropExtension (ShowS
    takeFileName FilePath
    mdfile) FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "-img"
                env :: Env
    env =
                  Env
                    { envServer :: ScriptServer
    envServer = ScriptServer
    server,
                      envOpts :: Options
    envOpts = Options
    opts,
                      envHash :: Text
    envHash = Text
    proghash,
                      envImgDir :: FilePath
    envImgDir = FilePath
    imgdir
                    }

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Options -> Int
    scriptVerbose Options
    opts Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
              Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Executing from " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack FilePath
    prog_dir
            FilePath -> IO ()
    setCurrentDirectory FilePath
    prog_dir

            (failure, md) <- Env -> [Block] -> IO (Failure, Text)
    processScript Env
    env [Block]
    script
            T.writeFile (orig_dir </> mdfile) md
            when (failure == Failure) exitFailure
        [FilePath]
    _ -> Maybe (IO ())
    forall a. Maybe a
    Nothing