├── edition-helper ├── README.md ├── .gitignore ├── Setup.hs ├── test │ ├── Spec.hs │ ├── PrimitiveTest │ │ ├── Pure │ │ │ ├── Node.hs │ │ │ ├── PrimitivePureSpec.hs │ │ │ ├── ModelType.hs │ │ │ ├── ModelId.hs │ │ │ ├── UnitData.hs │ │ │ ├── ModelInfo.hs │ │ │ └── ModelAttr.hs │ │ ├── Node.hs │ │ └── NodeType.hs │ └── UtilsTest │ │ ├── XmlUtilsSpec.hs │ │ ├── StrUtilsSpec.hs │ │ └── MapUtilsSpec.hs ├── app │ ├── Main │ └── Main.hs ├── src │ ├── Lib.hs │ ├── Io │ │ └── ProjectLayout.hs │ ├── Control │ │ ├── Pure │ │ │ ├── NodeInfo.hs │ │ │ └── NodeAttr.hs │ │ ├── Xml.hs │ │ ├── NodeId.hs │ │ ├── NodeType.hs │ │ └── Node.hs │ ├── FunctionDef │ │ ├── Matcher.hs │ │ ├── Modifier.hs │ │ ├── Transformer.hs │ │ └── Setter.hs │ ├── Utils │ │ ├── XmlUtils.hs │ │ ├── StrUtils.hs │ │ └── MapUtils.hs │ ├── Primitive │ │ ├── Instance │ │ │ ├── NodeType.hs │ │ │ ├── Node.hs │ │ │ ├── NodeId.hs │ │ │ └── NodeAttr.hs │ │ └── Definition │ │ │ ├── Node.hs │ │ │ └── Error.hs │ └── View │ │ └── XmlRenderer.hs ├── stack.yaml.lock ├── docs │ └── docstructure.json ├── ChangeLog.md ├── package.yaml ├── LICENSE ├── stack.yaml └── report.html ├── README.md ├── .gitignore └── LICENSE /edition-helper/README.md: -------------------------------------------------------------------------------- 1 | # edition-helper 2 | -------------------------------------------------------------------------------- /edition-helper/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | edition-helper.cabal 3 | *~ -------------------------------------------------------------------------------- /edition-helper/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /edition-helper/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /edition-helper/app/Main: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/D-K-E/typesafe-edition-helper/master/edition-helper/app/Main -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # typesafe-edition-helper 2 | Make your digital editions type safe with haskell. Plus some xml rendering stuff 3 | -------------------------------------------------------------------------------- /edition-helper/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) where 4 | 5 | someFunc :: IO () 6 | someFunc = putStrLn "someFunc" 7 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/Pure/Node.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Node Test 3 | License : see LICENSE 4 | Description : Test suit for primitive Node.hs 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | cabal.project.local~ 21 | .HTF/ 22 | .ghc.environment.* 23 | # cscope files 24 | **/cscope.out 25 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/Node.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Node Test 3 | License : see LICENSE 4 | Description : Test suit for primitive Node.hs 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module PrimitiveTest.Node where 10 | 11 | -- start def 12 | import Primitive.Definition.Node 13 | import Primitive.Instance.Node 14 | -- end def 15 | -------------------------------------------------------------------------------- /edition-helper/src/Io/ProjectLayout.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Make project layout 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Io.ProjectLayout where 10 | 11 | import Control.Monad ( mapM ) 12 | import System.Directory ( createDirectory ) 13 | import System.FilePath ( FilePath (..), addExtension, combine ) 14 | import System.IO 15 | 16 | --makeDirs :: [String] -> [IO ()] 17 | -------------------------------------------------------------------------------- /edition-helper/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 524804 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/16.yaml 11 | sha256: 4d1519a4372d051d47a5eae2241cf3fb54e113d7475f89707ddb6ec06add2888 12 | original: lts-14.16 13 | -------------------------------------------------------------------------------- /edition-helper/src/Control/Pure/NodeInfo.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : NodeInfo Control 3 | License : see LICENSE 4 | Description : ModuleInfo.hs maker 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Control.Pure.NodeInfo 10 | () 11 | where 12 | 13 | 14 | import Control.Pure.NodeAttr 15 | ( makeNodeAttrFromIdTupleStringMap 16 | , makeNodeAttrFromIdTupleTextMap 17 | , makeNodeAttrFromStringMap 18 | , makeNodeAttrFromTextMap 19 | ) 20 | import Control.Pure.NodeId 21 | ( makeNodeIdFromIdTuple, makeNodeIdFromString, makeNodeIdFromText ) 22 | -------------------------------------------------------------------------------- /edition-helper/src/FunctionDef/Matcher.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Matcher.hs 3 | License : see LICENSE 4 | Description : Contains typeclasses that are related to matching primitives 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module FunctionDef.Matcher 10 | ( MatchModel(..) 11 | ) 12 | where 13 | 14 | -- | 'MatchModel' class outlines methods to match model to given field 15 | class MatchModel model where 16 | -- | 'isSame' checks if the other value is same 17 | isSame :: model -> model -> Bool 18 | 19 | -- | 'contains' checks if the other value is contained by model 20 | contains :: model -> model -> Bool 21 | -------------------------------------------------------------------------------- /edition-helper/docs/docstructure.json: -------------------------------------------------------------------------------- 1 | { 2 | "Graph": [{ 3 | "NodeGroup": [ 4 | ["int", 12], 5 | ["float", 2.53] 6 | ["container", { 7 | "NodeInfo": { 8 | "id": "idstr", 9 | "type": "type str", 10 | "attr": { 11 | "key": "val", 12 | "key2": "val2" 13 | } 14 | }, 15 | "Data": { 16 | "NodeGroup": [] 17 | } 18 | }] 19 | ] 20 | }, 21 | { 22 | "NodeGroup": [] 23 | } 24 | ] 25 | } 26 | -------------------------------------------------------------------------------- /edition-helper/src/FunctionDef/Modifier.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Modifier.hs 3 | License : see LICENSE 4 | Description : Contains typeclasses that are related to modifying primitives 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module FunctionDef.Modifier 10 | ( 11 | ReplaceField(..) 12 | , Add2Field(..) 13 | ) 14 | where 15 | 16 | import Primitive.Definition.Node ( NField ) 17 | 18 | -- | 'ReplaceField' class outlines methods to replace model info fields 19 | class ReplaceField model where 20 | 21 | -- |'replaceField' replaces a field of model 22 | replaceField :: model -> NField -> model 23 | 24 | -- | 'Add2Field' class outlines methods to add new value to given field 25 | class (ReplaceField model) => Add2Field model where 26 | insertField :: model -> NField -> Bool -> model 27 | -------------------------------------------------------------------------------- /edition-helper/src/FunctionDef/Transformer.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Transformer 3 | License : see LICENSE 4 | Description : Regroups classes that transforms models into native data types 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module FunctionDef.Transformer 10 | ( NodeIdType2Text(..) 11 | , Model2Map(..) 12 | , Model2IdTuple(..) 13 | ) 14 | where 15 | 16 | -- start def 17 | 18 | import FunctionDef.Setter ( Map2Primitive ) 19 | 20 | -- end def 21 | 22 | import Data.Map.Strict ( Map ) 23 | import Data.Text ( Text ) 24 | 25 | class NodeIdType2Text model where 26 | toText :: model -> Text 27 | 28 | class Model2IdTuple model where 29 | toIdTuple :: model -> (Text, model) 30 | 31 | class (Map2Primitive model) => Model2Map model where 32 | toTextMap :: model -> Map Text Text 33 | -------------------------------------------------------------------------------- /edition-helper/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for edition-helper 2 | 3 | ## Unreleased changes 4 | 5 | - Io is not yet done 6 | - MVC architecture not completely implemented 7 | - Unit and Container Model do not decompose to native structures 8 | - UnitData and ContainerData do not decompose to native structures 9 | 10 | ## [0.2.0] - 2019-12-09 11 | 12 | - Underlaying structure extended. 13 | - A simple io function is implemented in Main.hs 14 | - Tests are started 15 | - ControlUtils start to have typeclasses for most common functionality 16 | 17 | ## Known 18 | 19 | - Does not compile yet, some implementations in typeclass is preventing 20 | compilation. I might change the underlaying implementation for models, to 21 | cope with it. 22 | 23 | ## [0.1.0] - 2019-12-07 24 | 25 | - New module structure conforming to mvc pattern 26 | - Primitives also decompose to native data types like string through the use 27 | of type classes. 28 | - 29 | -------------------------------------------------------------------------------- /edition-helper/src/Utils/XmlUtils.hs: -------------------------------------------------------------------------------- 1 | module Utils.XmlUtils 2 | ( makeName 3 | , makeTagName 4 | ) 5 | where 6 | import Data.Text ( Text, empty, pack ) 7 | import Text.XML 8 | ( Element, Name (..), Node, nameLocalName, nameNamespace, namePrefix ) 9 | -- | 'makeName' make an xml name from a text 10 | makeName :: Text -> Name 11 | 12 | makeName myText 13 | | myText == empty = Name { nameLocalName = pack "name" 14 | , nameNamespace = Nothing 15 | , namePrefix = Nothing 16 | } 17 | | otherwise = Name { nameLocalName = myText 18 | , nameNamespace = Nothing 19 | , namePrefix = Nothing 20 | } 21 | 22 | -- | 'makeTagName' make a xml tag from a text 23 | makeTagName :: Text -> Text -> Name 24 | 25 | makeTagName tagName eltype | empty == tagName = makeName eltype 26 | | otherwise = makeName tagName 27 | -------------------------------------------------------------------------------- /edition-helper/src/Primitive/Instance/NodeType.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : NodeId 3 | License : see LICENSE 4 | Description : NodeType primitive implements function definitions 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Primitive.Instance.NodeType 10 | ( NodeType 11 | ) 12 | where 13 | 14 | -- start def 15 | import Primitive.Definition.Node ( NodeType (TextTypeCons) ) 16 | -- end def 17 | 18 | -- start fn 19 | import FunctionDef.Setter ( IdTuple2Node (fromTupleString) ) 20 | import FunctionDef.Transformer 21 | ( Model2IdTuple (toIdTuple), NodeIdType2Text (toText) ) 22 | -- end fn 23 | 24 | -- start utility 25 | import Data.Text ( Text, pack, unpack ) 26 | -- end utility 27 | 28 | -- start setter 29 | 30 | 31 | -- end setter 32 | 33 | -- start transformer 34 | instance NodeIdType2Text NodeType where 35 | toText (TextTypeCons txt) = txt 36 | 37 | instance Model2IdTuple NodeType where 38 | toIdTuple mid = (pack "type", mid) 39 | -- end transformer 40 | -------------------------------------------------------------------------------- /edition-helper/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Main entry point to program 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Main where 10 | 11 | import Lib 12 | import System.Directory ( listDirectory ) 13 | import System.FilePath ( combine 14 | , FilePath(..) 15 | ) 16 | import Control.Monad ( mapM ) 17 | 18 | showDirContent :: [FilePath] -> IO [()] 19 | showDirContent contents = do 20 | mapM putStrLn contents 21 | 22 | main :: IO () 23 | main = do 24 | putStrLn "Enter project directory: " 25 | dataDirPath <- getLine 26 | contents <- listDirectory dataDirPath 27 | putStrLn "Here are the contents of the directory: " 28 | showDirContent contents 29 | putStrLn "Choose an action from the list below: " 30 | putStrLn " - Add a new field (a)" 31 | putStrLn " - Validate document structure (v)" 32 | putStrLn " - Label document part (l)" 33 | putStrLn " - Translate document part (t)" 34 | putStrLn " - Make ids for document part (m)" 35 | putStrLn " - Replace ids (r)" 36 | choice <- getLine 37 | putStrLn "Done" 38 | -------------------------------------------------------------------------------- /edition-helper/src/Primitive/Instance/Node.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Node.hs 3 | License : see LICENSE 4 | Description : Node instance 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | 10 | module Primitive.Instance.Node 11 | where 12 | 13 | -- start def 14 | import Primitive.Definition.Error ( NodeError ) 15 | import Primitive.Definition.Node ( Container ) 16 | import qualified Primitive.Definition.Node as PN ( PreNode (..) ) 17 | import qualified Primitive.Definition.Node as N ( Node (..) ) 18 | -- end def 19 | 20 | -- start fn 21 | import qualified FunctionDef.Setter as D2N ( Data2Node (..) ) 22 | -- end fn 23 | 24 | -- start utility 25 | import Data.Text ( Text ) 26 | -- end utility 27 | 28 | instance D2N.Data2Node N.Node where 29 | fromPreNode (PN.PreNodeInt nodeData) = Right ( N.NodeInt nodeData) 30 | fromPreNode (PN.PreNodeInteger nodeData) = Right ( N.NodeInteger nodeData) 31 | fromPreNode (PN.PreNodeFloat nodeData) = Right ( N.NodeFloat nodeData) 32 | fromPreNode (PN.PreNodeDouble nodeData) = Right ( N.NodeDouble nodeData) 33 | fromPreNode (PN.PreNodeBool nodeData) = Right ( N.NodeBool nodeData) 34 | fromPreNode (PN.PreNodeText nodeData) = Right ( N.NodeText nodeData) 35 | fromPreNode (PN.PreNodeEmpty nodeData) = Right ( N.NodeEmpty nodeData) 36 | fromContainer ncont = Right (N.NodeContainer ncont) 37 | -------------------------------------------------------------------------------- /edition-helper/package.yaml: -------------------------------------------------------------------------------- 1 | name: edition-helper 2 | version: 0.1.0.0 3 | github: "D-K-E/edition-helper-haskell" 4 | license: BSD3 5 | author: "Kaan Eraslan" 6 | maintainer: "example@example.com" 7 | copyright: "2019 Kaan Eraslan" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - xml-conduit 25 | - xml-hamlet 26 | - containers 27 | - text 28 | - filepath 29 | - directory 30 | - hspec 31 | - hspec-contrib 32 | 33 | library: 34 | source-dirs: src 35 | 36 | executables: 37 | edition-helper-exe: 38 | main: Main.hs 39 | source-dirs: app 40 | ghc-options: 41 | - -threaded 42 | - -rtsopts 43 | - -with-rtsopts=-N 44 | dependencies: 45 | - edition-helper 46 | 47 | tests: 48 | edition-helper-test: 49 | main: Spec.hs 50 | source-dirs: test 51 | ghc-options: 52 | - -threaded 53 | - -rtsopts 54 | - -with-rtsopts=-N 55 | dependencies: 56 | - edition-helper 57 | -------------------------------------------------------------------------------- /edition-helper/src/Primitive/Instance/NodeId.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : NodeId 3 | License : see LICENSE 4 | Description : NodeId primitive implements function definitions 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | 10 | module Primitive.Instance.NodeId 11 | ( NodeId 12 | ) 13 | where 14 | 15 | -- start def 16 | import Primitive.Definition.Node ( NodeId(TextIdCons) ) 17 | -- end def 18 | 19 | -- start fn 20 | import FunctionDef.Transformer ( NodeIdType2Text(toText) 21 | , Model2IdTuple(toIdTuple) 22 | ) 23 | import FunctionDef.Matcher ( MatchModel(isSame, contains) ) 24 | -- end fn 25 | 26 | -- start utility 27 | import Data.Text ( Text 28 | , pack 29 | , unpack 30 | , isInfixOf 31 | ) 32 | -- end utility 33 | 34 | -- start setter 35 | 36 | -- end setter 37 | 38 | -- start transformer 39 | 40 | instance NodeIdType2Text NodeId where 41 | toText (TextIdCons txt) = txt 42 | 43 | instance Model2IdTuple NodeId where 44 | toIdTuple mid = (pack "id", mid) 45 | 46 | -- end transformer 47 | 48 | -- start match 49 | instance MatchModel NodeId where 50 | isSame (TextIdCons txt1) (TextIdCons txt2) = txt1 == txt2 51 | contains (TextIdCons txt1) (TextIdCons txt2) = txt2 `isInfixOf` txt1 52 | 53 | -- end match 54 | -------------------------------------------------------------------------------- /edition-helper/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2019 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /edition-helper/src/View/XmlRenderer.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : XmlRenderer renders models as xml 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module View.XmlRenderer where 10 | 11 | -- start def 12 | 13 | -- end def 14 | 15 | 16 | -- start fn 17 | {- 18 | -- | transform model to xml node 19 | class Model2XmlNode model where 20 | toNode :: model -> Node 21 | 22 | 23 | -- | transform model to xml element 24 | class Model2XmlElement model where 25 | toElement :: model -> Element 26 | 27 | -- instances 28 | instance Model2XmlNode UnitData where 29 | toNode (TextUnitDataCons aMdl) = NodeContent aMdl 30 | toNode (StringUnitDataCons aMdl) = NodeContent (pack aMdl) 31 | 32 | -- transform unit model to xml 33 | 34 | instance Model2XmlElement Um.UnitModel where 35 | toElement um = Element 36 | { elementName = makeName (pack "unit") 37 | , elementAttributes = convertTxt2NameMap 38 | (VUtils.toTextMap (Um.modelInfo um)) 39 | , elementNodes = [NodeContent (VUtils.toText (Um.modelData um))] 40 | } 41 | 42 | 43 | -- transform container model to xml 44 | instance Model2XmlElement Cm.ContainerModel where 45 | toElement cm = Element 46 | { elementName = makeName (pack "container") 47 | , elementAttributes = convertTxt2NameMap 48 | (VUtils.toTextMap (Cm.modelInfo cm)) 49 | , elementNodes = map (NodeElement . toElement) (Cm.modelData cm) 50 | } 51 | 52 | -- transform container data to xml 53 | instance Model2XmlElement Cm.ContainerData where 54 | toElement (CModel cm) = toElement cm 55 | toElement (UModel um) = toElement um 56 | -} 57 | -------------------------------------------------------------------------------- /edition-helper/src/Primitive/Instance/NodeAttr.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : NodeId 3 | License : see LICENSE 4 | Description : NodeAttr primitive implements function definitions 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Primitive.Instance.NodeAttr 10 | ( NodeAttr 11 | ) 12 | where 13 | 14 | -- start def 15 | import Primitive.Definition.Error ( IdTupleValueError 16 | , MapValueError(..) 17 | , TextValueError 18 | ) 19 | import Primitive.Definition.Node ( NodeAttr(TextAttrCons) ) 20 | -- end def 21 | 22 | -- start fn 23 | import FunctionDef.Setter ( Map2Primitive(fromTextMap) 24 | ) 25 | import FunctionDef.Transformer ( Model2IdTuple(toIdTuple) 26 | , Model2Map(toTextMap) 27 | ) 28 | -- end fn 29 | 30 | -- start utility 31 | import Data.Map.Strict ( Map ) 32 | import Data.Text ( Text ) 33 | import Utils.MapUtils ( convertStringMap2Txt 34 | , convertTxtMap2String 35 | ) 36 | -- end utility 37 | 38 | -- setter 39 | 40 | instance Map2Primitive NodeAttr where 41 | fromTextMap amap = Right (TextAttrCons amap) 42 | 43 | -- end setter 44 | -- transformer 45 | 46 | instance Model2Map NodeAttr where 47 | toTextMap (TextAttrCons amap) = amap 48 | 49 | -- end transformer 50 | -------------------------------------------------------------------------------- /edition-helper/test/UtilsTest/XmlUtilsSpec.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for xml utilities 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | 10 | module UtilsTest.XmlUtilsSpec where 11 | 12 | import Utils.XmlUtils ( makeName 13 | , makeTagName 14 | ) 15 | import Data.Text ( Text 16 | , pack 17 | , empty 18 | , unpack 19 | ) 20 | import Text.XML ( Name(..) ) 21 | import Test.Hspec 22 | main :: IO () 23 | main = hspec $ do 24 | describe "makeName from text" $ do 25 | it "text to Name type text empty" $ makeName (pack "") `shouldBe` Name 26 | { nameLocalName = pack "name" 27 | , nameNamespace = Nothing 28 | , namePrefix = Nothing 29 | } 30 | it "text to Name type text non empty" 31 | $ makeName (pack "myname") 32 | `shouldBe` Name { nameLocalName = pack "myname" 33 | , nameNamespace = Nothing 34 | , namePrefix = Nothing 35 | } 36 | describe "makeTagName test" $ do 37 | it "make tag with empty tag name" 38 | $ makeTagName (pack "") (pack "edition") 39 | `shouldBe` makeName (pack "edition") 40 | 41 | it "make tag with non empty tag name" 42 | $ makeTagName (pack "editag") (pack "edition") 43 | `shouldBe` makeName (pack "editag") 44 | -------------------------------------------------------------------------------- /edition-helper/src/Control/Xml.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Xml interface to primitives 3 | License : see LICENSE 4 | Description : XML interface to primitives 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | 10 | module Control.Xml where 11 | 12 | -- start def 13 | import Primitive.Definition.Container as Cm 14 | ( ContainerData (..), ContainerModel (..) ) 15 | import Primitive.Definition.Error 16 | import Primitive.Definition.NodeAttr ( NodeAttr (..) ) 17 | import Primitive.Definition.NodeId ( NodeId (..) ) 18 | import Primitive.Definition.NodeInfo ( NodeInfo (..) ) 19 | import Primitive.Definition.NodeType ( NodeType (..) ) 20 | import Primitive.Definition.UnitData ( UnitData (..) ) 21 | 22 | import Primitive.Instance.NodeAttr ( NodeAttr ) 23 | import Primitive.Instance.NodeType ( NodeType ) 24 | import Primitive.Instance.UnitData ( UnitData ) 25 | -- end def 26 | 27 | -- start fn 28 | 29 | import Control.Pure.NodeAttr ( makeNodeAttrFromTextMap ) 30 | import Control.Pure.NodeId ( makeNodeIdFromIdTuple, makeNodeIdFromText ) 31 | import Control.Pure.NodeType ( makeNodeTypeFromText ) 32 | import Control.Pure.UnitData 33 | ( makeUnitDataFromIdTuple, makeUnitDataFromText ) 34 | import FunctionDef.Transformer 35 | ( Model2Map (toTextMap), NodeIdType2Text (toText) ) 36 | -- end fn 37 | 38 | -- start utilities 39 | import Data.Map.Strict ( Map ) 40 | import Data.Text ( Text, pack, unpack ) 41 | import Text.XML 42 | ( Element (..) 43 | , Name (..) 44 | , Node (..) 45 | , elementAttributes 46 | , elementName 47 | , elementNodes 48 | ) 49 | import Utils.MapUtils ( add2Map, convertTxt2NameMap ) 50 | import Utils.XmlUtils ( makeName, makeTagName ) 51 | -- end utilities 52 | 53 | makeUnitDataFromNode :: Node -> Either TextValueError UnitData 54 | makeUnitDataFromNode (NodeContent txt) = makeUnitDataFromText txt 55 | makeNodeFromUnitData :: UnitData -> Node 56 | makeNodeFromUnitData udata = NodeContent (toText udata) 57 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/Pure/PrimitivePureSpec.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for primitive pure instance spec 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module PrimitiveTest.Pure.PrimitivePureSpec where 10 | 11 | -- start def 12 | import Primitive.Definition.Container ( ContainerModel(..) 13 | , ContainerData(..) 14 | ) 15 | import Primitive.Definition.NodeAttr ( NodeAttr(..) ) 16 | import Primitive.Definition.NodeType ( NodeType(..) ) 17 | import Primitive.Definition.ModelData ( ModelData(..) ) 18 | import Primitive.Definition.NodeInfo ( NodeInfo(..) ) 19 | import Primitive.Definition.Unit ( UnitModel(..) ) 20 | import Primitive.Definition.UnitData ( UnitData(..) ) 21 | 22 | import Primitive.Definition.Container ( ContainerModel(..) 23 | , ContainerData(..) 24 | ) 25 | import Primitive.Instance.NodeAttr 26 | ( NodeAttr(..) ) 27 | import Primitive.Instance.NodeType 28 | ( NodeType(..) ) 29 | import Primitive.Instance.ModelData 30 | ( ModelData(..) ) 31 | import Primitive.Instance.NodeInfo 32 | ( NodeInfo(..) ) 33 | import Primitive.Instance.Unit ( UnitModel(..) ) 34 | import Primitive.Instance.UnitData 35 | ( UnitData(..) ) 36 | -- end def 37 | 38 | -- start fn 39 | 40 | import FunctionDef.Setter 41 | import FunctionDef.Transformer 42 | import FunctionDef.Matcher 43 | import FunctionDef.Modifier 44 | 45 | -- end fn 46 | 47 | import Test.Hspec 48 | -------------------------------------------------------------------------------- /edition-helper/src/Utils/StrUtils.hs: -------------------------------------------------------------------------------- 1 | module Utils.StrUtils 2 | ( toLowerStr 3 | , isAlphaNumStr 4 | , isAsciiStr 5 | , toLowerTxt 6 | , isAlphaNumText 7 | , isAsciiTxt 8 | , appendOrPrepend 9 | , concatHStr 10 | , concatTStr 11 | , toTxtList 12 | ) 13 | where 14 | 15 | 16 | import qualified Data.Char as Chr 17 | import Data.Text ( Text 18 | , pack 19 | , toLower 20 | , unpack 21 | ) 22 | 23 | 24 | -- |'concatHStr' concatenates the string to the head of the text 25 | concatHStr :: String -> Text -> Text 26 | concatHStr str txt = pack (str ++ (unpack txt)) 27 | 28 | -- |'concatTStr' concatenates the string to the tail of the text 29 | concatTStr :: Text -> String -> Text 30 | concatTStr txt str = pack ((unpack txt) ++ str) 31 | 32 | -- |'toLowerStr' transform all characters to lower characters 33 | toLowerStr = map Chr.toLower 34 | 35 | -- |'toLowerTxt' transform all characters to lower characters for Text 36 | toLowerTxt :: Text -> Text 37 | toLowerTxt = toLower 38 | 39 | toTxtList :: [String] -> [Text] 40 | toTxtList strlst = map pack strlst 41 | 42 | -- |'isAlphaNumStr' checks if all characters are alphanumeric 43 | isAlphaNumStr :: String -> Bool 44 | isAlphaNumStr = all Chr.isAlphaNum 45 | 46 | -- |'isAlphaNumText' checks if all characters are alphanumeric for Text 47 | isAlphaNumText :: Text -> Bool 48 | isAlphaNumText atxt = (isAlphaNumStr . unpack) atxt 49 | 50 | -- |'isAsciiStr' checks if all characters are ascii 51 | isAsciiStr :: String -> Bool 52 | isAsciiStr = all Chr.isAscii 53 | 54 | isAsciiTxt :: Text -> Bool 55 | isAsciiTxt txt = (isAsciiStr . unpack) txt 56 | 57 | -- |'appendOrPrepend' adds str2 either at the start or at the end of str1 58 | appendOrPrepend :: String -> String -> Bool -> String 59 | appendOrPrepend str1 str2 isAppend | isAppend = str1 ++ "-" ++ str2 60 | | otherwise = str2 ++ "-" ++ str1 61 | -------------------------------------------------------------------------------- /edition-helper/test/UtilsTest/StrUtilsSpec.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for string utilities 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module UtilsTest.StrUtilsSpec where 10 | import Utils.StrUtils ( toLowerStr 11 | , isAlphaNumStr 12 | , isAsciiStr 13 | , appendOrPrepend 14 | ) 15 | import Test.Hspec 16 | 17 | main :: IO () 18 | main = hspec $ do 19 | describe "to lower string, toLowerStr" $ do 20 | it "should transform to lower case when arg contains upper case" 21 | $ toLowerStr "EdiTion" 22 | `shouldBe` "edition" 23 | 24 | 25 | it "should return str as is if arg is lower case" 26 | $ toLowerStr "edition" 27 | `shouldBe` "edition" 28 | 29 | describe "check alphanumeric string isAlphaNumStr" $ do 30 | it "if arg is alphanumeric should return true" 31 | $ isAlphaNumStr "e13di3500tion" 32 | `shouldBe` True 33 | 34 | it "if arg is not alphanumeric should return false" 35 | $ isAlphaNumStr "e;,$13di3500tion" 36 | `shouldBe` False 37 | 38 | 39 | describe "check string isAsciiStr" $ do 40 | it "if arg is ascii should return true" 41 | $ isAsciiStr "e13di3500tion" 42 | `shouldBe` True 43 | 44 | it "if arg is not ascii should return false" 45 | $ isAsciiStr "eḫ13di3500tion" 46 | `shouldBe` False 47 | 48 | describe "append or prepend strings" $ do 49 | it "if bool arg is true it should append" 50 | $ appendOrPrepend "edition" "note" True 51 | `shouldBe` "edition-note" 52 | 53 | it "if bool arg is false it should prepend" 54 | $ appendOrPrepend "edition" "note" False 55 | `shouldBe` "note-edition" 56 | -------------------------------------------------------------------------------- /edition-helper/src/Utils/MapUtils.hs: -------------------------------------------------------------------------------- 1 | module Utils.MapUtils 2 | ( add2Map 3 | , convertTxt2NameMap 4 | , convertStringKey 5 | , convertStringVal 6 | , convertTxtKey 7 | , convertTxtVal 8 | , convertStringMap2Txt 9 | , convertTxtMap2String 10 | ) 11 | where 12 | import Data.Map.Strict ( Map ) 13 | import qualified Data.Map.Strict as Dict 14 | import Data.Text ( Text ) 15 | import qualified Data.Text as Txt 16 | import Text.XML ( Name ) 17 | import Utils.XmlUtils ( makeName ) 18 | 19 | -- |'add2Map' adds [(key, val)] to map by transforming the list to map 20 | -- then making a union with the resulting map 21 | add2Map :: Map Text Text -> [(Text, Text)] -> Map Text Text 22 | 23 | add2Map aMap kvs | null kvs = aMap 24 | | otherwise = Dict.union aMap (Dict.fromList kvs) 25 | 26 | -- Map functions 27 | 28 | -- |'convertTxt2NameMap' converts the key of the map from Data.Text to Xml.Name 29 | convertTxt2NameMap :: Map Text Text -> Map Name Text 30 | convertTxt2NameMap = Dict.mapKeys makeName 31 | 32 | -- |'convertStringKey' changes string key of the map to Data.Text 33 | convertStringKey :: Map String Text -> Map Text Text 34 | convertStringKey = Dict.mapKeys Txt.pack 35 | 36 | -- |'convertStringVal' changes string val of the map to Data.Text 37 | convertStringVal :: Map Text String -> Map Text Text 38 | convertStringVal = Dict.map Txt.pack 39 | 40 | -- |'convertTxtKey' changes Data.Text key of the map to string 41 | convertTxtKey :: Map Text String -> Map String String 42 | convertTxtKey = Dict.mapKeys Txt.unpack 43 | 44 | -- |'convertTxtVal' changes Data.Text val of the map to string 45 | convertTxtVal :: Map String Text -> Map String String 46 | convertTxtVal = Dict.map Txt.unpack 47 | 48 | -- |'convertStringMap2Txt' change string key val of the map to Data.Text 49 | convertStringMap2Txt :: Map String String -> Map Text Text 50 | convertStringMap2Txt aMap = Dict.map Txt.pack (Dict.mapKeys Txt.pack aMap) 51 | 52 | -- |'convertTxtMap2String' change Data.Text key val of the map to string 53 | convertTxtMap2String :: Map Text Text -> Map String String 54 | convertTxtMap2String aMap = Dict.map Txt.unpack (Dict.mapKeys Txt.unpack aMap) 55 | -------------------------------------------------------------------------------- /edition-helper/src/FunctionDef/Setter.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Setter.hs 3 | License : see LICENSE 4 | Description : Setter regroups classes that sets data to primitives 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module FunctionDef.Setter 10 | (Map2Primitive(..) 11 | , Data2Node(..) 12 | , IdTuple2Node(..) 13 | ) 14 | where 15 | 16 | -- start def 17 | 18 | -- end def 19 | import Primitive.Definition.Error 20 | ( IdTupleValueError, MapValueError, NodeError, TextValueError ) 21 | import Primitive.Definition.Node ( Container, PreNode ) 22 | 23 | -- start fn 24 | 25 | -- end fn 26 | 27 | -- start utility 28 | import Data.Map.Strict ( Map ) 29 | import Data.Text ( Text, pack, unpack ) 30 | import Utils.MapUtils 31 | ( convertStringKey 32 | , convertStringMap2Txt 33 | , convertStringVal 34 | , convertTxtMap2String 35 | ) 36 | -- end utility 37 | 38 | class Data2Node model where 39 | fromPreNode :: PreNode -> Either NodeError model 40 | fromContainer :: Container -> Either NodeError model 41 | 42 | class Map2Primitive model where 43 | fromStringMap :: Map String String -> Either MapValueError model 44 | fromTextMap :: Map Text Text -> Either MapValueError model 45 | fromMixedStrMap :: Map String Text -> Either MapValueError model 46 | fromMixedTextMap :: Map Text String -> Either MapValueError model 47 | 48 | fromMixedStrMap aMap = fromTextMap (convertStringKey aMap) 49 | fromMixedTextMap aMap = fromTextMap (convertStringVal aMap) 50 | fromStringMap aMap = fromTextMap (convertStringMap2Txt aMap) 51 | 52 | class (Data2Node model) => IdTuple2Node model where 53 | fromTupleString :: (String, String) -> Either IdTupleValueError model 54 | fromTupleText :: (String, Text) -> Either IdTupleValueError model 55 | fromTupleInt :: (String, Int) -> Either IdTupleValueError model 56 | fromTupleInteger :: (String, Integer) -> Either IdTupleValueError model 57 | fromTupleFloat :: (String, Float) -> Either IdTupleValueError model 58 | fromTupleDouble :: (String, Double) -> Either IdTupleValueError model 59 | fromTupleBool :: (String, Bool) -> Either IdTupleValueError model 60 | fromTupleEmpty :: (String, Text) -> Either IdTupleValueError model 61 | fromTupleContainer :: (String, Container) -> Either IdTupleValueError model 62 | -------------------------------------------------------------------------------- /edition-helper/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-14.16 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | # extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=2.1" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /edition-helper/src/Primitive/Definition/Node.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Node model 3 | License : see LICENSE 4 | Description : Node primitive 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Primitive.Definition.Node 10 | ( Node(..) 11 | , NodeInfo(..) 12 | , NodeId(..) 13 | , NodeType(..) 14 | , NodeAttr(..) 15 | , PreNode(..) 16 | , Container(..) 17 | , NField(..) 18 | ) 19 | where 20 | 21 | -- start utilities 22 | import Data.Map.Strict ( Map ) 23 | import Data.Text ( Text, empty, pack ) 24 | 25 | -- end utilities 26 | 27 | -- | node id: alphanumeric non empty string has to be unique for each model 28 | newtype NodeId = TextIdCons Text 29 | deriving (Eq, Show, Ord) 30 | 31 | -- | node type: edition, inflected, glossary it can be constructed from string 32 | newtype NodeType = TextTypeCons Text 33 | deriving (Eq, Show, Ord) 34 | 35 | -- | node attribute: unique key value non nested pairs 36 | newtype NodeAttr = TextAttrCons (Map Text Text) 37 | deriving (Eq, Show, Ord) 38 | 39 | -- | node info: contains meta data with regard to unit/container model 40 | data NodeInfo = InfoCons { 41 | nodeId :: NodeId 42 | , nodeType :: NodeType 43 | , nodeAttr :: NodeAttr 44 | } deriving (Eq, Show, Ord) 45 | 46 | 47 | data PreNode = PreNodeInt Int 48 | | PreNodeInteger Integer 49 | | PreNodeFloat Float 50 | | PreNodeDouble Double 51 | | PreNodeBool Bool 52 | | PreNodeText Text 53 | | PreNodeEmpty Text 54 | deriving (Eq, Ord, Show) 55 | 56 | -- | Node data: node that can contain couple of types 57 | data Node = NodeInt Int 58 | | NodeInteger Integer 59 | | NodeFloat Float 60 | | NodeDouble Double 61 | | NodeBool Bool 62 | | NodeText Text 63 | | NodeEmpty Text 64 | | NodeContainer Container 65 | deriving(Eq, Ord, Show) 66 | 67 | newtype NodeGroup = NodeGroupCons [Node] deriving (Eq, Ord, Show) 68 | 69 | data NField = IdField NodeId 70 | | TypeField NodeType 71 | | AttrField NodeAttr 72 | | NodeField Node 73 | | NodeInfoField NodeInfo 74 | | NodeGroupField NodeGroup 75 | deriving (Eq, Show, Ord) 76 | 77 | data Container = ContainerCons { 78 | cinfo :: NodeInfo 79 | , cdata :: NodeGroup 80 | } deriving (Eq, Show, Ord) 81 | 82 | newtype Graph = GraphCons [NodeGroup] deriving (Eq, Ord, Show) 83 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/Pure/ModelType.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for primitive model type instance spec 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | 10 | module PrimitiveTest.Pure.NodeType where 11 | 12 | -- start def 13 | import Primitive.Definition.NodeType ( NodeType(..) ) 14 | import Primitive.Instance.NodeType 15 | ( NodeType(..) ) 16 | -- end def 17 | -- start fn 18 | 19 | import FunctionDef.Setter ( Text2NodeIdType(..) 20 | , IdTuple2Node(..) 21 | ) 22 | import FunctionDef.Transformer ( NodeIdType2Text(..) 23 | , Model2IdTuple(..) 24 | ) 25 | 26 | -- end fn 27 | 28 | import Data.Text ( Text 29 | , pack 30 | , unpack 31 | ) 32 | 33 | import Test.Hspec 34 | 35 | mtype = StringTypeCons "edition" 36 | 37 | 38 | main :: IO () 39 | main = hspec $ do 40 | describe "NodeType setter test" $ do 41 | it "Set model type from string" $ fromString "edition" `shouldBe` mtype 42 | it "Set Model type from Text" 43 | $ fromText (pack "edition") 44 | `shouldBe` mtype 45 | 46 | it "Set Model Type from IdTuple2Node fromTupleString" 47 | $ fromTupleString ("type", "edition") 48 | `shouldBe` mtype 49 | 50 | it "Set Model Type from IdTuple2Node fromTupleText" 51 | $ fromTupleText ("type", pack "edition") 52 | `shouldBe` mtype 53 | 54 | describe "NodeType transformer test" $ do 55 | it "NodeIdType2Text transform model type to string" 56 | $ toString mtype 57 | `shouldBe` "edition" 58 | 59 | it "NodeIdType2Text transform model type to Text" 60 | $ toText mtype 61 | `shouldBe` pack "edition" 62 | 63 | it "Model2IdTuple transform model type to string NodeId tuple" 64 | $ toIdTuple mtype 65 | `shouldBe` ("type", mtype) 66 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/Pure/ModelId.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : NodeIdSpec 3 | License : see LICENSE 4 | Description : Test suit for primitive model id pure instance spec 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | 10 | module PrimitiveTest.Pure.NodeId where 11 | 12 | -- start def 13 | import Primitive.Definition.NodeId ( NodeId(..) ) 14 | import Primitive.Instance.NodeId 15 | ( NodeId(..) ) 16 | -- end def 17 | -- start fn 18 | 19 | import FunctionDef.Setter ( Text2NodeIdType(..) 20 | , IdTuple2Node(..) 21 | ) 22 | import FunctionDef.Transformer ( NodeIdType2Text(..) 23 | , Model2IdTuple(..) 24 | ) 25 | import FunctionDef.Matcher 26 | import FunctionDef.Modifier 27 | 28 | -- end fn 29 | 30 | import Data.Text ( Text 31 | , pack 32 | , unpack 33 | ) 34 | 35 | import Test.Hspec 36 | 37 | mid = StringIdCons "small-id-12" 38 | 39 | 40 | main :: IO () 41 | main = hspec $ do 42 | describe "NodeId setter test" $ do 43 | it "Set model id from string" $ fromString "small-id-12" `shouldBe` mid 44 | it "Set Model id from Text" 45 | $ fromText (pack "small-id-12") 46 | `shouldBe` mid 47 | 48 | it "Set Model Id from IdTuple2Node fromTupleString" 49 | $ fromTupleString ("id", "small-id-12") 50 | `shouldBe` mid 51 | 52 | it "Set Model Id from IdTuple2Node fromTupleText" 53 | $ fromTupleText ("id", pack "small-id-12") 54 | `shouldBe` mid 55 | 56 | describe "NodeId transformer test" $ do 57 | it "NodeIdType2Text transform model id to string" 58 | $ toString mid 59 | `shouldBe` "small-id-12" 60 | 61 | it "NodeIdType2Text transform model id to Text" 62 | $ toText mid 63 | `shouldBe` pack "small-id-12" 64 | 65 | it "Model2IdTuple transform model id to string NodeId tuple" 66 | $ toIdTuple mid 67 | `shouldBe` ("id", mid) 68 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/Pure/UnitData.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for primitive unit data pure instance spec 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module PrimitiveTest.Pure.UnitData where 10 | 11 | -- start def 12 | import Primitive.Definition.UnitData ( UnitData(..) ) 13 | import Primitive.Instance.UnitData 14 | ( UnitData(..) ) 15 | -- end def 16 | 17 | -- start fn 18 | import FunctionDef.Setter ( Text2NodeIdType 19 | ( fromString 20 | , fromText 21 | ) 22 | , IdTuple2Node(..) 23 | ) 24 | import FunctionDef.Transformer ( NodeIdType2Text 25 | ( toString 26 | , toText 27 | ) 28 | , Model2IdTuple(toIdTuple) 29 | ) 30 | -- end fn 31 | -- start utility 32 | import Data.Text ( Text 33 | , unpack 34 | , pack 35 | ) -- importing type 36 | -- end utility 37 | import Test.Hspec 38 | 39 | udata = StringUnitDataCons "mydata" 40 | 41 | utpli = ("data-unit", udata) 42 | 43 | utpls = ("data-unit", "mydata") 44 | utplt = ("data-unit", pack "mydata") 45 | 46 | main :: IO () 47 | main = hspec $ do 48 | describe "Text2NodeIdType tests" $ do 49 | it "fromString test" $ fromString "mydata" `shouldBe` udata 50 | it "fromText test" $ fromText (pack "mydata") `shouldBe` udata 51 | describe "IdTuple2Node tests" $ do 52 | it "fromTupleString test" $ fromTupleString utpls `shouldBe` udata 53 | it "fromTupleText test" $ fromTupleText utplt `shouldBe` udata 54 | describe "NodeIdType2Text tests" $ do 55 | it "toString test" $ toString udata `shouldBe` "mydata" 56 | it "toText test" $ toText udata `shouldBe` pack "mydata" 57 | describe "Model2IdTuple tests" $ do 58 | it "toIdTuple test" $ toIdTuple udata `shouldBe` utpli 59 | -------------------------------------------------------------------------------- /edition-helper/src/Control/NodeId.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : NodeId.hs monadic maker 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Control.NodeId 10 | ( makeNodeIdFromText 11 | , makeNodeIdFromIdTuple 12 | ) 13 | where 14 | 15 | -- start def 16 | import FunctionDef.Setter ( IdTuple2Node(fromTupleString) 17 | ) 18 | import Primitive.Definition.Error ( IdTupleValueError(..) 19 | , TextValueError(..) 20 | ) 21 | import Primitive.Instance.NodeId 22 | import Primitive.Definition.Node ( NodeId(TextIdCons) ) 23 | -- end def 24 | import Data.Text ( Text 25 | , pack 26 | , unpack 27 | ) 28 | import qualified Data.Text as T 29 | ( null ) 30 | import Utils.StrUtils ( isAlphaNumText 31 | , isAsciiTxt 32 | , concatHStr 33 | , concatTStr 34 | ) 35 | 36 | -- start maker 37 | 38 | -- |'makeNodeIdFromText' makes model id from string using conditions 39 | makeNodeIdFromText :: Text -> Either TextValueError NodeId 40 | makeNodeIdFromText astr 41 | | T.null astr = Left (EmptyText (pack "NodeId")) 42 | | not (isAlphaNumText astr && isAsciiTxt astr) = Left 43 | (NotAsciiAlphanumeric (pack "NodeId")) 44 | | otherwise = Right (TextIdCons astr) 45 | 46 | -- |'makeNodeIdFromIdTuple' make model id from id tuple 47 | makeNodeIdFromIdTuple :: (Text, Text) -> Either IdTupleValueError NodeId 48 | makeNodeIdFromIdTuple (txt1, txt2) 49 | | T.null txt1 50 | = Left (FirstValueError (EmptyText (pack "IdTuple first argument"))) 51 | | txt1 /= pack "id" 52 | = Left 53 | (FirstValueError 54 | (OtherTextError 55 | (concatHStr 56 | "IdTuple first argument has inappropriate value: " 57 | txt1 58 | ) 59 | ) 60 | ) 61 | | txt1 == pack "id" 62 | = let midErr = makeNodeIdFromText txt2 63 | in case midErr of 64 | Left err -> Left (SecondTextValueError err) 65 | Right mid -> Right mid 66 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/Pure/ModelInfo.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for primitive model info pure instance spec 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module PrimitiveTest.Pure.NodeInfo where 10 | 11 | -- start def 12 | import Primitive.Definition.NodeInfo ( NodeInfo(..) ) 13 | import Primitive.Instance.NodeInfo 14 | ( NodeInfo(..) ) 15 | import Primitive.Definition.NodeId ( NodeId(..) ) 16 | import Primitive.Definition.NodeAttr ( NodeAttr(..) ) 17 | import Primitive.Definition.NodeType ( NodeType(..) ) 18 | import Primitive.Instance.NodeId 19 | ( NodeId(..) ) 20 | import Primitive.Instance.NodeAttr 21 | ( NodeAttr(..) ) 22 | import Primitive.Instance.NodeType 23 | ( NodeType(..) ) 24 | -- end def 25 | -- start fn 26 | import FunctionDef.Setter ( Map2Primitive(..) 27 | , TupleMap2Primitive(..) 28 | , InfoTuple2Primitive(..) 29 | ) 30 | import FunctionDef.Transformer ( Model2Map(..) 31 | , Model2IdTuple(..) 32 | , NodeInfo2Tuple(..) 33 | ) 34 | -- end fn 35 | import Data.Text ( Text 36 | , pack 37 | , unpack 38 | ) 39 | import Data.Map.Strict ( Map 40 | , fromList 41 | ) 42 | 43 | import Test.Hspec 44 | 45 | minfo = InfoCons { modelId = StringIdCons "my-id" 46 | , modelType = StringTypeCons "edition" 47 | , modelAttr = StringAttrCons (fromList [("my", "val")]) 48 | } 49 | 50 | tpl = 51 | ( StringIdCons "my-id" 52 | , StringTypeCons "edition" 53 | , StringAttrCons (fromList [("my", "val")]) 54 | ) 55 | 56 | main :: IO () 57 | main = hspec $ do 58 | describe "InfoTuple2Primitive tests" $ do 59 | it "fromInfoTuple test" $ fromInfoTuple tpl `shouldBe` minfo 60 | 61 | describe "NodeInfo2Tuple tests" $ do 62 | it "toInfoTuple test" $ toInfoTuple minfo `shouldBe` tpl 63 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/NodeType.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for primitive node type instance spec 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module PrimitiveTest.NodeType where 10 | 11 | -- start def 12 | import Primitive.Definition.Node ( NodeType(..) ) 13 | import Primitive.Instance.NodeType 14 | -- end def 15 | 16 | -- start fn 17 | 18 | import Control.NodeType ( makeNodeTypeFromIdTuple 19 | , makeNodeTypeFromText 20 | ) 21 | import FunctionDef.Transformer ( Model2IdTuple(..) 22 | , NodeIdType2Text(..) 23 | ) 24 | 25 | -- end fn 26 | import Data.Text ( Text 27 | , pack 28 | , unpack 29 | ) 30 | 31 | 32 | 33 | import Test.Hspec 34 | 35 | mtype = TextTypeCons "edition" 36 | 37 | main :: IO () 38 | main = hspec $ do 39 | describe "NodeType setter test" $ do 40 | it "Set Model type from Text" 41 | $ makeNodeTypeFromText (pack "edition") 42 | `shouldBe` Right mtype 43 | 44 | it "Check for invalid text value" 45 | $ makeNodeTypeFromText (pack "someval") 46 | `shouldBe` Left 47 | (OtherTextError 48 | (pack ("Unsupported type: " ++ "someval")) 49 | ) 50 | 51 | it "Set Model Type from IdTuple2Node" 52 | $ makeNodeTypeFromIdTuple (pack "type", pack "edition") 53 | `shouldBe` Right mtype 54 | 55 | it "Check for bad id value" 56 | $ makeNodeTypeFromIdTuple (pack "tyype", pack "edition") 57 | `shouldBe` Left 58 | (OtherTextError 59 | pack 60 | ("IdTuple first argument has inappropriate value: " 61 | ++ "tyype" 62 | ) 63 | ) 64 | 65 | 66 | describe "NodeType transformer test" $ do 67 | 68 | it "NodeIdType2Text transform model type to Text" 69 | $ toText mtype 70 | `shouldBe` pack "edition" 71 | 72 | it "Model2IdTuple transform model type to string NodeId tuple" 73 | $ toIdTuple mtype 74 | `shouldBe` (pack "type", mtype) 75 | -------------------------------------------------------------------------------- /edition-helper/src/Control/NodeType.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : NodeType.hs monadic maker 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Control.NodeType 10 | ( makeNodeTypeFromText 11 | ) 12 | where 13 | 14 | -- start def 15 | 16 | import Primitive.Definition.Node ( NodeType(..) ) 17 | import Primitive.Definition.Error ( IdTupleValueError(..) 18 | , TextValueError(..) 19 | ) 20 | import Primitive.Instance.NodeType ( NodeType ) 21 | 22 | -- end def 23 | -- start fn 24 | -- end fn 25 | -- start utility 26 | import Data.List ( elem ) 27 | import Data.Text ( Text 28 | , pack 29 | , unpack 30 | ) 31 | import qualified Data.Text as T 32 | ( null ) 33 | import Utils.StrUtils ( concatHStr 34 | , concatTStr 35 | , toLowerTxt 36 | , toTxtList 37 | ) 38 | -- end utility 39 | 40 | -- start maker 41 | makeNodeTypeFromText :: Text -> Either TextValueError NodeType 42 | 43 | makeNodeTypeFromText typeName 44 | | toLowerTxt typeName 45 | `elem` (toTxtList 46 | [ "edition" 47 | , "transliteration" 48 | , "translation" 49 | , "note" 50 | , "info" 51 | , "text" 52 | , "term" 53 | , "glossary" 54 | , "inflected" 55 | , "attestation" 56 | , "lemma" 57 | , "analysis" 58 | ] 59 | ) 60 | = Right (TextTypeCons typeName) 61 | | otherwise 62 | = Left (OtherTextError (concatHStr "Unsupported type: " typeName)) 63 | 64 | 65 | -- |'makeNodeTypeFromIdTuple' make model id from id tuple 66 | makeNodeTypeFromIdTuple :: (Text, Text) -> Either IdTupleValueError NodeType 67 | makeNodeTypeFromIdTuple (txt1, txt2) 68 | | T.null txt1 69 | = Left (FirstValueError (EmptyText (pack "IdTuple first argument"))) 70 | | txt1 /= (pack "type") 71 | = Left 72 | (FirstValueError 73 | (OtherTextError 74 | (concatHStr 75 | "IdTuple first argument has inappropriate value: " 76 | txt1 77 | ) 78 | ) 79 | ) 80 | | txt1 == pack "type" 81 | = let midErr = makeNodeTypeFromText txt2 82 | in case midErr of 83 | Left err -> Left (SecondTextValueError err) 84 | Right mid -> Right mid 85 | -- end maker 86 | -------------------------------------------------------------------------------- /edition-helper/test/PrimitiveTest/Pure/ModelAttr.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for primitive model attribute pure instance spec 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | 10 | module PrimitiveTest.Pure.NodeAttr where 11 | 12 | -- start def 13 | import Primitive.Definition.NodeAttr ( NodeAttr(..) ) 14 | import Primitive.Instance.NodeAttr 15 | ( NodeAttr(..) ) 16 | -- end def 17 | -- start fn 18 | import FunctionDef.Setter ( Map2Primitive(..) 19 | , TupleMap2Primitive(..) 20 | ) 21 | import FunctionDef.Transformer ( Model2Map(..) 22 | , Model2IdTuple(..) 23 | ) 24 | -- end fn 25 | 26 | 27 | import Data.Text ( Text 28 | , pack 29 | , unpack 30 | ) 31 | import Data.Map.Strict ( Map 32 | , fromList 33 | ) 34 | 35 | import Test.Hspec 36 | 37 | mattr = StringAttrCons (fromList [("my", "val")]) 38 | 39 | main :: IO () 40 | main = hspec $ do 41 | describe "Map2Primitive tests" $ do 42 | it "fromStringMap test" 43 | $ fromStringMap (fromList [("my", "val")]) 44 | `shouldBe` mattr 45 | 46 | it "fromTextMap test" 47 | $ fromTextMap (fromList [(pack "my", pack "val")]) 48 | `shouldBe` mattr 49 | it "fromMixedStrMap test" 50 | $ fromMixedStrMap (fromList [("my", pack "val")]) 51 | `shouldBe` mattr 52 | it "fromMixedTextMap test" 53 | $ fromMixedTextMap (fromList [(pack "my", "val")]) 54 | `shouldBe` mattr 55 | 56 | describe "TupleMap2Primitive tests" $ do 57 | it "fromTupleStringMap test" 58 | $ fromTupleStringMap ("mykey", (fromList [("my", "val")])) 59 | `shouldBe` mattr 60 | 61 | it "fromTupleTextMap test" 62 | $ fromTupleTextMap ("mykey", (fromList [(pack "my", pack "val")])) 63 | `shouldBe` mattr 64 | 65 | it "fromTupleMixedStrMap test" 66 | $ fromTupleMixedStrMap ("mykey", (fromList [("my", pack "val")])) 67 | `shouldBe` mattr 68 | 69 | it "fromTupleMixedTextMap test" 70 | $ fromTupleMixedTextMap ("mykey", (fromList [(pack "my", "val")])) 71 | `shouldBe` mattr 72 | 73 | describe "Model2IdTuple tests" $ do 74 | it "toIdTuple test" $ toIdTuple mattr `shouldBe` ("attribute", mattr) 75 | 76 | describe "Model2Map tests" $ do 77 | it "toStringMap test with StringAttrCons" 78 | $ toStringMap mattr 79 | `shouldBe` fromList [("my", "val")] 80 | 81 | it "toStringMap test TextAttrCons" 82 | $ toStringMap (TextAttrCons (fromList [(pack "my", pack "val")])) 83 | `shouldBe` fromList [("my", "val")] 84 | 85 | it "toTextMap test TextAttrCons" 86 | $ toTextMap (TextAttrCons (fromList [(pack "my", pack "val")])) 87 | `shouldBe` fromList [(pack "my", pack "val")] 88 | 89 | it "toTextMap test StringAttrCons" $ toTextMap mattr `shouldBe` fromList 90 | [(pack "my", pack "val")] 91 | -------------------------------------------------------------------------------- /edition-helper/src/Control/Node.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Control.Node.hs 3 | License : see LICENSE 4 | Description : Control functions for Node type 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Control.Node where 10 | 11 | -- start def 12 | import Primitive.Definition.Error ( NodeError(..) ) 13 | import Primitive.Definition.Node ( Node 14 | ( NodeBool 15 | , NodeContainer 16 | , NodeDouble 17 | , NodeEmpty 18 | , NodeFloat 19 | , NodeInt 20 | , NodeInteger 21 | , NodeText 22 | ) 23 | , PreNode 24 | ( PreNodeBool 25 | , PreNodeDouble 26 | , PreNodeEmpty 27 | , PreNodeFloat 28 | , PreNodeInt 29 | , PreNodeInteger 30 | , PreNodeText 31 | ) 32 | ) 33 | import Primitive.Instance.Node 34 | -- end def 35 | -- start fn 36 | import FunctionDef.Setter ( Data2Node(..) 37 | , IdTuple2Node(..) 38 | ) 39 | -- end fn 40 | -- start utility 41 | import Data.Text ( Text 42 | , empty 43 | , pack 44 | , unpack 45 | ) 46 | -- end utility 47 | 48 | makePreNode str = PreNodeInt (read str :: Int) 49 | makePreNode str = PreNodeInteger (read str :: Integer) 50 | makePreNode str = PreNodeFloat (read str :: Float) 51 | makePreNode str = PreNodeDouble (read str :: Double) 52 | makePreNode str = PreNodeText (pack str) 53 | makePreNode str = PreNodeBool (read str :: Bool) 54 | 55 | makeNodeFromPreNode :: PreNode -> Either NodeError Node 56 | makeNodeFromPreNode (PreNodeInt pint) = Right (NodeInt pint) 57 | makeNodeFromPreNode (PreNodeInteger pint) = Right (NodeInteger pint) 58 | makeNodeFromPreNode (PreNodeFloat pf ) = Right (NodeFloat pf) 59 | makeNodeFromPreNode (PreNodeDouble pd ) = Right (NodeDouble pd) 60 | makeNodeFromPreNode (PreNodeBool pb ) = Right (NodeBool pb) 61 | 62 | makeNodeFromIdTupleString :: (String, String) -> Either NodeError Node 63 | makeNodeFromIdTupleString (str1, str2) 64 | | str1 == "int" 65 | = makeNodeFromPreNode (PreNodeInt (read str2 :: Int)) 66 | | str1 == "integer" 67 | = makeNodeFromPreNode (PreNodeInteger (read str2 :: Integer)) 68 | | str1 == "float" 69 | = makeNodeFromPreNode (PreNodeFloat (read str2 :: Float)) 70 | | str1 == "double" 71 | = makeNodeFromPreNode (PreNodeDouble (read str2 :: Double)) 72 | | str1 == "text" 73 | = makeNodeFromPreNode (PreNodeText (pack str2)) 74 | | str1 == "bool" 75 | = makeNodeFromPreNode (PreNodeBool (read str2 :: Bool)) 76 | -------------------------------------------------------------------------------- /edition-helper/test/UtilsTest/MapUtilsSpec.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Model 3 | License : see LICENSE 4 | Description : Test suit for map utilities 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module UtilsTest.MapUtilsSpec where 10 | 11 | import Utils.MapUtils ( add2Map 12 | , convertTxt2NameMap 13 | , convertStringKey 14 | , convertStringVal 15 | , convertTxtKey 16 | , convertTxtVal 17 | , convertStringMap2Txt 18 | , convertTxtMap2String 19 | ) 20 | import Data.Map.Strict ( Map 21 | , fromList 22 | , union 23 | ) 24 | import Data.Text ( Text 25 | , pack 26 | , unpack 27 | ) 28 | import Text.XML ( Name ) 29 | import Utils.XmlUtils ( makeName ) 30 | 31 | import Test.Hspec 32 | main :: IO () 33 | main = hspec $ do 34 | describe "add key value of text type to Map Text Text add2Map" $ do 35 | it "should add (Foo, Bar) to map {'my': 'val', 'toto': 'titi'}" 36 | $ add2Map 37 | (fromList 38 | [(pack "my", pack "val"), (pack "toto", pack "titi")] 39 | ) 40 | [(pack "Foo", pack "Bar"), (pack "Foo2", pack "Bar2")] 41 | `shouldBe` fromList 42 | [ (pack "my" , pack "val") 43 | , (pack "toto", pack "titi") 44 | , (pack "Foo" , pack "Bar") 45 | , (pack "Foo2", pack "Bar2") 46 | ] 47 | 48 | describe "convert key and value to different types" $ do 49 | it "convertTxt2NameMap change map Text key to Name key" 50 | $ convertTxt2NameMap (fromList [(pack "my", pack "val")]) 51 | `shouldBe` (fromList [(makeName (pack "my"), pack "val")]) 52 | 53 | it "convertStringKey change map String key to Text key" 54 | $ convertStringKey (fromList [("my", pack "val")]) 55 | `shouldBe` (fromList [(pack "my", pack "val")]) 56 | 57 | it "convertStringVal change map String val to Text val" 58 | $ convertStringVal (fromList [(pack "my", "val")]) 59 | `shouldBe` (fromList [(pack "my", pack "val")]) 60 | 61 | it "convertTxtKey change map Text key to String key" 62 | $ convertTxtKey (fromList [(pack "my", "val")]) 63 | `shouldBe` (fromList [("my", "val")]) 64 | 65 | it "convertTxtVal change map Text val to String val" 66 | $ convertTxtVal (fromList [("my", pack "val")]) 67 | `shouldBe` (fromList [("my", "val")]) 68 | 69 | it "convertStringMap2Txt change map String String to Text Text" 70 | $ convertStringMap2Txt (fromList [("my", "val")]) 71 | `shouldBe` (fromList [(pack "my", pack "val")]) 72 | 73 | it "convertTxtMap2String change map Text Text to String String" 74 | $ convertTxtMap2String (fromList [(pack "my", pack "val")]) 75 | `shouldBe` (fromList [("my", "val")]) 76 | -------------------------------------------------------------------------------- /edition-helper/src/Control/Pure/NodeAttr.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Control.Pure.NodeAttr.hs 3 | License : see LICENSE 4 | Description : Control functions for NodeAttr type 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Control.Pure.NodeAttr 10 | ( makeNodeAttrFromStringMap 11 | , makeNodeAttrFromTextMap 12 | , makeNodeAttrFromIdTupleStringMap 13 | , makeNodeAttrFromIdTupleTextMap 14 | ) 15 | where 16 | 17 | -- start def 18 | import Primitive.Definition.Error 19 | ( IdTupleValueError (FirstValueError, SecondMapValueError) 20 | , MapValueError (MapKeyError, MapValError, OtherMapError) 21 | , TextValueError (EmptyStr, OtherStringError) 22 | ) 23 | import Primitive.Definition.NodeAttr ( NodeAttr ) 24 | import Primitive.Instance.NodeAttr ( NodeAttr ) 25 | -- end def 26 | -- start fn 27 | import FunctionDef.Setter ( Map2Primitive (..), TupleMap2Primitive (..) ) 28 | -- end fn 29 | -- start utility 30 | import Data.Map.Strict ( Map, elems, filterWithKey, keys, toList ) 31 | import qualified Data.Map.Strict as Mp ( filter ) 32 | import Data.Text ( Text ) 33 | import Utils.MapUtils ( convertStringMap2Txt, convertTxtMap2String ) 34 | import Utils.StrUtils ( isAlphaNumStr, isAsciiStr ) 35 | 36 | showMapKeyVal :: Int -> Map String String -> String 37 | 38 | showMapKeyVal 0 amap = fst (head (toList amap)) 39 | showMapKeyVal 1 amap = snd (head (toList amap)) 40 | 41 | showMapKey :: Map String String -> String 42 | showMapKey = showMapKeyVal 0 43 | showMapVal :: Map String String -> String 44 | showMapVal = showMapKeyVal 1 45 | showFirstKV :: Map String String -> String 46 | showFirstKV amap = 47 | "Key: " ++ (showMapKey amap) ++ "\n" ++ "Val: " ++ (showMapVal amap) 48 | 49 | -- end utility 50 | makeNodeAttrFromStringMap 51 | :: Map String String -> Either MapValueError NodeAttr 52 | makeNodeAttrFromStringMap aMap 53 | | any null (elems aMap) 54 | = let errstr = showFirstKV (Mp.filter null aMap) 55 | in Left (MapValError "Attributes must have non empty values" errstr) 56 | | any null (keys aMap) 57 | = let errstr = showFirstKV (filterWithKey filtfn aMap) 58 | where filtfn key val = null key 59 | in Left (MapKeyError "Attributes must have non empty keys" errstr) 60 | | not (all isAlphaNumStr (elems aMap)) 61 | = let errstr = showMapVal (Mp.filter isAlphaNumStr aMap) 62 | in 63 | Left 64 | (MapValError 65 | "Attributes must have alphanumeric values unlike: " 66 | errstr 67 | ) 68 | | not (all isAsciiStr (elems aMap)) 69 | = let errstr = showMapVal (Mp.filter isAsciiStr aMap) 70 | in Left (MapValError "Attributes must have ascii values" errstr) 71 | | not (all isAlphaNumStr (keys aMap)) 72 | = let errstr = showMapKey (filterWithKey fn aMap) 73 | where fn key val = isAlphaNumStr key 74 | in Left (MapKeyError "Attributes must have alphanumeric keys" errstr) 75 | | not (all isAsciiStr (keys aMap)) 76 | = let errstr = showMapKey (filterWithKey fn aMap) 77 | where fn key val = isAsciiStr key 78 | in Left (MapKeyError "Attributes must have ascii keys" errstr) 79 | 80 | makeNodeAttrFromTextMap :: Map Text Text -> Either MapValueError NodeAttr 81 | makeNodeAttrFromTextMap amap = 82 | makeNodeAttrFromStringMap (convertTxtMap2String amap) 83 | 84 | makeNodeAttrFromIdTupleStringMap 85 | :: (String, Map String String) -> Either IdTupleValueError NodeAttr 86 | 87 | makeNodeAttrFromIdTupleStringMap (str, amap) 88 | | null str 89 | = Left (FirstValueError (EmptyStr "IdTuple first argument")) 90 | | not (str == "attribute") 91 | = Left 92 | (FirstValueError 93 | (OtherStringError 94 | "IdTuple first value is not attribute for NodeAttr id tuple" 95 | ) 96 | ) 97 | | otherwise 98 | = let res = makeNodeAttrFromStringMap amap 99 | in case res of 100 | Left err -> Left (SecondMapValueError err) 101 | Right m -> Right m 102 | 103 | makeNodeAttrFromIdTupleTextMap 104 | :: (String, Map Text Text) -> Either IdTupleValueError NodeAttr 105 | 106 | 107 | makeNodeAttrFromIdTupleTextMap (str, amap) = 108 | makeNodeAttrFromIdTupleStringMap (str, (convertTxtMap2String amap)) 109 | -------------------------------------------------------------------------------- /edition-helper/src/Primitive/Definition/Error.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Error 3 | License : see LICENSE 4 | Description : Custom error definitions 5 | Copyright : Kaan Eraslan 6 | Maintainer : Kaan Eraslan 7 | Stability : Experimental 8 | -} 9 | module Primitive.Definition.Error 10 | ( TextValueError(..) 11 | , IdTupleValueError(..) 12 | , MapValueError(..) 13 | , NodeError(..) 14 | ) 15 | where 16 | 17 | import qualified Control.Exception as Ex 18 | import Data.Text ( Text, unpack ) 19 | import Type.Reflection ( Typeable ) 20 | import Utils.StrUtils ( concatHStr, concatTStr ) 21 | 22 | -- |'TextValueError' defines errors for string 23 | data TextValueError = EmptyText Text -- string is empty 24 | | NotAscii Text 25 | | NotAlphanumeric Text 26 | | NotAsciiAlphanumeric Text 27 | | OtherTextError Text 28 | deriving (Typeable) 29 | 30 | instance Show TextValueError where 31 | show (EmptyText infostr) = "String value is empty for " ++ unpack infostr 32 | show (NotAscii infostr) = 33 | "String value is not entirely composed of ASCII characters for " 34 | ++ unpack infostr 35 | show (NotAlphanumeric infostr) = 36 | "String value is not entirely composed of alphanumeric characters for " 37 | ++ unpack infostr 38 | show (NotAsciiAlphanumeric infostr) = 39 | "String not entirely composed of alphanumeric ASCII characters for " 40 | ++ unpack infostr 41 | show (OtherTextError str) | null (unpack str) = "Unknown string error" 42 | | otherwise = unpack str 43 | 44 | instance Ex.Exception TextValueError 45 | 46 | -- |'MapValueError' regroups map errors 47 | data MapValueError = MapKeyError Text Text 48 | | MapValError Text Text 49 | | OtherMapError Text 50 | deriving (Typeable) 51 | 52 | 53 | instance Show MapValueError where 54 | show (MapKeyError mess str) = 55 | "Map key error: " ++ unpack mess ++ " for key: " ++ unpack str 56 | show (MapValError mess str) = 57 | "Map value error: " ++ unpack mess ++ " for value: " ++ unpack str 58 | show (OtherMapError mess) = "Map error: " ++ unpack mess 59 | 60 | 61 | data NodeError = NodeIntError String 62 | | NodeIntegerError String 63 | | NodeFloatError String 64 | | NodeDoubleError String 65 | | NodeStringError String 66 | | NodeBoolError String 67 | | NodeTextError String 68 | | NodeEmptyError String 69 | | NodeContainerError String 70 | deriving (Typeable) 71 | 72 | makeNodeErrString :: String -> String -> String 73 | makeNodeErrString tname mess = 74 | "Node" 75 | ++ tname 76 | ++ "Error: in constructing node from" 77 | ++ tname 78 | ++ ": " 79 | ++ mess 80 | 81 | instance Show NodeError where 82 | show (NodeIntError mess) = makeNodeErrString "Int" mess 83 | show (NodeIntegerError mess) = makeNodeErrString "Integer" mess 84 | show (NodeFloatError mess) = makeNodeErrString "Float" mess 85 | show (NodeDoubleError mess) = makeNodeErrString "Double" mess 86 | show (NodeStringError mess) = makeNodeErrString "String" mess 87 | show (NodeBoolError mess) = makeNodeErrString "Bool" mess 88 | show (NodeTextError mess) = makeNodeErrString "Text" mess 89 | show (NodeEmptyError mess) = makeNodeErrString "Error" mess 90 | show (NodeContainerError mess) = makeNodeErrString "Container" mess 91 | 92 | 93 | newtype NodeIdError = NodeIdError TextValueError 94 | newtype NodeTypeError = NodeTypeError TextValueError 95 | newtype NodeAttrError = NodeAttrError MapValueError 96 | 97 | instance Show NodeIdError where 98 | show (NodeIdError serr) = "Node id error: " ++ show serr 99 | 100 | instance Show NodeTypeError where 101 | show (NodeTypeError serr) = "Node type error: " ++ show serr 102 | 103 | instance Show NodeAttrError where 104 | show (NodeAttrError serr) = "Node attribute error: " ++ show serr 105 | 106 | 107 | data NodeInfoError = NodeInfoIdError NodeIdError 108 | | NodeInfoTypeError NodeTypeError 109 | | NodeInfoAttrError NodeAttrError 110 | | OtherNodeInfoError String 111 | deriving (Typeable) 112 | 113 | 114 | instance Show NodeInfoError where 115 | show (NodeInfoIdError serr) = "NodeInfo: " ++ show serr 116 | show (NodeInfoTypeError serr) = "NodeInfo: " ++ show serr 117 | show (NodeInfoAttrError serr) = "NodeInfo: " ++ show serr 118 | show (OtherNodeInfoError serr) = "Other NodeInfo error: " ++ serr 119 | 120 | 121 | data IdTupleValueError = FirstValueEmpty String 122 | | FirstValueError TextValueError 123 | | SecondTextValueError TextValueError 124 | | SecondMapValueError MapValueError 125 | | OtherIdTupleError String 126 | deriving (Typeable) 127 | 128 | 129 | instance Show IdTupleValueError where 130 | show (FirstValueEmpty infostr) = 131 | "First value of id tuple is empty: " ++ infostr 132 | show (FirstValueError strerr) = 133 | "Error in first value of id tuple: " ++ show strerr 134 | show (SecondTextValueError strerr) = 135 | "Error in second string value of id tuple: " ++ show strerr 136 | show (SecondMapValueError strerr) = 137 | "Error in second map value of id tuple: " ++ show strerr 138 | show (OtherIdTupleError infostr) | null infostr = "Unknown id tuple error" 139 | | otherwise = infostr 140 | -------------------------------------------------------------------------------- /edition-helper/report.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | HLint Report 6 | 61 | 70 | 139 | 140 | 141 | 142 | 145 | 146 |
147 | 148 |

