Skip to content

Instantly share code, notes, and snippets.

View etorreborre's full-sized avatar
🏠
Working from home

Eric Torreborre etorreborre

🏠
Working from home
View GitHub Profile
@etorreborre
etorreborre / sketch.hs
Created August 6, 2019 11:45
schemaz-registry?
import Data.Registry
data Company = Company [Department] deriving (Eq, Show)
data Departement = Department [PersonV0] deriving (Eq, Show)
data PersonV0 = PersonV0 Text deriving (Eq, Show)
data PersonV1 = PersonV1 Text Int deriving (Eq, Show)
-- A registry for a given "schema". That registry can be lifted to
-- any Applicative context: Encoder, Decoder, Gen, ...
-- a component
data FileSystem m = FileSystem {
exists :: Path -> m (Either Text Bool)
, readFile :: Path -> m (Either Text Text)
}
-- a constructor for a mock file system
newFileSystemWith :: (FileSystemValues -> FileSystemValues) -> FileSystem
newFileSystemWith f = FileSystem {
exists = \_ -> pure (_exists $ f fileSystemValues)
data Expr =
Var String
| Lam String Expr
| App Expr Expr
@etorreborre
etorreborre / cycle-constructors.hs
Created May 12, 2019 10:59
cycle-constructors
test_cycle_constructors =
prop "we can cycle deterministically across all the constructors of a data type" $ runS generators $ do
setGenS @Int (pure 1)
setCycleChooserS @EmployeeStatus
names <- replicateM 10 (forallS @EmployeeStatus)
names === take 10 (join $ repeat [Permanent, Temporary 1])
@etorreborre
etorreborre / propertyt-statet
Created May 12, 2019 10:36
propertyt-statet
test_with_better_department_name =
prop "a department must have a short capitalized name" $ runS generators $ do
setSmallCompany
setDepartmentName
company <- forallS @Company
let Just d = head $ departments company
(T.length (departmentName d) <= 5) === True
@etorreborre
etorreborre / setShortDepartmentNamesS.hs
Last active May 12, 2019 10:32
setShortDepartmentNamesS
setShortDepartmentNamesS :: MonadState (Registry _ _) m => m ()
setShortDepartmentNamesS = specializeGenS @Department genDepartmentName
@etorreborre
etorreborre / override-department-names
Last active May 12, 2019 10:26
override-department-names
-- short and upper cased names
genDepartmentName = T.take 5 . T.toUpper <$> genText
registry' =
specializeGen @Department genDepartmentName
registry
-- we get specific department names
λ> fmap departmentName <$> (replicateM 5 $ sampleIO (make @(GenIO Department) registry'))
["CE","UNZ","FG","V","HIB"]
registry' =
fun (list @Deparment (linear 10 1000))
<: registry
@etorreborre
etorreborre / override-employee-status.hs
Last active May 12, 2019 10:24
override-employee-status
registry' =
genVal (pure Permanent)
<: registry
permanentCompany :: GenIO Company
permanentCompany = make registry'
λ> replicateM 5 $ sampleIO (make @(GenIO EmployeeStatus) registry')
[Permanent,Permanent,Permanent,Permanent,Permanent]
@etorreborre
etorreborre / tagging-constructors.hs
Created May 12, 2019 09:57
tagging-constructors
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]