polysemy-methodology 0.1.2.1 → 0.1.3.0
raw patch · 3 files changed
+76/−53 lines, 3 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Polysemy.Methodology: traceMethodologyAround :: forall b c r a. Members '[Methodology b c, Trace] r => (b -> String) -> (c -> String) -> Sem r a -> Sem r a
+ Polysemy.Methodology: traceMethodologyEnd :: forall b c r a. Members '[Methodology b c, Trace] r => (c -> String) -> Sem r a -> Sem r a
+ Polysemy.Methodology: traceMethodologyStart :: forall b c r a. Members '[Methodology b c, Trace] r => (b -> String) -> Sem r a -> Sem r a
- Polysemy.Methodology: process :: forall b_ab3z c_ab3A r_acln. MemberWithError (Methodology b_ab3z c_ab3A) r_acln => b_ab3z -> Sem r_acln c_ab3A
+ Polysemy.Methodology: process :: forall b_ab3J c_ab3K r_aclx. MemberWithError (Methodology b_ab3J c_ab3K) r_aclx => b_ab3J -> Sem r_aclx c_ab3K
Files
- README.md +37/−52
- polysemy-methodology.cabal +1/−1
- src/Polysemy/Methodology.hs +38/−0
README.md view
@@ -31,7 +31,7 @@ A worked example of this approach can be found in the [flashblast](https://gitlab.com/homotopic-tech/flashblast)-repository. In this we want to take a configuration in dhall,+repository. In this we want to take a configuration, and process it in some way an output of flashcards. We might model this as such:@@ -47,7 +47,7 @@ -- | A `DeckConfiguration` indicates how we create cards. data DeckConfiguration --- | A `CollectionsPackage` indicates.+-- | A `CollectionsPackage` indicates the desired output format. data CollectionsPackage -- | The Construction Methodology for flashblast.@@ -85,25 +85,14 @@ | BasicReversed [BasicReversedCard] | MinimalReversed [MinimalReversedCard] deriving stock Generic- deriving D.FromDhall- via D.Codec (D.Field (D.DropPrefix "_")) Spec makePrisms ''Spec -data Part = Part {- _outfile :: Path Rel File-, _spec :: Spec-} deriving Generic- deriving D.FromDhall- via D.Codec (D.Field (D.DropPrefix "_")) Part- data Deck = Deck { _resourceDirs :: ResourceDirs , _exportDirs :: ExportDirs-, _parts :: [Part]+, _parts :: [Spec] } deriving stock Generic- deriving D.FromDhall- via D.Codec (D.Field (D.DropPrefix "_")) Deck ``` ```@@ -116,8 +105,8 @@ deriving Monoid via GenericMonoid Deck main = do- Config.FlashBlast{..} <- D.input D.auto "./index.dhall"- forM_ _decks $ \x -> do+ decks <- ...+ forM_ decks $ \x -> do flashblast @Config.Deck @Deck & runM ```@@ -211,57 +200,53 @@ it. ```-type DeckSplit = '[Map (Path Rel File) [Config.MinimalReversedCard]- , Map (Path Rel File) [Config.BasicReversedCard]- , Map (Path Rel File) [Config.ExcerptSpec]- , Map (Path Rel File) [Config.PronunciationSpec]- ]--type FileMap b = Map (Path b File)--extractParts :: Prism' Config.Spec x -> Config.Deck -> Map (Path Rel File) x-extractParts x = Map.fromList . itoListOf- ( Config.parts- % itraversed- %> reindexed (view Config.outfile) selfIndex- % Config.spec- % x- )--- main = do- Config.FlashBlast{..} <- D.input D.auto "./index.dhall"- forM_ _decks $ \x -> do+ forM_ decks $ \x -> do flashblast @Config.Deck @Deck & untag @ConstructionMethodology & decomposeMethodology @Config.Deck @DeckSplit @Deck- -- We pull out `Config.Deck -> (FileMap Rel [Config.MinimalReversedCard]` as its own `Methodology`.- & separateMethodologyInitial @Config.Deck @(FileMap Rel [Config.MinimalReversedCard])+ -- We pull out `Config.Deck -> [Config.MinimalReversedCard]` as its own `Methodology`.+ & separateMethodologyInitial @Config.Deck @[Config.MinimalReversedCard]) -- And then immediately solve it purely.- & runMethodologyPure (extractParts Config._MinimalReversed)- -- and do the same for each one in the list.- & separateMethodologyInitial @Config.Deck @(FileMap Rel [Config.BasicReversedCard])- & runMethodologyPure (extractParts Config._BasicReversed)- & separateMethodologyInitial @Config.Deck @(FileMap Rel [Config.ExcerptSpec])- & runMethodologyPure (extractParts Config._Excerpt)- & separateMethodologyInitial @Config.Deck @(FileMap Rel [Config.PronunciationSpec])- & runMethodologyPure (extractParts Config._Pronunciation)+ & runMethodologyPure _+ & separateMethodologyInitial @Config.Deck @[Config.BasicReversedCard]+ & runMethodologyPure _+ & separateMethodologyInitial @Config.Deck @[Config.ExcerptSpec]+ & runMethodologyPure _+ & separateMethodologyInitial @Config.Deck @[Config.PronunciationSpec]+ & runMethodologyPure _ & endMethodologyInitial- & separateMethodologyTerminal @(FileMap Rel [Config.MinimalReversedCard]) @Deck+ & separateMethodologyTerminal @[Config.MinimalReversedCard] @Deck & runMethodologyPure _- & separateMethodologyTerminal @(FileMap Rel [Config.BasicReversedCard]) @Deck+ & separateMethodologyTerminal @[Config.BasicReversedCard] @Deck & runMethodologyPure _- & separateMethodologyTerminal @(FileMap Rel [Config.ExcerptSpec]) @Deck+ & separateMethodologyTerminal @[Config.ExcerptSpec] @Deck & runMethodologySem _- & separateMethodologyTerminal @(FileMap Rel [Config.PronunciationSpec]) @Deck+ & separateMethodologyTerminal @[Config.PronunciationSpec] @Deck & runMethodologySem _ ``` We have left holes that polysemy will now tell us need to be filled by nice clean `a -> b` or `a -> Sem r b` functions. Any effects we add here we can deal with after this block, or-we can decompose this even further (see flashblast for details).+we can decompose this even further (see flashblast for more details).++## Logging++You can also surround `Methodology`s with logging using the+`traceMethodologyStart`, `traceMethodologyEnd` and `traceMethodologyAround`+functions.++```+ & decomposeMethodology @Config.Deck @DeckSplit @Deck+ & traceMethodologyAround @Config.Deck @(HList DeckSplit)+ (const $ T.unpack $ "Analysing Deck: " <> n)+ (const $ T.unpack $ "Finished Analysing Deck: " <> n)+ & separateMethodologyInitial @Config.Deck @[Config.MinimalReversedCard]+ & traceMethodologyAround @Config.Deck @[Config.MinimalReversedCard]+ (const "Extracting Minimal Reversed Card Specs")+ (\c -> "Found " <> show (length c) <> " Minimal Card specs.")+``` ## Notes
polysemy-methodology.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: polysemy-methodology-version: 0.1.2.1+version: 0.1.3.0 synopsis: Domain modelling algebra for polysemy category: Polysemy author: Daniel Firth
src/Polysemy/Methodology.hs view
@@ -18,6 +18,7 @@ import Polysemy.Input import Polysemy.Output import Polysemy.Several+import Polysemy.Trace -- | A `Methodology` generalises a semantic process from `b` to `c`. data Methodology b c m a where@@ -218,3 +219,40 @@ traverseMethodology = interpret \case Process b -> sequenceA <$> traverse (process @b @(f c)) b +-- | `Trace` a `String` based on the input to a `Methodology`.+traceMethodologyStart :: forall b c r a.+ Members '[Methodology b c,+ Trace] r+ => (b -> String)+ -> Sem r a+ -> Sem r a+traceMethodologyStart f = intercept \case+ Process b -> trace (f b) >> process @b @c b++-- | `Trace` a `String` based on the output to a `Methodology`.+traceMethodologyEnd :: forall b c r a.+ Members '[Methodology b c,+ Trace] r+ => (c -> String)+ -> Sem r a+ -> Sem r a+traceMethodologyEnd f = intercept \case+ Process b -> do+ c <- process @b @c b+ trace $ f c+ return c++-- | `Trace` both the start and the end of a `Methodology`.+traceMethodologyAround :: forall b c r a.+ Members '[Methodology b c,+ Trace] r+ => (b -> String)+ -> (c -> String)+ -> Sem r a+ -> Sem r a+traceMethodologyAround f g = intercept \case+ Process b -> do+ trace $ f b+ c <- process @b @c b+ trace $ g c+ return c