All hints

149 | 154 | 155 |

All files

156 | 160 | 161 |
162 |
163 |

164 | Report generated by HLint 165 | v1.9.26 166 | - a tool to suggest improvements to your Haskell code. 167 |

168 | 169 |
170 | src/Primitive/Instance/Impure/UnitData.hs:15:1: Error: Use fewer imports
171 | Found
172 | 
import Primitive.Definition.UnitData
173 |        (UnitData(StringUnitDataCons, TextUnitDataCons))
174 | import Primitive.Definition.UnitData
175 |        (UnitData(StringUnitDataCons, TextUnitDataCons))
176 |
177 | Why not
178 | 
import Primitive.Definition.UnitData
179 |        (UnitData(StringUnitDataCons, TextUnitDataCons))
180 |
181 | 182 |
183 | 184 |
185 | src/Primitive/Instance/Pure/Unit.hs:99:18: Error: Evaluate
186 | Found
187 | 
(pack (fst tpl)) (snd tpl)
188 | Why not
189 | 
uncurry pack tpl
190 | 191 |
192 | 193 |
194 | src/Primitive/Instance/Pure/Unit.hs:99:18: Warning: Redundant bracket
195 | Found
196 | 
(pack (fst tpl)) (snd tpl)
197 | Why not
198 | 
pack (fst tpl) (snd tpl)
199 | 200 |
201 | 202 |
203 | 204 | 205 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | --------------------------------------------------------------------------------