etorreborre

registry' = 
     genVal (pure Permanent)
  <: registry
  
permanentCompany :: GenIO Company  
permanentCompany = make registry'

λ> replicateM 5 $ sampleIO (make @(GenIO EmployeeStatus) registry')
[Permanent,Permanent,Permanent,Permanent,Permanent]

etorreborre

   fun genEmployeeStatus
<: genFun (tag @"permanent" Permanent) -- Gen (Tag "permanent" EmployeeStatus)
<: genFun (tag @"temporary" Temporary) -- Gen (Tag "temporary" EmployeeStatus)

genEmployeeStatus :: 
     GenIO (Tag "permanent" EmployeeStatus) 
  -> GenIO (Tag "temporary" EmployeeStatus) 
  -> GenIO EmployeeStatus
genEmployeeStatus g1 g2 = Gen.choice [fmap unTagg1, fmap unTag g2]

etorreborre

import           Data.Registry
import           Data.Registry.Hedgehog
import           Hedgehog.Gen
import           Hedgehog.Range
import           Protolude                  hiding (list)
import           Test.Data.Registry.Company

registry =
    genFun Company
 <: genFun Department

etorreborre

genCompany :: Gen Text -> Gen [Department] -> Gen Company
genCompany g1 g2 = Company <$> g1 <*> g2

genDepartment :: Gen Text -> Gen [Employee] -> Gen Department
genDepartment g1 g2 = Department <$> g1 <*> g2

genEmployee :: Gen Text -> Gen EmployeeStatus -> Gen Int -> Gen (Maybe Int) -> Gen Employee
genEmployee g1 g2 g3 g4 = Employee <$> g1 <*> g2 <*> g3 <*> g4

genDepartments :: Gen Deparment -> Gen [Department]

etorreborre

data Company = Company {
  companyName :: Text
, departments :: [Department]
} deriving (Eq, Show)

data Department = Department {
  departmentName :: Text
, employees      :: [Employee]
} deriving (Eq, Show)

etorreborre

-- reuse the Arbitrary instance for String
-- and make only small Text values
instance Arbitrary Text where
  arbitrary = Text.take 5 . toS . arbitrary @String

etorreborre

-- reuse the Arbitrary instance for String
-- and make only small Text values
instance Arbitrary Text where
  arbitrary = Text.take 5 . toS . arbitrary @String

etorreborre

data Logger m = Logger {
  info :: Text -> m ()
, warn :: Text -> m ()  
}

-- | IO is only used to create the Logger
newLogger :: Logger IO
newLogger = Logger {
  info = \t -> print ("[INFO] " <> show t)
, warn = \t -> print ("[WARN] " <> show t)  

etorreborre

newBatchedOutput :: (Monad m) => Tag "unbatched" (Output m) -> Output m
newBatchedOutput output = Output {
  saveOutputs = concat . saveOutputs (unTag output). batchesOf 500
}

batchesOf :: (Monad m) => Int -> Stream (Of a) m r -> Stream (Of [a]) m r
batchesOf batchSize = mapsM toList . chunksOf batchSize

etorreborre

newtype Output m = Output {
  saveOutputs :: forall a . (ToJSON a) => Stream (Of a) m () -> Stream (Of a) m ()
}

newHttpOutput :: (Monad m) => Http m -> Output m
newHttpOutput http = Output {
  saveOutputs = saveOutputs' http
}