]>
Commit | Line | Data |
---|---|---|
a9d77a20 FM |
1 | {-# LANGUAGE OverloadedStrings #-} |
2 | ||
3 | module Text.Edifact.Scaffolder.Segments | |
4 | ( segments | |
5 | ) where | |
6 | ||
7 | import Text.Edifact.Scaffolder.Commons | |
8 | ||
9 | import Text.Edifact.Scaffolder.Segments.Dependencies | |
10 | import Text.Edifact.Scaffolder.Segments.Elements | |
11 | import Text.Edifact.Scaffolder.Segments.Implementation | |
12 | import Text.Edifact.Scaffolder.Segments.Specification | |
13 | import Text.Edifact.Scaffolder.Segments.Types | |
14 | ||
15 | import Data.List.NonEmpty (nubBy) | |
16 | import Formatting | |
17 | ||
18 | segments :: Scaffolding () | |
19 | segments = listSegments >>= scaffoldElements parentSegmentModule segmentModule | |
20 | ||
21 | parentSegmentModule :: NonEmpty (ElementWithDefinition SegmentCode) -> Scaffolding () | |
22 | parentSegmentModule = parentModule "Segments" "S" segmentModuleName | |
23 | ||
24 | segmentModuleName :: ModuleName -> SegmentCode -> ModuleName | |
25 | segmentModuleName mn code = mn <.> fromString (getSegmentCode code) | |
26 | ||
27 | segmentModule :: ElementWithDefinition SegmentCode -> Scaffolding () | |
28 | segmentModule (inputFile, code) = do | |
29 | moduleName <- getRootModuleNameFor (segmentModuleName "Segments" code) | |
30 | dependencies <- scanDependencies inputFile (snd <$> specificationParser) | |
31 | specification <- includeSpecification inputFile | |
32 | let parserFunction = fSegmentParserFunction | |
33 | fDescription = "Segment " % fSegmentCode | |
34 | parserNotYetImplemented = sformat (notYetImplemented fDescription) code | |
35 | defaultImplementation = haskellList [ parserNotYetImplemented ] | |
36 | elements = sort . nubBy (\a b -> getCode a == getCode b) . fmap dependencyElement <$> dependencies | |
37 | implementation = maybe defaultImplementation toImplementation dependencies | |
38 | buildDependencies b = fromMaybe [] <$> traverse b elements | |
39 | dependenciesReexports <- buildDependencies mkDependenciesReexports | |
40 | dependenciesImports <- buildDependencies mkDependenciesImports | |
41 | dependenciesHaddock <- buildDependencies mkDependenciesHaddock | |
42 | let exports = Comment "* Definition" | |
43 | : Name (sformat parserFunction code) | |
44 | : dependenciesReexports | |
45 | imports = dependenciesImports | |
46 | <> [ importCombinators ] | |
47 | <> maybe [ importNotYetImplementedHelper ] (const []) dependencies | |
48 | documentation = specification <> dependenciesHaddock | |
49 | signature = sformat (fParserSignature parserFunction) code | |
50 | definition = [ sformat (fParserDeclaration parserFunction) code | |
51 | , indent (sformat ("segment " % quoted fSegmentCode) code) | |
52 | ] <> (indent . indent <$> implementation) | |
53 | parser = signature : definition | |
54 | scaffoldModule moduleName ["OverloadedStrings"] exports imports (documentation <> parser) |