chore: import pie
This commit is contained in:
2
pie/.gitignore
vendored
Normal file
2
pie/.gitignore
vendored
Normal file
@@ -0,0 +1,2 @@
|
||||
.stack-work/
|
||||
dist-newstyle/
|
||||
3
pie/ChangeLog.md
Normal file
3
pie/ChangeLog.md
Normal file
@@ -0,0 +1,3 @@
|
||||
# Changelog for pie
|
||||
|
||||
## Unreleased changes
|
||||
30
pie/LICENSE
Normal file
30
pie/LICENSE
Normal file
@@ -0,0 +1,30 @@
|
||||
Copyright Kierán Meinhardt (c) 2020
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Kierán Meinhardt nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
1
pie/README.md
Normal file
1
pie/README.md
Normal file
@@ -0,0 +1 @@
|
||||
# pie
|
||||
2
pie/Setup.hs
Normal file
2
pie/Setup.hs
Normal file
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
6
pie/app/Main.hs
Normal file
6
pie/app/Main.hs
Normal file
@@ -0,0 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Lib
|
||||
|
||||
main :: IO ()
|
||||
main = someFunc
|
||||
6
pie/default.nix
Normal file
6
pie/default.nix
Normal file
@@ -0,0 +1,6 @@
|
||||
{ pkgs ? import <nixpkgs> {} }:
|
||||
with pkgs.haskellPackages;
|
||||
developPackage {
|
||||
root = ./.;
|
||||
modifier = drv: pkgs.haskell.lib.addBuildTools drv [ cabal-install ghcid ];
|
||||
}
|
||||
48
pie/package.yaml
Normal file
48
pie/package.yaml
Normal file
@@ -0,0 +1,48 @@
|
||||
name: pie
|
||||
version: 0.1.0.0
|
||||
github: "kmein/pie"
|
||||
license: BSD3
|
||||
author: "Kierán Meinhardt"
|
||||
maintainer: "kieran.meinhardt@gmail.com"
|
||||
copyright: "Copyright: (c) 2019 Kierán Meinhardt"
|
||||
|
||||
extra-source-files:
|
||||
- README.md
|
||||
- ChangeLog.md
|
||||
|
||||
# Metadata used when publishing your package
|
||||
# synopsis: Short description of your package
|
||||
# category: Web
|
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the
|
||||
# complications of embedding Haddock markup inside cabal files, it is
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README on GitHub at <https://github.com/kmein/pie#readme>
|
||||
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
||||
executables:
|
||||
pie-exe:
|
||||
main: Main.hs
|
||||
source-dirs: app
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- pie
|
||||
|
||||
tests:
|
||||
pie-test:
|
||||
main: Spec.hs
|
||||
source-dirs: test
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- pie
|
||||
64
pie/pie.cabal
Normal file
64
pie/pie.cabal
Normal file
@@ -0,0 +1,64 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.33.0.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 7b2191766b707f18a8358cd8565a38904d2b7e91376ea706ee91882a8c811f19
|
||||
|
||||
name: pie
|
||||
version: 0.1.0.0
|
||||
description: Please see the README on GitHub at <https://github.com/kmein/pie#readme>
|
||||
homepage: https://github.com/kmein/pie#readme
|
||||
bug-reports: https://github.com/kmein/pie/issues
|
||||
author: Kierán Meinhardt
|
||||
maintainer: kieran.meinhardt@gmail.com
|
||||
copyright: Copyright: (c) 2019 Kierán Meinhardt
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
README.md
|
||||
ChangeLog.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/kmein/pie
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Lib,
|
||||
Phonology,
|
||||
Util
|
||||
other-modules:
|
||||
Paths_pie
|
||||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
default-language: Haskell2010
|
||||
|
||||
executable pie-exe
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Paths_pie
|
||||
hs-source-dirs:
|
||||
app
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, pie
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite pie-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Paths_pie
|
||||
hs-source-dirs:
|
||||
test
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, pie
|
||||
default-language: Haskell2010
|
||||
101
pie/src/Lib.hs
Normal file
101
pie/src/Lib.hs
Normal file
@@ -0,0 +1,101 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Lib
|
||||
( someFunc
|
||||
)
|
||||
where
|
||||
|
||||
import Phonology
|
||||
import Util ( replaceSublist )
|
||||
|
||||
import Control.Monad ( forM_ )
|
||||
import Data.List ( zip3 )
|
||||
|
||||
{-
|
||||
import Data.Void
|
||||
import qualified Text.Megaparsec as Parsec
|
||||
import qualified Text.Megaparsec.Stream as Parsec
|
||||
|
||||
instance Parsec.Stream [Phoneme] where
|
||||
type Token [Phoneme] = Phoneme
|
||||
type Tokens [Phoneme] = [Phoneme]
|
||||
tokensToChunk _ = id
|
||||
chunkToTokens _ = id
|
||||
chunkLength _ = length
|
||||
take1_ [] = Nothing
|
||||
take1_ (x : xs) = Just (x, xs)
|
||||
takeN_ n xs = if length xs >= n then Just (splitAt n xs) else Nothing
|
||||
takeWhile_ = span
|
||||
showTokens _ = show
|
||||
reachOffset offset posState =
|
||||
Parsec.reachOffset' splitAt foldl' id id ('\n', '\t') o pst
|
||||
|
||||
|
||||
|
||||
parseRoot :: Parsec.Parsec Void [Phoneme] ()
|
||||
parseRoot = () <$ do
|
||||
Parsec.optional $ satisfyFeature (`elem` [Sibilant, Laryngeal])
|
||||
Parsec.optional $ satisfyFeature isPlosive
|
||||
satisfyFeature $ \p -> isPlosive p || p == Resonant
|
||||
Parsec.single E
|
||||
satisfyFeature $ \p -> isPlosive p || p == Resonant
|
||||
Parsec.optional $ satisfyFeature isPlosive
|
||||
Parsec.optional $ satisfyFeature (`elem` [Sibilant, Laryngeal])
|
||||
where
|
||||
satisfyFeature :: (FeatureSet -> Bool) -> Parsec.Parsec Void [Phoneme] Phoneme
|
||||
satisfyFeature p = Parsec.satisfy (p . features)
|
||||
-}
|
||||
|
||||
|
||||
|
||||
syllabify :: [Phoneme] -> [Bool]
|
||||
syllabify = replaceSublist [True, True] [True, False] -- replace VV by VC
|
||||
. foldr isSonant []
|
||||
where
|
||||
hasToBeSyllabic p = features p == Vowel
|
||||
canBeSyllabic p = features p `elem` [Vowel, Resonant]
|
||||
isSonant current xs = case xs of
|
||||
[] -> [canBeSyllabic current] -- make last phoneme in word syllabic
|
||||
previousIsSonant : _ -> if previousIsSonant
|
||||
then hasToBeSyllabic current : xs -- only vowels are sonant, the rest can be consonantal
|
||||
else canBeSyllabic current : xs -- make syllabic if previous is not syllabic
|
||||
|
||||
|
||||
syllableCores :: [Phoneme] -> [Bool]
|
||||
syllableCores = localMax . (++ [0]) . ([0] ++) . map (sonority . features)
|
||||
where
|
||||
localMax xs = map project $ zip3 xs (tail xs) (drop 2 xs)
|
||||
where project (x, y, z) = x <= y && y >= z
|
||||
|
||||
-- chunkSyllables :: [Bool] -> [[Bool]]
|
||||
-- chunkSyllables = _
|
||||
|
||||
someFunc :: IO ()
|
||||
someFunc = do
|
||||
let pieLines =
|
||||
[ [Kj, M, T, O, M]
|
||||
, [N, E, H2, U, S]
|
||||
, [I, U, N, E, G, T, I]
|
||||
, [I, U, N, G, E, N, T, I]
|
||||
, [H2, N, R, Bh, I]
|
||||
, [H2, E, R, H3, T, R, O, M]
|
||||
, [H2, I, U, H, O, N]
|
||||
, [H2, S, N, T, I, E, H2]
|
||||
, [Gh, E_, I, M, N, O]
|
||||
, [Kj, U, N, Bh, I]
|
||||
, [D, I, U, O, S]
|
||||
, [N, M, R, T, O, S]
|
||||
, [U, L, Kw, O, S]
|
||||
, [Kj, U, N, O, S]
|
||||
, [D, N, T, N, S]
|
||||
, [N, D, R, Kj, T, O, S]
|
||||
, [U, N, T, O, S]
|
||||
, [D, U, I, D, Kj, M, T]
|
||||
, [Kj, L, U, Dh, I]
|
||||
, [H1, N, E, U, N]
|
||||
, [H2, U, E, H1, N, T, O, S]
|
||||
]
|
||||
forM_ pieLines $ \line -> do
|
||||
putStr $ concatMap show line
|
||||
putChar ' '
|
||||
putStrLn $ concat $ zipWith showSyllabic line (syllabify line)
|
||||
105
pie/src/Phonology.hs
Normal file
105
pie/src/Phonology.hs
Normal file
@@ -0,0 +1,105 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
module Phonology where
|
||||
|
||||
|
||||
data Manner = MediaAspirata | Media | Tenuis
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data Place = Labial | Dental | Palatal | Velar | Labiovelar
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data Phoneme
|
||||
= E | O | A | E_ | O_ | A_
|
||||
| I | U | N | M | R | L
|
||||
| P | B | Bh | T | D | Dh | Kj | Gj | Gjh | K | G | Gh | Kw | Gw | Gwh | S | H1 | H2 | H3 | H
|
||||
deriving (Eq, Ord)
|
||||
|
||||
instance Show Phoneme where
|
||||
show = \case
|
||||
E -> "e"
|
||||
O -> "o"
|
||||
A -> "a"
|
||||
E_ -> "ē"
|
||||
O_ -> "ō"
|
||||
A_ -> "ā"
|
||||
I -> "i"
|
||||
U -> "u"
|
||||
N -> "n"
|
||||
M -> "m"
|
||||
R -> "r"
|
||||
L -> "l"
|
||||
P -> "p"
|
||||
B -> "b"
|
||||
Bh -> "bh"
|
||||
T -> "t"
|
||||
D -> "d"
|
||||
Dh -> "dh"
|
||||
Kj -> "ḱ"
|
||||
Gj -> "ǵ"
|
||||
Gjh -> "ǵh"
|
||||
K -> "k"
|
||||
G -> "g"
|
||||
Gh -> "gh"
|
||||
Kw -> "kʷ"
|
||||
Gw -> "gʷ"
|
||||
Gwh -> "gʷh"
|
||||
S -> "s"
|
||||
H1 -> "h₁"
|
||||
H2 -> "h₂"
|
||||
H3 -> "h₃"
|
||||
H -> "H"
|
||||
|
||||
data FeatureSet
|
||||
= Vowel
|
||||
| Resonant
|
||||
| Laryngeal
|
||||
| Sibilant
|
||||
| Plosive { manner :: Manner, place :: Place }
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
sonority :: FeatureSet -> Int
|
||||
sonority = \case
|
||||
Vowel -> 4
|
||||
Resonant -> 3
|
||||
Laryngeal -> 3
|
||||
Sibilant -> 2
|
||||
Plosive _ _ -> 1
|
||||
|
||||
isPlosive :: FeatureSet -> Bool
|
||||
isPlosive (Plosive _ _) = True
|
||||
isPlosive _ = False
|
||||
|
||||
features :: Phoneme -> FeatureSet
|
||||
features phoneme
|
||||
| phoneme == S = Sibilant
|
||||
| phoneme `elem` [E, O, A, E_, O_, A_] = Vowel
|
||||
| phoneme `elem` [H1, H2, H3, H] = Laryngeal
|
||||
| phoneme `elem` [I, U, N, M, R, L] = Resonant
|
||||
| otherwise = Plosive
|
||||
{ manner = if
|
||||
| phoneme `elem` [P, T, K, Kj, Kw] -> Tenuis
|
||||
| phoneme `elem` [B, D, G, Gj, Gw] -> Media
|
||||
| phoneme `elem` [Bh, Dh, Gh, Gjh, Gwh] -> MediaAspirata
|
||||
, place = if
|
||||
| phoneme `elem` [P, B, Bh] -> Labial
|
||||
| phoneme `elem` [T, D, Dh] -> Dental
|
||||
| phoneme `elem` [Kj, Gj, Gjh] -> Palatal
|
||||
| phoneme `elem` [K, G, Gh] -> Velar
|
||||
| phoneme `elem` [Kw, Gw, Gwh] -> Labiovelar
|
||||
}
|
||||
|
||||
showSyllabic :: Phoneme -> Bool -> String
|
||||
showSyllabic phoneme syllabic = case (phoneme, syllabic) of
|
||||
(I , False) -> "y"
|
||||
(U , False) -> "w"
|
||||
(N , True ) -> "ṇ"
|
||||
(M , True ) -> "ṃ"
|
||||
(R , True ) -> "ṛ"
|
||||
(L , True ) -> "ḷ"
|
||||
-- (H1, True ) -> "ə₁"
|
||||
-- (H2, True ) -> "ə₂"
|
||||
-- (H3, True ) -> "ə₃"
|
||||
-- (H , True ) -> "ə"
|
||||
_ -> show phoneme
|
||||
|
||||
10
pie/src/Util.hs
Normal file
10
pie/src/Util.hs
Normal file
@@ -0,0 +1,10 @@
|
||||
module Util where
|
||||
|
||||
import Data.List ( isPrefixOf )
|
||||
|
||||
replaceSublist :: Eq a => [a] -> [a] -> [a] -> [a]
|
||||
replaceSublist _ _ [] = []
|
||||
replaceSublist list replacement xss@(x : xs) = if list `isPrefixOf` xss
|
||||
then replacement ++ replaceSublist list replacement (drop (length list) xss)
|
||||
else x : replaceSublist list replacement xs
|
||||
|
||||
66
pie/stack.yaml
Normal file
66
pie/stack.yaml
Normal file
@@ -0,0 +1,66 @@
|
||||
# This file was automatically generated by 'stack init'
|
||||
#
|
||||
# Some commonly used options have been documented as comments in this file.
|
||||
# For advanced use and comprehensive documentation of the format, please see:
|
||||
# https://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||
|
||||
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||
# A snapshot resolver dictates the compiler version and the set of packages
|
||||
# to be used for project dependencies. For example:
|
||||
#
|
||||
# resolver: lts-3.5
|
||||
# resolver: nightly-2015-09-21
|
||||
# resolver: ghc-7.10.2
|
||||
#
|
||||
# The location of a snapshot can be provided as a file or url. Stack assumes
|
||||
# a snapshot provided as a file might change, whereas a url resource does not.
|
||||
#
|
||||
# resolver: ./custom-snapshot.yaml
|
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||
resolver: lts-16.2
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
#
|
||||
# packages:
|
||||
# - some-directory
|
||||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||
# subdirs:
|
||||
# - auto-update
|
||||
# - wai
|
||||
packages:
|
||||
- .
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver.
|
||||
# These entries can reference officially published versions as well as
|
||||
# forks / in-progress versions pinned to a git hash. For example:
|
||||
#
|
||||
# extra-deps:
|
||||
# - acme-missiles-0.3
|
||||
# - git: https://github.com/commercialhaskell/stack.git
|
||||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||
#
|
||||
# extra-deps: []
|
||||
|
||||
# Override default flag values for local packages and extra-deps
|
||||
# flags: {}
|
||||
|
||||
# Extra package databases containing global packages
|
||||
# extra-package-dbs: []
|
||||
|
||||
# Control whether we use the GHC we find on the path
|
||||
# system-ghc: true
|
||||
#
|
||||
# Require a specific version of stack, using version ranges
|
||||
# require-stack-version: -any # Default
|
||||
# require-stack-version: ">=2.1"
|
||||
#
|
||||
# Override the architecture used by stack, especially useful on Windows
|
||||
# arch: i386
|
||||
# arch: x86_64
|
||||
#
|
||||
# Extra directories used by stack for building
|
||||
# extra-include-dirs: [/path/to/dir]
|
||||
# extra-lib-dirs: [/path/to/dir]
|
||||
#
|
||||
# Allow a newer minor version of GHC than the snapshot specifies
|
||||
# compiler-check: newer-minor
|
||||
12
pie/stack.yaml.lock
Normal file
12
pie/stack.yaml.lock
Normal file
@@ -0,0 +1,12 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 531674
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/2.yaml
|
||||
sha256: 4b08fb9338ca297de7ade8318f4be1216f14dff8c0426c001fb7886ee88cb84a
|
||||
original: lts-16.2
|
||||
2
pie/test/Spec.hs
Normal file
2
pie/test/Spec.hs
Normal file
@@ -0,0 +1,2 @@
|
||||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
||||
Reference in New Issue
Block a user