{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
module Predicate.Data.IO (
ReadFile
, ReadFileBinary
, FileExists
, ReadDir
, DirExists
, AppendFile
, WriteFile
, WriteFile'
, Stdout
, Stderr
, Stdin
, ReadIO
, ReadIO'
, ReadEnv
, ReadEnvAll
, TimeUtc
, TimeZt
) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.Maybe (IsJust)
import Predicate.Data.Monoid (type (<>))
import Predicate.Data.ReadShow (ReadP)
import GHC.TypeLits (Symbol,KnownSymbol)
import Data.Proxy (Proxy(Proxy))
import qualified Control.Exception as E
import Data.Kind (Type)
import Control.Arrow (ArrowChoice(left))
import Data.Time (UTCTime, ZonedTime, getCurrentTime, getZonedTime)
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.IO (hPutStr, withFile, IOMode(WriteMode, AppendMode), stderr)
import System.Environment (getEnvironment, lookupEnv)
import qualified Data.ByteString.Char8 as BS8
data ReadFile p deriving Int -> ReadFile p -> ShowS
[ReadFile p] -> ShowS
ReadFile p -> String
(Int -> ReadFile p -> ShowS)
-> (ReadFile p -> String)
-> ([ReadFile p] -> ShowS)
-> Show (ReadFile p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ReadFile p -> ShowS
forall k (p :: k). [ReadFile p] -> ShowS
forall k (p :: k). ReadFile p -> String
showList :: [ReadFile p] -> ShowS
$cshowList :: forall k (p :: k). [ReadFile p] -> ShowS
show :: ReadFile p -> String
$cshow :: forall k (p :: k). ReadFile p -> String
showsPrec :: Int -> ReadFile p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ReadFile p -> ShowS
Show
instance ( PP p x ~ String
, P p x
) => P (ReadFile p) x where
type PP (ReadFile p) x = Maybe String
eval :: proxy (ReadFile p) -> POpts -> x -> m (TT (PP (ReadFile p) x))
eval proxy (ReadFile p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"ReadFile"
TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe String)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
Left TT (Maybe String)
e -> TT (Maybe String) -> m (TT (Maybe String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe String)
e
Right String
p -> do
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
Maybe (Maybe String)
mb <- IO (Maybe String) -> m (Maybe (Maybe String))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe String) -> m (Maybe (Maybe String)))
-> IO (Maybe String) -> m (Maybe (Maybe String))
forall a b. (a -> b) -> a -> b
$ IO Bool
-> IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
p)
(String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
p)
IO (Maybe String)
forall a. Monoid a => a
mempty
TT (Maybe String) -> m (TT (Maybe String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe String) -> m (TT (Maybe String)))
-> TT (Maybe String) -> m (TT (Maybe String))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe String)
mb of
Maybe (Maybe String)
Nothing -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Maybe String)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just Maybe String
Nothing -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe String -> Val (Maybe String)
forall a. a -> Val a
Val Maybe String
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist") [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just (Just String
b) -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe String -> Val (Maybe String)
forall a. a -> Val a
Val (String -> Maybe String
forall a. a -> Maybe a
Just String
b)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" len=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Just " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
b) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
data ReadFileBinary p deriving Int -> ReadFileBinary p -> ShowS
[ReadFileBinary p] -> ShowS
ReadFileBinary p -> String
(Int -> ReadFileBinary p -> ShowS)
-> (ReadFileBinary p -> String)
-> ([ReadFileBinary p] -> ShowS)
-> Show (ReadFileBinary p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ReadFileBinary p -> ShowS
forall k (p :: k). [ReadFileBinary p] -> ShowS
forall k (p :: k). ReadFileBinary p -> String
showList :: [ReadFileBinary p] -> ShowS
$cshowList :: forall k (p :: k). [ReadFileBinary p] -> ShowS
show :: ReadFileBinary p -> String
$cshow :: forall k (p :: k). ReadFileBinary p -> String
showsPrec :: Int -> ReadFileBinary p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ReadFileBinary p -> ShowS
Show
instance ( PP p x ~ String
, P p x
) => P (ReadFileBinary p) x where
type PP (ReadFileBinary p) x = Maybe BS8.ByteString
eval :: proxy (ReadFileBinary p)
-> POpts -> x -> m (TT (PP (ReadFileBinary p) x))
eval proxy (ReadFileBinary p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"ReadFileBinary"
TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe ByteString)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
Left TT (Maybe ByteString)
e -> TT (Maybe ByteString) -> m (TT (Maybe ByteString))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe ByteString)
e
Right String
p -> do
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
Maybe (Maybe ByteString)
mb <- IO (Maybe ByteString) -> m (Maybe (Maybe ByteString))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe ByteString) -> m (Maybe (Maybe ByteString)))
-> IO (Maybe ByteString) -> m (Maybe (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ IO Bool
-> IO (Maybe ByteString)
-> IO (Maybe ByteString)
-> IO (Maybe ByteString)
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
p)
(ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS8.readFile String
p)
IO (Maybe ByteString)
forall a. Monoid a => a
mempty
TT (Maybe ByteString) -> m (TT (Maybe ByteString))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe ByteString) -> m (TT (Maybe ByteString)))
-> TT (Maybe ByteString) -> m (TT (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe ByteString)
mb of
Maybe (Maybe ByteString)
Nothing -> POpts
-> Val (Maybe ByteString)
-> String
-> [Tree PE]
-> TT (Maybe ByteString)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Maybe ByteString)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just Maybe ByteString
Nothing -> POpts
-> Val (Maybe ByteString)
-> String
-> [Tree PE]
-> TT (Maybe ByteString)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe ByteString -> Val (Maybe ByteString)
forall a. a -> Val a
Val Maybe ByteString
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist") [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just (Just ByteString
b) -> POpts
-> Val (Maybe ByteString)
-> String
-> [Tree PE]
-> TT (Maybe ByteString)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe ByteString -> Val (Maybe ByteString)
forall a. a -> Val a
Val (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" len=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS8.length ByteString
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Just " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ByteString -> String
litBS POpts
opts ByteString
b) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
data FileExists p deriving Int -> FileExists p -> ShowS
[FileExists p] -> ShowS
FileExists p -> String
(Int -> FileExists p -> ShowS)
-> (FileExists p -> String)
-> ([FileExists p] -> ShowS)
-> Show (FileExists p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> FileExists p -> ShowS
forall k (p :: k). [FileExists p] -> ShowS
forall k (p :: k). FileExists p -> String
showList :: [FileExists p] -> ShowS
$cshowList :: forall k (p :: k). [FileExists p] -> ShowS
show :: FileExists p -> String
$cshow :: forall k (p :: k). FileExists p -> String
showsPrec :: Int -> FileExists p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> FileExists p -> ShowS
Show
type FileExistsT p = ReadFile p >> IsJust
instance P (FileExistsT p) x => P (FileExists p) x where
type PP (FileExists p) x = PP (FileExistsT p) x
eval :: proxy (FileExists p) -> POpts -> x -> m (TT (PP (FileExists p) x))
eval proxy (FileExists p)
_ = Proxy (FileExistsT p)
-> POpts -> x -> m (TT (PP (FileExistsT p) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (FileExistsT p)
forall k (t :: k). Proxy t
Proxy @(FileExistsT p))
data DirExists p deriving Int -> DirExists p -> ShowS
[DirExists p] -> ShowS
DirExists p -> String
(Int -> DirExists p -> ShowS)
-> (DirExists p -> String)
-> ([DirExists p] -> ShowS)
-> Show (DirExists p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> DirExists p -> ShowS
forall k (p :: k). [DirExists p] -> ShowS
forall k (p :: k). DirExists p -> String
showList :: [DirExists p] -> ShowS
$cshowList :: forall k (p :: k). [DirExists p] -> ShowS
show :: DirExists p -> String
$cshow :: forall k (p :: k). DirExists p -> String
showsPrec :: Int -> DirExists p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> DirExists p -> ShowS
Show
type DirExistsT p = ReadDir p >> IsJust
instance P (DirExistsT p) x => P (DirExists p) x where
type PP (DirExists p) x = PP (DirExistsT p) x
eval :: proxy (DirExists p) -> POpts -> x -> m (TT (PP (DirExists p) x))
eval proxy (DirExists p)
_ = Proxy (DirExistsT p) -> POpts -> x -> m (TT (PP (DirExistsT p) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (DirExistsT p)
forall k (t :: k). Proxy t
Proxy @(DirExistsT p))
data ReadDir p deriving Int -> ReadDir p -> ShowS
[ReadDir p] -> ShowS
ReadDir p -> String
(Int -> ReadDir p -> ShowS)
-> (ReadDir p -> String)
-> ([ReadDir p] -> ShowS)
-> Show (ReadDir p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ReadDir p -> ShowS
forall k (p :: k). [ReadDir p] -> ShowS
forall k (p :: k). ReadDir p -> String
showList :: [ReadDir p] -> ShowS
$cshowList :: forall k (p :: k). [ReadDir p] -> ShowS
show :: ReadDir p -> String
$cshow :: forall k (p :: k). ReadDir p -> String
showsPrec :: Int -> ReadDir p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ReadDir p -> ShowS
Show
instance ( PP p x ~ String
, P p x
) => P (ReadDir p) x where
type PP (ReadDir p) x = Maybe [FilePath]
eval :: proxy (ReadDir p) -> POpts -> x -> m (TT (PP (ReadDir p) x))
eval proxy (ReadDir p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"ReadDir"
TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe [String])) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
Left TT (Maybe [String])
e -> TT (Maybe [String]) -> m (TT (Maybe [String]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe [String])
e
Right String
p -> do
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
Maybe (Maybe [String])
mb <- IO (Maybe [String]) -> m (Maybe (Maybe [String]))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe [String]) -> m (Maybe (Maybe [String])))
-> IO (Maybe [String]) -> m (Maybe (Maybe [String]))
forall a b. (a -> b) -> a -> b
$ IO Bool
-> IO (Maybe [String])
-> IO (Maybe [String])
-> IO (Maybe [String])
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesDirectoryExist String
p)
([String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> IO [String] -> IO (Maybe [String])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
p)
IO (Maybe [String])
forall a. Monoid a => a
mempty
TT (Maybe [String]) -> m (TT (Maybe [String]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe [String]) -> m (TT (Maybe [String])))
-> TT (Maybe [String]) -> m (TT (Maybe [String]))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe [String])
mb of
Maybe (Maybe [String])
Nothing -> POpts
-> Val (Maybe [String])
-> String
-> [Tree PE]
-> TT (Maybe [String])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Maybe [String])
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just Maybe [String]
Nothing -> POpts
-> Val (Maybe [String])
-> String
-> [Tree PE]
-> TT (Maybe [String])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe [String] -> Val (Maybe [String])
forall a. a -> Val a
Val Maybe [String]
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist") [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just (Just [String]
b) -> POpts
-> Val (Maybe [String])
-> String
-> [Tree PE]
-> TT (Maybe [String])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe [String] -> Val (Maybe [String])
forall a. a -> Val a
Val ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
b)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" len=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [String]
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Just " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [String] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [String]
b) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
data ReadEnv p deriving Int -> ReadEnv p -> ShowS
[ReadEnv p] -> ShowS
ReadEnv p -> String
(Int -> ReadEnv p -> ShowS)
-> (ReadEnv p -> String)
-> ([ReadEnv p] -> ShowS)
-> Show (ReadEnv p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ReadEnv p -> ShowS
forall k (p :: k). [ReadEnv p] -> ShowS
forall k (p :: k). ReadEnv p -> String
showList :: [ReadEnv p] -> ShowS
$cshowList :: forall k (p :: k). [ReadEnv p] -> ShowS
show :: ReadEnv p -> String
$cshow :: forall k (p :: k). ReadEnv p -> String
showsPrec :: Int -> ReadEnv p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ReadEnv p -> ShowS
Show
instance ( PP p x ~ String
, P p x
) => P (ReadEnv p) x where
type PP (ReadEnv p) x = Maybe String
eval :: proxy (ReadEnv p) -> POpts -> x -> m (TT (PP (ReadEnv p) x))
eval proxy (ReadEnv p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"ReadEnv"
TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe String)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
Left TT (Maybe String)
e -> TT (Maybe String) -> m (TT (Maybe String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe String)
e
Right String
p -> do
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
Maybe (Maybe String)
mb <- IO (Maybe String) -> m (Maybe (Maybe String))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe String) -> m (Maybe (Maybe String)))
-> IO (Maybe String) -> m (Maybe (Maybe String))
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
p
TT (Maybe String) -> m (TT (Maybe String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe String) -> m (TT (Maybe String)))
-> TT (Maybe String) -> m (TT (Maybe String))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe String)
mb of
Maybe (Maybe String)
Nothing -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Maybe String)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just Maybe String
Nothing -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe String -> Val (Maybe String)
forall a. a -> Val a
Val Maybe String
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist") [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just (Just String
v) -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe String -> Val (Maybe String)
forall a. a -> Val a
Val (String -> Maybe String
forall a. a -> Maybe a
Just String
v)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
v) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
data ReadEnvAll deriving Int -> ReadEnvAll -> ShowS
[ReadEnvAll] -> ShowS
ReadEnvAll -> String
(Int -> ReadEnvAll -> ShowS)
-> (ReadEnvAll -> String)
-> ([ReadEnvAll] -> ShowS)
-> Show ReadEnvAll
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadEnvAll] -> ShowS
$cshowList :: [ReadEnvAll] -> ShowS
show :: ReadEnvAll -> String
$cshow :: ReadEnvAll -> String
showsPrec :: Int -> ReadEnvAll -> ShowS
$cshowsPrec :: Int -> ReadEnvAll -> ShowS
Show
instance P ReadEnvAll a where
type PP ReadEnvAll a = [(String,String)]
eval :: proxy ReadEnvAll -> POpts -> a -> m (TT (PP ReadEnvAll a))
eval proxy ReadEnvAll
_ POpts
opts a
_ = do
let msg0 :: String
msg0 = String
"ReadEnvAll"
Maybe [(String, String)]
mb <- IO [(String, String)] -> m (Maybe [(String, String)])
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO IO [(String, String)]
getEnvironment
TT [(String, String)] -> m (TT [(String, String)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(String, String)] -> m (TT [(String, String)]))
-> TT [(String, String)] -> m (TT [(String, String)])
forall a b. (a -> b) -> a -> b
$ case Maybe [(String, String)]
mb of
Maybe [(String, String)]
Nothing -> POpts
-> Val [(String, String)]
-> String
-> [Tree PE]
-> TT [(String, String)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [(String, String)]
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" []
Just [(String, String)]
v -> POpts
-> Val [(String, String)]
-> String
-> [Tree PE]
-> TT [(String, String)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(String, String)] -> Val [(String, String)]
forall a. a -> Val a
Val [(String, String)]
v) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" count=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([(String, String)] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [(String, String)]
v)) []
data TimeUtc deriving Int -> TimeUtc -> ShowS
[TimeUtc] -> ShowS
TimeUtc -> String
(Int -> TimeUtc -> ShowS)
-> (TimeUtc -> String) -> ([TimeUtc] -> ShowS) -> Show TimeUtc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeUtc] -> ShowS
$cshowList :: [TimeUtc] -> ShowS
show :: TimeUtc -> String
$cshow :: TimeUtc -> String
showsPrec :: Int -> TimeUtc -> ShowS
$cshowsPrec :: Int -> TimeUtc -> ShowS
Show
instance P TimeUtc a where
type PP TimeUtc a = UTCTime
eval :: proxy TimeUtc -> POpts -> a -> m (TT (PP TimeUtc a))
eval proxy TimeUtc
_ POpts
opts a
_ = do
let msg0 :: String
msg0 = String
"TimeUtc"
Maybe UTCTime
mb <- IO UTCTime -> m (Maybe UTCTime)
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO IO UTCTime
getCurrentTime
TT UTCTime -> m (TT UTCTime)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT UTCTime -> m (TT UTCTime)) -> TT UTCTime -> m (TT UTCTime)
forall a b. (a -> b) -> a -> b
$ case Maybe UTCTime
mb of
Maybe UTCTime
Nothing -> POpts -> Val UTCTime -> String -> [Tree PE] -> TT UTCTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val UTCTime
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" []
Just UTCTime
v -> POpts -> Val UTCTime -> String -> [Tree PE] -> TT UTCTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (UTCTime -> Val UTCTime
forall a. a -> Val a
Val UTCTime
v) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> UTCTime -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts UTCTime
v) []
data TimeZt deriving Int -> TimeZt -> ShowS
[TimeZt] -> ShowS
TimeZt -> String
(Int -> TimeZt -> ShowS)
-> (TimeZt -> String) -> ([TimeZt] -> ShowS) -> Show TimeZt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeZt] -> ShowS
$cshowList :: [TimeZt] -> ShowS
show :: TimeZt -> String
$cshow :: TimeZt -> String
showsPrec :: Int -> TimeZt -> ShowS
$cshowsPrec :: Int -> TimeZt -> ShowS
Show
instance P TimeZt a where
type PP TimeZt a = ZonedTime
eval :: proxy TimeZt -> POpts -> a -> m (TT (PP TimeZt a))
eval proxy TimeZt
_ POpts
opts a
_ = do
let msg0 :: String
msg0 = String
"TimeZt"
Maybe ZonedTime
mb <- IO ZonedTime -> m (Maybe ZonedTime)
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO IO ZonedTime
getZonedTime
TT ZonedTime -> m (TT ZonedTime)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT ZonedTime -> m (TT ZonedTime))
-> TT ZonedTime -> m (TT ZonedTime)
forall a b. (a -> b) -> a -> b
$ case Maybe ZonedTime
mb of
Maybe ZonedTime
Nothing -> POpts -> Val ZonedTime -> String -> [Tree PE] -> TT ZonedTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ZonedTime
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" []
Just ZonedTime
v -> POpts -> Val ZonedTime -> String -> [Tree PE] -> TT ZonedTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ZonedTime -> Val ZonedTime
forall a. a -> Val a
Val ZonedTime
v) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ZonedTime -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts ZonedTime
v) []
data FHandle s = FStdout | FStderr | FOther !s !WFMode
deriving stock (ReadPrec [FHandle s]
ReadPrec (FHandle s)
Int -> ReadS (FHandle s)
ReadS [FHandle s]
(Int -> ReadS (FHandle s))
-> ReadS [FHandle s]
-> ReadPrec (FHandle s)
-> ReadPrec [FHandle s]
-> Read (FHandle s)
forall s. Read s => ReadPrec [FHandle s]
forall s. Read s => ReadPrec (FHandle s)
forall s. Read s => Int -> ReadS (FHandle s)
forall s. Read s => ReadS [FHandle s]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FHandle s]
$creadListPrec :: forall s. Read s => ReadPrec [FHandle s]
readPrec :: ReadPrec (FHandle s)
$creadPrec :: forall s. Read s => ReadPrec (FHandle s)
readList :: ReadS [FHandle s]
$creadList :: forall s. Read s => ReadS [FHandle s]
readsPrec :: Int -> ReadS (FHandle s)
$creadsPrec :: forall s. Read s => Int -> ReadS (FHandle s)
Read, Int -> FHandle s -> ShowS
[FHandle s] -> ShowS
FHandle s -> String
(Int -> FHandle s -> ShowS)
-> (FHandle s -> String)
-> ([FHandle s] -> ShowS)
-> Show (FHandle s)
forall s. Show s => Int -> FHandle s -> ShowS
forall s. Show s => [FHandle s] -> ShowS
forall s. Show s => FHandle s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FHandle s] -> ShowS
$cshowList :: forall s. Show s => [FHandle s] -> ShowS
show :: FHandle s -> String
$cshow :: forall s. Show s => FHandle s -> String
showsPrec :: Int -> FHandle s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> FHandle s -> ShowS
Show, FHandle s -> FHandle s -> Bool
(FHandle s -> FHandle s -> Bool)
-> (FHandle s -> FHandle s -> Bool) -> Eq (FHandle s)
forall s. Eq s => FHandle s -> FHandle s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FHandle s -> FHandle s -> Bool
$c/= :: forall s. Eq s => FHandle s -> FHandle s -> Bool
== :: FHandle s -> FHandle s -> Bool
$c== :: forall s. Eq s => FHandle s -> FHandle s -> Bool
Eq)
class GetFHandle (x :: FHandle Symbol) where getFHandle :: FHandle String
instance GetFHandle 'FStdout where getFHandle :: FHandle String
getFHandle = FHandle String
forall s. FHandle s
FStdout
instance GetFHandle 'FStderr where getFHandle :: FHandle String
getFHandle = FHandle String
forall s. FHandle s
FStderr
instance ( GetMode w
, KnownSymbol s
) => GetFHandle ('FOther s w) where getFHandle :: FHandle String
getFHandle = String -> WFMode -> FHandle String
forall s. s -> WFMode -> FHandle s
FOther (KnownSymbol s => String
forall (s :: Symbol). KnownSymbol s => String
symb @s) (GetMode w => WFMode
forall (x :: WFMode). GetMode x => WFMode
getMode @w)
data WFMode = WFAppend | WFWrite | WFWriteForce
deriving stock (ReadPrec [WFMode]
ReadPrec WFMode
Int -> ReadS WFMode
ReadS [WFMode]
(Int -> ReadS WFMode)
-> ReadS [WFMode]
-> ReadPrec WFMode
-> ReadPrec [WFMode]
-> Read WFMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WFMode]
$creadListPrec :: ReadPrec [WFMode]
readPrec :: ReadPrec WFMode
$creadPrec :: ReadPrec WFMode
readList :: ReadS [WFMode]
$creadList :: ReadS [WFMode]
readsPrec :: Int -> ReadS WFMode
$creadsPrec :: Int -> ReadS WFMode
Read, Int -> WFMode -> ShowS
[WFMode] -> ShowS
WFMode -> String
(Int -> WFMode -> ShowS)
-> (WFMode -> String) -> ([WFMode] -> ShowS) -> Show WFMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WFMode] -> ShowS
$cshowList :: [WFMode] -> ShowS
show :: WFMode -> String
$cshow :: WFMode -> String
showsPrec :: Int -> WFMode -> ShowS
$cshowsPrec :: Int -> WFMode -> ShowS
Show, WFMode -> WFMode -> Bool
(WFMode -> WFMode -> Bool)
-> (WFMode -> WFMode -> Bool) -> Eq WFMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WFMode -> WFMode -> Bool
$c/= :: WFMode -> WFMode -> Bool
== :: WFMode -> WFMode -> Bool
$c== :: WFMode -> WFMode -> Bool
Eq)
class GetMode (x :: WFMode) where getMode :: WFMode
instance GetMode 'WFAppend where getMode :: WFMode
getMode = WFMode
WFAppend
instance GetMode 'WFWriteForce where getMode :: WFMode
getMode = WFMode
WFWriteForce
instance GetMode 'WFWrite where getMode :: WFMode
getMode = WFMode
WFWrite
data WriteFileImpl (hh :: FHandle Symbol) p deriving Int -> WriteFileImpl hh p -> ShowS
[WriteFileImpl hh p] -> ShowS
WriteFileImpl hh p -> String
(Int -> WriteFileImpl hh p -> ShowS)
-> (WriteFileImpl hh p -> String)
-> ([WriteFileImpl hh p] -> ShowS)
-> Show (WriteFileImpl hh p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (hh :: FHandle Symbol) k (p :: k).
Int -> WriteFileImpl hh p -> ShowS
forall (hh :: FHandle Symbol) k (p :: k).
[WriteFileImpl hh p] -> ShowS
forall (hh :: FHandle Symbol) k (p :: k).
WriteFileImpl hh p -> String
showList :: [WriteFileImpl hh p] -> ShowS
$cshowList :: forall (hh :: FHandle Symbol) k (p :: k).
[WriteFileImpl hh p] -> ShowS
show :: WriteFileImpl hh p -> String
$cshow :: forall (hh :: FHandle Symbol) k (p :: k).
WriteFileImpl hh p -> String
showsPrec :: Int -> WriteFileImpl hh p -> ShowS
$cshowsPrec :: forall (hh :: FHandle Symbol) k (p :: k).
Int -> WriteFileImpl hh p -> ShowS
Show
data AppendFile (s :: Symbol) p deriving Int -> AppendFile s p -> ShowS
[AppendFile s p] -> ShowS
AppendFile s p -> String
(Int -> AppendFile s p -> ShowS)
-> (AppendFile s p -> String)
-> ([AppendFile s p] -> ShowS)
-> Show (AppendFile s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) k (p :: k). Int -> AppendFile s p -> ShowS
forall (s :: Symbol) k (p :: k). [AppendFile s p] -> ShowS
forall (s :: Symbol) k (p :: k). AppendFile s p -> String
showList :: [AppendFile s p] -> ShowS
$cshowList :: forall (s :: Symbol) k (p :: k). [AppendFile s p] -> ShowS
show :: AppendFile s p -> String
$cshow :: forall (s :: Symbol) k (p :: k). AppendFile s p -> String
showsPrec :: Int -> AppendFile s p -> ShowS
$cshowsPrec :: forall (s :: Symbol) k (p :: k). Int -> AppendFile s p -> ShowS
Show
type AppendFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFAppend) p
instance P (AppendFileT s p) x => P (AppendFile s p) x where
type PP (AppendFile s p) x = PP (AppendFileT s p) x
eval :: proxy (AppendFile s p)
-> POpts -> x -> m (TT (PP (AppendFile s p) x))
eval proxy (AppendFile s p)
_ = Proxy (AppendFileT s p)
-> POpts -> x -> m (TT (PP (AppendFileT s p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (AppendFileT s p)
forall k (t :: k). Proxy t
Proxy @(AppendFileT s p))
data WriteFile' (s :: Symbol) p deriving Int -> WriteFile' s p -> ShowS
[WriteFile' s p] -> ShowS
WriteFile' s p -> String
(Int -> WriteFile' s p -> ShowS)
-> (WriteFile' s p -> String)
-> ([WriteFile' s p] -> ShowS)
-> Show (WriteFile' s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) k (p :: k). Int -> WriteFile' s p -> ShowS
forall (s :: Symbol) k (p :: k). [WriteFile' s p] -> ShowS
forall (s :: Symbol) k (p :: k). WriteFile' s p -> String
showList :: [WriteFile' s p] -> ShowS
$cshowList :: forall (s :: Symbol) k (p :: k). [WriteFile' s p] -> ShowS
show :: WriteFile' s p -> String
$cshow :: forall (s :: Symbol) k (p :: k). WriteFile' s p -> String
showsPrec :: Int -> WriteFile' s p -> ShowS
$cshowsPrec :: forall (s :: Symbol) k (p :: k). Int -> WriteFile' s p -> ShowS
Show
type WriteFileT' (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWriteForce) p
instance P (WriteFileT' s p) x => P (WriteFile' s p) x where
type PP (WriteFile' s p) x = PP (WriteFileT' s p) x
eval :: proxy (WriteFile' s p)
-> POpts -> x -> m (TT (PP (WriteFile' s p) x))
eval proxy (WriteFile' s p)
_ = Proxy (WriteFileT' s p)
-> POpts -> x -> m (TT (PP (WriteFileT' s p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (WriteFileT' s p)
forall k (t :: k). Proxy t
Proxy @(WriteFileT' s p))
data WriteFile (s :: Symbol) p deriving Int -> WriteFile s p -> ShowS
[WriteFile s p] -> ShowS
WriteFile s p -> String
(Int -> WriteFile s p -> ShowS)
-> (WriteFile s p -> String)
-> ([WriteFile s p] -> ShowS)
-> Show (WriteFile s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) k (p :: k). Int -> WriteFile s p -> ShowS
forall (s :: Symbol) k (p :: k). [WriteFile s p] -> ShowS
forall (s :: Symbol) k (p :: k). WriteFile s p -> String
showList :: [WriteFile s p] -> ShowS
$cshowList :: forall (s :: Symbol) k (p :: k). [WriteFile s p] -> ShowS
show :: WriteFile s p -> String
$cshow :: forall (s :: Symbol) k (p :: k). WriteFile s p -> String
showsPrec :: Int -> WriteFile s p -> ShowS
$cshowsPrec :: forall (s :: Symbol) k (p :: k). Int -> WriteFile s p -> ShowS
Show
type WriteFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWrite) p
instance P (WriteFileT s p) x => P (WriteFile s p) x where
type PP (WriteFile s p) x = PP (WriteFileT s p) x
eval :: proxy (WriteFile s p)
-> POpts -> x -> m (TT (PP (WriteFile s p) x))
eval proxy (WriteFile s p)
_ = Proxy (WriteFileT s p)
-> POpts -> x -> m (TT (PP (WriteFileT s p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (WriteFileT s p)
forall k (t :: k). Proxy t
Proxy @(WriteFileT s p))
data Stdout p deriving Int -> Stdout p -> ShowS
[Stdout p] -> ShowS
Stdout p -> String
(Int -> Stdout p -> ShowS)
-> (Stdout p -> String) -> ([Stdout p] -> ShowS) -> Show (Stdout p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Stdout p -> ShowS
forall k (p :: k). [Stdout p] -> ShowS
forall k (p :: k). Stdout p -> String
showList :: [Stdout p] -> ShowS
$cshowList :: forall k (p :: k). [Stdout p] -> ShowS
show :: Stdout p -> String
$cshow :: forall k (p :: k). Stdout p -> String
showsPrec :: Int -> Stdout p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Stdout p -> ShowS
Show
type StdoutT p = WriteFileImpl 'FStdout p
instance P (StdoutT p) x => P (Stdout p) x where
type PP (Stdout p) x = PP (StdoutT p) x
eval :: proxy (Stdout p) -> POpts -> x -> m (TT (PP (Stdout p) x))
eval proxy (Stdout p)
_ = Proxy (StdoutT p) -> POpts -> x -> m (TT (PP (StdoutT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (StdoutT p)
forall k (t :: k). Proxy t
Proxy @(StdoutT p))
data Stderr p deriving Int -> Stderr p -> ShowS
[Stderr p] -> ShowS
Stderr p -> String
(Int -> Stderr p -> ShowS)
-> (Stderr p -> String) -> ([Stderr p] -> ShowS) -> Show (Stderr p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Stderr p -> ShowS
forall k (p :: k). [Stderr p] -> ShowS
forall k (p :: k). Stderr p -> String
showList :: [Stderr p] -> ShowS
$cshowList :: forall k (p :: k). [Stderr p] -> ShowS
show :: Stderr p -> String
$cshow :: forall k (p :: k). Stderr p -> String
showsPrec :: Int -> Stderr p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Stderr p -> ShowS
Show
type StderrT p = WriteFileImpl 'FStderr p
instance P (StderrT p) x => P (Stderr p) x where
type PP (Stderr p) x = PP (StderrT p) x
eval :: proxy (Stderr p) -> POpts -> x -> m (TT (PP (Stderr p) x))
eval proxy (Stderr p)
_ = Proxy (StderrT p) -> POpts -> x -> m (TT (PP (StderrT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (StderrT p)
forall k (t :: k). Proxy t
Proxy @(StderrT p))
instance ( GetFHandle fh
, P p a
, PP p a ~ String
) => P (WriteFileImpl fh p) a where
type PP (WriteFileImpl fh p) a = ()
eval :: proxy (WriteFileImpl fh p)
-> POpts -> a -> m (TT (PP (WriteFileImpl fh p) a))
eval proxy (WriteFileImpl fh p)
_ POpts
opts a
a = do
let fh :: FHandle String
fh = GetFHandle fh => FHandle String
forall (x :: FHandle Symbol). GetFHandle x => FHandle String
getFHandle @fh
msg0 :: String
msg0 = case FHandle String
fh of
FHandle String
FStdout -> String
"Stdout"
FHandle String
FStderr -> String
"Stderr"
FOther String
s WFMode
w -> (String -> ShowS
forall a. Semigroup a => a -> a -> a
<>(String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]")) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ case WFMode
w of
WFMode
WFAppend -> String
"AppendFile"
WFMode
WFWrite -> String
"WriteFile"
WFMode
WFWriteForce -> String
"WriteFile'"
TT String
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT ()) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
Left TT ()
e -> TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT ()
e
Right String
ss -> do
Maybe (Either String ())
mb <- IO (Either String ()) -> m (Maybe (Either String ()))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Either String ()) -> m (Maybe (Either String ())))
-> IO (Either String ()) -> m (Maybe (Either String ()))
forall a b. (a -> b) -> a -> b
$ case FHandle String
fh of
FHandle String
FStdout -> (SomeException -> String)
-> Either SomeException () -> Either String ()
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left SomeException -> String
forall e. Exception e => e -> String
E.displayException (Either SomeException () -> Either String ())
-> IO (Either SomeException ()) -> IO (Either String ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException (String -> IO ()
putStr String
ss)
FHandle String
FStderr -> (SomeException -> String)
-> Either SomeException () -> Either String ()
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left SomeException -> String
forall e. Exception e => e -> String
E.displayException (Either SomeException () -> Either String ())
-> IO (Either SomeException ()) -> IO (Either String ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException (Handle -> String -> IO ()
hPutStr Handle
stderr String
ss)
FOther String
s WFMode
w -> do
Bool
b <- String -> IO Bool
doesFileExist String
s
if Bool
b Bool -> Bool -> Bool
&& WFMode
w WFMode -> WFMode -> Bool
forall a. Eq a => a -> a -> Bool
== WFMode
WFWrite then Either String () -> IO (Either String ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"file [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"] already exists"
else do
let md :: IOMode
md = case WFMode
w of
WFMode
WFAppend -> IOMode
AppendMode
WFMode
WFWrite -> IOMode
WriteMode
WFMode
WFWriteForce -> IOMode
WriteMode
(SomeException -> String)
-> Either SomeException () -> Either String ()
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left SomeException -> String
forall e. Exception e => e -> String
E.displayException (Either SomeException () -> Either String ())
-> IO (Either SomeException ()) -> IO (Either String ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException (String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
s IOMode
md (Handle -> String -> IO ()
`hPutStr` String
ss))
TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT () -> m (TT ())) -> TT () -> m (TT ())
forall a b. (a -> b) -> a -> b
$ case Maybe (Either String ())
mb of
Maybe (Either String ())
Nothing -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ()
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just (Left String
e) -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ()
forall a. String -> Val a
Fail (String -> Val ()) -> String -> Val ()
forall a b. (a -> b) -> a -> b
$ String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
Just (Right ()) -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (() -> Val ()
forall a. a -> Val a
Val ()) String
msg0 [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
type ReadIO (t :: Type) = ReadIO' t "Enter value"
type ReadIO' (t :: Type) s = Stdout (s <> ":") >> Stdin >> ReadP t Id
data Stdin deriving Int -> Stdin -> ShowS
[Stdin] -> ShowS
Stdin -> String
(Int -> Stdin -> ShowS)
-> (Stdin -> String) -> ([Stdin] -> ShowS) -> Show Stdin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stdin] -> ShowS
$cshowList :: [Stdin] -> ShowS
show :: Stdin -> String
$cshow :: Stdin -> String
showsPrec :: Int -> Stdin -> ShowS
$cshowsPrec :: Int -> Stdin -> ShowS
Show
instance P Stdin x where
type PP Stdin x = String
eval :: proxy Stdin -> POpts -> x -> m (TT (PP Stdin x))
eval proxy Stdin
_ POpts
opts x
_ = do
let msg0 :: String
msg0 = String
"Stdin"
Maybe (Either SomeException String)
mb <- IO (Either SomeException String)
-> m (Maybe (Either SomeException String))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Either SomeException String)
-> m (Maybe (Either SomeException String)))
-> IO (Either SomeException String)
-> m (Maybe (Either SomeException String))
forall a b. (a -> b) -> a -> b
$ IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException IO String
getLine
TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ case Maybe (Either SomeException String)
mb of
Maybe (Either SomeException String)
Nothing -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" []
Just (Left SomeException
e) -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. String -> Val a
Fail (String -> Val String) -> String -> Val String
forall a b. (a -> b) -> a -> b
$ String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall e. Exception e => e -> String
E.displayException SomeException
e) String
"" []
Just (Right String
ss) -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val String
ss) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
"" String
ss String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") []