Last active
May 7, 2021 22:50
-
-
Save cleichner/826e5f35decffa8ba03dde123c9755b1 to your computer and use it in GitHub Desktop.
Example code to explore the example from https://www.youtube.com/watch?v=sIqZEmnFer8 without the use of the 'barbies' library
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- Copyright 2021 Google LLC. | |
-- SPDX-License-Identifier: Apache-2.0 | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE PolyKinds #-} | |
{-# LANGUAGE RankNTypes #-} | |
{-# LANGUAGE TypeOperators #-} | |
module Main where | |
import Data.Functor.Identity | |
import Data.Functor.Product | |
data Config f = Config { | |
port :: f Int, | |
yaml :: f FilePath, | |
name :: f String | |
} | |
bmap :: (forall a . f a -> g a) -> Config f -> Config g | |
bmap f cfg = Config { port = f (port cfg), | |
yaml = f (yaml cfg), | |
name = f (name cfg) | |
} | |
bpure :: (forall a. f a) -> Config f | |
bpure c = Config { port = c, yaml = c, name = c } | |
bprod :: Config f -> Config g -> Config (Product f g) | |
bprod cfgf cfgg = Config { port = Pair (port cfgf) (port cfgg), | |
yaml = Pair (yaml cfgf) (yaml cfgg), | |
name = Pair (name cfgf) (name cfgg) | |
} | |
bzip :: Config f -> Config g -> Config (Product f g) | |
bzip = bprod | |
bZipWith :: (forall field . f field -> g field -> h field) | |
-> Config f -> Config g -> Config h | |
bZipWith zf hf hg = bmap (\(Pair cf cg) -> zf cf cg) (bprod hf hg) | |
defs :: Config Identity | |
defs = Config { | |
port = Identity 3, | |
yaml = Identity "/etc/config", | |
name = Identity "default" | |
} | |
update :: Config Maybe | |
update = Config { | |
port = Nothing, | |
yaml = Nothing, | |
name = Just "non-default" | |
} | |
merge :: forall field . Identity field -> Maybe field -> Identity field | |
merge (Identity def) over = | |
case over of | |
Just x -> Identity x | |
Nothing -> Identity def | |
mergeConfigs :: Config Identity -> Config Maybe -> Config Identity | |
mergeConfigs = bZipWith merge | |
main = do | |
let upcfg = mergeConfigs defs update | |
print (name upcfg) | |
print (yaml upcfg) | |
print (port upcfg) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment