From 7451594ddf6653b11fcf9e28b888c6ca5882f753 Mon Sep 17 00:00:00 2001 From: Crawford Collins Date: Mon, 3 Jan 2022 22:43:00 -0600 Subject: [PATCH] initial commit --- db_config.py | 1 + elm.json | 32 ++++ make_db.py | 166 +++++++++++++++++++ server/Setup.hs | 2 + server/app/Main.hs | 143 ++++++++++++++++ server/package.yaml | 56 +++++++ server/server.cabal | 89 ++++++++++ server/src/Lib.hs | 6 + server/stack.yaml | 67 ++++++++ server/stack.yaml.lock | 13 ++ src/Main.elm | 366 +++++++++++++++++++++++++++++++++++++++++ src/SharedTypes.elm | 37 +++++ 12 files changed, 978 insertions(+) create mode 100755 db_config.py create mode 100755 elm.json create mode 100755 make_db.py create mode 100755 server/Setup.hs create mode 100755 server/app/Main.hs create mode 100755 server/package.yaml create mode 100755 server/server.cabal create mode 100755 server/src/Lib.hs create mode 100755 server/stack.yaml create mode 100755 server/stack.yaml.lock create mode 100755 src/Main.elm create mode 100755 src/SharedTypes.elm diff --git a/db_config.py b/db_config.py new file mode 100755 index 0000000..8b13789 --- /dev/null +++ b/db_config.py @@ -0,0 +1 @@ + diff --git a/elm.json b/elm.json new file mode 100755 index 0000000..1032902 --- /dev/null +++ b/elm.json @@ -0,0 +1,32 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "NoRedInk/elm-json-decode-pipeline": "1.0.0", + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/http": "2.0.0", + "elm/json": "1.1.3", + "elm/url": "1.0.0", + "elm-community/list-extra": "8.5.1", + "krisajenkins/remotedata": "6.0.1", + "mdgriffith/elm-ui": "1.1.8", + "ohanhi/remotedata-http": "4.0.0" + }, + "indirect": { + "elm/bytes": "1.0.8", + "elm/file": "1.0.5", + "elm/time": "1.0.0", + "elm/virtual-dom": "1.0.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/make_db.py b/make_db.py new file mode 100755 index 0000000..e15cef5 --- /dev/null +++ b/make_db.py @@ -0,0 +1,166 @@ +import glob +import json +import re +import sqlite3 + + +def create_scrubbed_lines(): + sql = sqlite3.connect("db.sqlite3") + try: + sql.execute("DROP TABLE scrubbedLines") + except: + pass + sql.execute( + """CREATE VIRTUAL TABLE scrubbedLines USING fts5( + line, lineNumber UNINDEXED, bookId UNINDEXED, chapter UNINDEXED, subsection UNINDEXED, + );""") + sql.close() + return 1 + + +def add_scrubbed_lines_to_db(chapter, book, subsection): + file = f"fulltexts/{book}/{book}{chapter:02d}.txt" + with open(file) as f: + text = re.sub(pattern=r"(Ἀ|Ἁ|Ἂ|Ἃ|Ἄ|Ἅ|Ἆ|Ἇ|Ὰ|Ά|Ᾰ|Ᾱ|ᾼ|ᾈ|ᾉ|ᾊ|ᾋ|ᾌ|ᾍ|ᾎ|ᾏ)", repl="Α", string=f.read(), count=100_000) + text = re.sub(pattern=r"(Ἐ|Ἑ|Ἒ|Ἓ|Ἔ|Ἕ|Ὲ|Έ)", repl="Ε", string=text, count=100_000) + text = re.sub(pattern=r"(Ἠ|Ἡ|Ἢ|Ἣ|Ἤ|Ἥ|Ἦ|Ἧ|Ὴ|Ή|ῌ|ᾘ|ᾙ|ᾚ|ᾛ|ᾜ|ᾝ|ᾞ|ᾟ)", repl="Η", string=text, count=100_000) + text = re.sub(pattern=r"(Ἰ|Ἱ|Ἲ|Ἳ|Ἴ|Ἵ|Ἶ|Ἷ|Ὶ|Ί|Ῐ|Ῑ)", repl="Ι", string=text, count=100_000) + text = re.sub(pattern=r"(Ὑ|Ὓ|Ὕ|Ὗ|Ὺ|Ύ|Ῠ|Ῡ)", repl="Υ", string=text, count=100_000) + text = re.sub(pattern=r"(ἀ|ἁ|ἂ|ἃ|ἄ|ἅ|ἆ|ἇ|ὰ|ά|ᾰ|ᾱ|ᾶ|ᾳ|ᾲ|ᾴ|ᾀ|ᾁ|ᾂ|ᾃ|ᾄ|ᾅ|ᾆ|ᾇ|ᾷ|ά)", repl="α", string=text, + count=100_000) + text = re.sub(pattern=r"(ἐ|ἑ|ἒ|ἓ|ἔ|ἕ|ὲ|έ|έ)", repl="ε", string=text, count=100_000) + text = re.sub(pattern=r"(ἠ|ἡ|ἢ|ἣ|ἤ|ἥ|ἦ|ἧ|ὴ|ή|ῆ|ῃ|ῂ|ῄ|ᾐ|ᾑ|ᾒ|ᾓ|ᾔ|ᾕ|ᾖ|ᾗ|ῇ|ή)", repl="η", string=text, + count=100_000) + text = re.sub(pattern=r"(ἰ|ἱ|ἲ|ἳ|ἴ|ἵ|ἶ|ἷ|ὶ|ί|ῐ|ῑ|ῖ|ῒ|ΐ|ῗ|ί|ΐ)", repl="ι", string=text, count=100_000) + text = re.sub(pattern=r"(ὀ|ὁ|ὂ|ὃ|ὄ|ὅ|ὸ|ό|ό)", repl="ο", string=text, count=100_000) + text = re.sub(pattern=r"(ὑ|ὓ|ὕ|ὗ|ὺ|ύ|ῠ|ῡ|ὐ|ὒ|ὔ|ὖ|ῦ|ῢ|ΰ|ῧ|ύ)", repl="υ", string=text, count=100_000) + text = re.sub(pattern=r"(ὠ|ὡ|ὢ|ὣ|ὤ|ὥ|ὦ|ὧ|ὼ|ώ|ῶ|ῳ|ῲ|ῴ|ᾠ|ᾡ|ᾢ|ᾣ|ᾤ|ᾥ|ᾦ|ᾧ|ῷ|ώ)", repl="ω", string=text, + count=100_000) + text = re.sub(pattern=r'\n’', repl='’\n', string=text, count=100_000) + text = text.split("\n") + text = [t.strip("0123456789") for t in text] + text = [i for i in text if i not in ["\n", "", '’', '’ ’', "’’", "‘"]] + + for index, line in enumerate(text, start=1): + with sqlite3.connect("db.sqlite3") as conn: + book_id = conn.execute("SELECT id FROM books WHERE title=?", (book,)).fetchone()[0] + conn.execute( + "INSERT INTO scrubbedLines VALUES (?,?,?,?,?)", (line, index, book_id, chapter, subsection)) + return 1 + + +def create_full_lines(): + sql = sqlite3.connect("db.sqlite3") + try: + sql.execute("DROP TABLE fullLines") + except: + pass + sql.execute(""" + CREATE TABLE fullLines( + line TEXT NOT NULL, + lineNumber INT NOT NULL, + bookId INT NOT NULL, + chapter INT NOT NULL, + subsection INT, + FOREIGN KEY (bookId) REFERENCES books(id) + );""") + sql.execute("CREATE UNIQUE INDEX textLocation on fullLines(bookId,chapter,lineNumber)") + sql.close() + return 1 + + +def add_full_lines_to_db(chapter, book, subsection): + file = f"fulltexts/{book}/{book}{chapter:02d}.txt" + with open(file) as f: + text = re.sub(pattern=r'\n’', repl='’\n', string=f.read(), count=100_000) + text = text.split("\n") + text = [t.strip("0123456789") for t in text] + text = [i for i in text if i not in ["\n", "", '’', '’ ’', "’’", "‘"]] + + for index, line in enumerate(text, start=1): + with sqlite3.connect("db.sqlite3") as conn: + book_id = conn.execute("SELECT id FROM books WHERE title=?", (book,)).fetchone()[0] + res = conn.execute( + "INSERT INTO fullLines VALUES (?,?,?,?,?)", (line, index, book_id, chapter, subsection) + ) + return 1 + + +def create_authors(): + sql = sqlite3.connect("db.sqlite3") + try: + sql.execute("DROP TABLE authors") + except: + pass + sql.execute("CREATE TABLE authors (id INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT UNIQUE NOT NULL);") + sql.close() + return 1 + + +def create_books(): + sql = sqlite3.connect("db.sqlite3") + try: + sql.execute("DROP TABLE books") + except: + pass + sql.execute( + "CREATE TABLE books(id INTEGER PRIMARY KEY AUTOINCREMENT, title TEXT, authorId INTEGER, FOREIGN KEY (authorId) REFERENCES author(id));") + sql.close() + return 1 + +def create_commentary(): + with sqlite3.connect("db.sqlite3") as sql: + try: + sql.execute("DROP TABLE commentary") + except: + pass + sql.execute( + """CREATE TABLE commentary( + text TEXT, + commentaryAuthorId INT, + source TEXT, + bookId INT, + chapter INT, + lineNumber INT, + FOREIGN KEY (bookId) REFERENCES books(id) + );""") + from fulltexts.commentary.commentary import commentary + for i in commentary: + for line in i["lineNumber"]: + confirm = sql.execute("""INSERT INTO commentary(text,commentaryAuthorId,source,bookId,chapter,lineNumber) + VALUES(?,?,?,?,?,?)""", + (i["text"],i["commentaryAuthorId"],i["source"],i["bookId"],i["chapter"],line)).lastrowid + if confirm is None: + print(f"Error adding commentary {i['source']}, {i['bookId']}, {i['chapter']}, {line}") + +def main(metadata): + create_authors() + create_books() + create_full_lines() + create_scrubbed_lines() + create_commentary() + for i in metadata: + # Insert Author + try: + with sqlite3.connect("db.sqlite3") as conn: + conn.execute("INSERT INTO authors(name) VALUES (?)", (i["author"],)) + except sqlite3.IntegrityError: + pass + # Insert Lines + with sqlite3.connect("db.sqlite3") as conn: + _, author_id = conn.execute("SELECT name,id FROM authors WHERE name=?", (i["author"],)).fetchone() + conn.execute("INSERT INTO books(title,authorId) VALUES (?,?)", (i["book"], author_id)) + for j in glob.glob(f'{i["path"]}*'): + print(j) + chapter = int(j.replace(i["path"], "").replace(i["book"], "").replace(".txt", "")) + add_scrubbed_lines_to_db(chapter, i["book"], None) + add_full_lines_to_db(chapter, i["book"], None) + + +if __name__ == "__main__": + # metadata = [ + # {"author": "homer", "book": "iliad", "path": "fulltexts/iliad/"}, + # {"author": "homer", "book": "odyssey", "path": "fulltexts/odyssey/"} + # ] + # main(metadata) + create_commentary() diff --git a/server/Setup.hs b/server/Setup.hs new file mode 100755 index 0000000..9a994af --- /dev/null +++ b/server/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/server/app/Main.hs b/server/app/Main.hs new file mode 100755 index 0000000..dfe9581 --- /dev/null +++ b/server/app/Main.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DeriveGeneric #-} + +module Main where + +import Control.Concurrent +import Control.Exception (bracket) +import Control.Monad.IO.Class +import Database.SQLite.Simple +import Network.Wai.Handler.Warp +import Servant +import Network.Wai.Middleware.Cors +import GHC.Generics +import Data.Aeson +import Data.Text + +data BookPage = BookPage { + title :: Text + , linesOfText :: ZipListLine + , chapter :: Int + , allBooks :: [Book] + } deriving ( Generic) + +instance ToJSON BookPage + +data BookPageCommentary = BookPageCommentary { + bpcTitle :: Text, + bpcLinesOfText :: ZipListLine, + bpcChapter :: Int, + bpcAllBooks :: [Book], + bpcCommentary :: [Commentary], + bpcLineNumber :: Int + } deriving (Generic) + +instance ToJSON BookPageCommentary + +data Line = Line { + lineText :: Text + , lineLineNumber :: Int + } deriving (Show, Generic) +instance FromRow Line where + fromRow = Line <$> field <*> field +instance ToJSON Line + +data ZipListLine = ZipListLine { + p1 :: [Line] + , p2 :: [Line] + , p3 :: [Line] + } deriving (Show,Generic) +instance ToJSON ZipListLine + +data Book = Book{ + bookTitle :: Text + , bookId :: Int + , numberOfChapters :: Int + } deriving (Show,Generic) + +instance FromRow Book where + fromRow = Book <$> field <*> field <*> field + +instance ToJSON Book + +data Commentary = Commentary { + commentaryText :: Text + ,commentaryAuthorId :: Text + , commentarySource :: Text + } deriving (Generic) +instance ToJSON Commentary +instance FromRow Commentary where + fromRow = Commentary <$> field <*>field<*>field -- <*>field<*>field<*>field + + +type API = Get '[JSON] [Book] + :<|> "books" :> Capture "title" Text :> Capture "chapter" Int :> Get '[JSON] BookPage + :<|> "books" :> Capture "title" Text :> Capture "chapter" Int :> Capture "lineNumber" Int :> Get '[JSON] BookPageCommentary + +allBooksQuery :: Query +allBooksQuery = "SELECT title, bookId, Count(DISTINCT chapter) FROM fullLines Inner JOIN books on books.id=fullLines.bookId GROUP BY bookId" +queryAllBooks :: FilePath -> IO [Book] +queryAllBooks dbfile = withConnection dbfile $ \conn -> query_ conn allBooksQuery + +bookChapterCommentaryQuery :: Query +bookChapterCommentaryQuery = "SELECT text, commentaryAuthorId, source FROM commentary INNER JOIN books ON books.id = commentary.bookId WHERE lineNumber = :lineNumber AND books.title = :title AND chapter = :chapter" +queryBookChapterCommentary :: Text -> Int-> Int ->FilePath-> IO [Commentary] +queryBookChapterCommentary title chapter lineNumber dbfile = withConnection dbfile $ \conn -> queryNamed conn bookChapterCommentaryQuery [":title" := title, ":chapter" := chapter, ":lineNumber" := lineNumber] + +zipListLineQuery1 :: Query +zipListLineQuery1 = "Select line,lineNumber FROM fullLines INNER JOIN books ON fullLines.bookId = books.id WHERE books.title = :title AND fullLines.chapter = :chapter AND lineNumber < :lineNumber ORDER BY lineNumber ASC" +zipListLineQuery2 :: Query +zipListLineQuery2 = "Select line,lineNumber FROM fullLines INNER JOIN books ON fullLines.bookId = books.id WHERE books.title = :title AND fullLines.chapter = :chapter AND lineNumber = :lineNumber ORDER BY lineNumber ASC" +zipListLineQuery3 :: Query +zipListLineQuery3 = "Select line,lineNumber FROM fullLines INNER JOIN books ON fullLines.bookId = books.id WHERE books.title = :title AND fullLines.chapter = :chapter AND lineNumber > :lineNumber ORDER BY lineNumber ASC" +zipListLineQuery :: Text -> Int-> Int -> FilePath -> IO ZipListLine +zipListLineQuery title chapter lineNumber dbfile = do + p1 <- withConnection dbfile $ \conn -> queryNamed conn zipListLineQuery1 [":title" := title, ":chapter" := chapter, ":lineNumber" := lineNumber] + p2 <- withConnection dbfile $ \conn -> queryNamed conn zipListLineQuery2 [":title" := title, ":chapter" := chapter, ":lineNumber" := lineNumber] + p3 <- withConnection dbfile $ \conn -> queryNamed conn zipListLineQuery3 [":title" := title, ":chapter" := chapter, ":lineNumber" := lineNumber] + return ZipListLine {p1=p1,p2=p2,p3=p3} + +bookChapterQuery :: Query +bookChapterQuery = "Select line,lineNumber FROM fullLines INNER JOIN books ON fullLines.bookId = books.id WHERE books.title = :book AND fullLines.chapter = :chapter ORDER BY lineNumber ASC" +queryLines :: Text-> Int -> FilePath ->IO [Line] +queryLines title chapter dbfile= withConnection dbfile $ \conn -> queryNamed conn bookChapterQuery [":book" :=title,":chapter":=chapter ] + +api :: Proxy API +api = Proxy + +server dbfile = listAllBooks + :<|> getBookPageWithChapter + :<|> getBookPageWithChapterWithCommentary + + where + listAllBooks :: Handler [Book] + listAllBooks = liftIO (queryAllBooks dbfile) + + getBookPageWithChapter :: Text -> Int -> Handler BookPage + getBookPageWithChapter title chapter = do + lines <- liftIO (zipListLineQuery title chapter 1 dbfile) + allBooks <- liftIO (queryAllBooks dbfile) + return BookPage {title=title,chapter=chapter,linesOfText=lines, allBooks= allBooks } + + getBookPageWithChapterWithCommentary :: Text -> Int -> Int -> Handler BookPageCommentary + getBookPageWithChapterWithCommentary title chapter lineNumber = do + lines <- liftIO (zipListLineQuery title chapter lineNumber dbfile) + allBooks <- liftIO (queryAllBooks dbfile) + commentary <- liftIO (queryBookChapterCommentary title chapter lineNumber dbfile) + return BookPageCommentary {bpcTitle=title, bpcChapter=chapter, bpcLinesOfText=lines,bpcAllBooks=allBooks,bpcCommentary =commentary,bpcLineNumber=lineNumber} + + + + +runApp :: FilePath -> IO () +runApp dbfile = run 8080 (simpleCors $ (serve api $ server dbfile)) + + +main :: IO () +main = do + -- you could read this from some configuration file, + -- environment variable or somewhere else instead. + let dbfile = "../db.sqlite3" + runApp dbfile diff --git a/server/package.yaml b/server/package.yaml new file mode 100755 index 0000000..b40c833 --- /dev/null +++ b/server/package.yaml @@ -0,0 +1,56 @@ +name: server +version: 0.1.0.0 +github: "githubuser/server" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2021 Author name here" + +# 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 + +dependencies: + - base >= 4.7 && < 5 + - servant + - servant-client + - servant-server + - sqlite-simple + - wai + - http-types + - warp + - text + - aeson + - transformers + - wai-cors + +library: + source-dirs: src + +executables: + server-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - server + + +tests: + server-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - server diff --git a/server/server.cabal b/server/server.cabal new file mode 100755 index 0000000..d93807b --- /dev/null +++ b/server/server.cabal @@ -0,0 +1,89 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: server +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/server#readme +bug-reports: https://github.com/githubuser/server/issues +author: Author name here +maintainer: example@example.com +copyright: 2021 Author name here +license: BSD3 +build-type: Simple + +source-repository head + type: git + location: https://github.com/githubuser/server + +library + exposed-modules: + Lib + other-modules: + Paths_server + hs-source-dirs: + src + build-depends: + aeson + , base >=4.7 && <5 + , http-types + , servant + , servant-client + , servant-server + , sqlite-simple + , text + , transformers + , wai + , wai-cors + , warp + default-language: Haskell2010 + +executable server-exe + main-is: Main.hs + other-modules: + Paths_server + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , base >=4.7 && <5 + , http-types + , servant + , servant-client + , servant-server + , server + , sqlite-simple + , text + , transformers + , wai + , wai-cors + , warp + default-language: Haskell2010 + +test-suite server-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_server + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , base >=4.7 && <5 + , http-types + , servant + , servant-client + , servant-server + , server + , sqlite-simple + , text + , transformers + , wai + , wai-cors + , warp + default-language: Haskell2010 diff --git a/server/src/Lib.hs b/server/src/Lib.hs new file mode 100755 index 0000000..d36ff27 --- /dev/null +++ b/server/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/server/stack.yaml b/server/stack.yaml new file mode 100755 index 0000000..3a72859 --- /dev/null +++ b/server/stack.yaml @@ -0,0 +1,67 @@ +# 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: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/16.yaml + +# 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.7" +# +# 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 diff --git a/server/stack.yaml.lock b/server/stack.yaml.lock new file mode 100755 index 0000000..cfbb00a --- /dev/null +++ b/server/stack.yaml.lock @@ -0,0 +1,13 @@ +# 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 + +snapshots: +- original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/16.yaml + completed: + sha256: cdead65fca0323144b346c94286186f4969bf85594d649c49c7557295675d8a5 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/16.yaml + size: 586286 +packages: [] diff --git a/src/Main.elm b/src/Main.elm new file mode 100755 index 0000000..b01a8e8 --- /dev/null +++ b/src/Main.elm @@ -0,0 +1,366 @@ +module Main exposing (main) + +import Array +import Browser +import Dict +import Element exposing (alignLeft, alignRight, alignTop, padding, px, spaceEvenly, spacing, width) +import Element.Background as Background +import Element.Border as Border +import Element.Events as Events exposing (onClick) +import Element.Region as Region +import Html +import Http +import Json.Decode as Decode exposing (Decoder, int, list, string, oneOf) +import Json.Decode.Pipeline exposing (custom, hardcoded, required) +import RemoteData exposing (RemoteData(..), WebData) +import RemoteData.Http +import Url.Builder exposing (crossOrigin) + + +type Model + = BookPage_ (WebData BookPage) + | BookPageCommentary_ (WebData BookPageCommentary) + + +type alias ZipListLine = { p1 : List Line, p2 : List Line, p3 : List Line} +type alias BookPage = + { title : String + , linesOfText : ZipListLine + , chapter : Int + , allBooks : List Book + } + + +type alias BookPageCommentary = + { title : String + , linesOfText : ZipListLine + , chapter : Int + , allBooks : List Book + , commentary : List Commentary + , lineNumber : Int + } + + +type alias Commentary = + { text : String + , commentaryAuthorId : String + , source : String + } + + +type alias Book = + { bookTitle : String + , bookId : Int + , numberOfChapters : Int + } + + +type alias Line = + { text : String + , lineNumber : Int + } + + +type Msg + = HandleBookPageResponse (WebData BookPage) + | FetchBookPage String Int + | FetchBookPageCommentary String Int Int + | HandleBookPageCommentaryResponse (WebData BookPageCommentary) + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( BookPage_ Loading + , fetchBookPageCmd "iliad" 1 + ) + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.none + + +bookPageCommentaryDecoder : Decoder BookPageCommentary +bookPageCommentaryDecoder = + Decode.succeed BookPageCommentary + |> required "bpcTitle" string + |> required "bpcLinesOfText" zipListLineDecoder + |> required "bpcChapter" int + |> required "bpcAllBooks" (list bookDecoder) + |> required "bpcCommentary" (list commentaryDecoder) + |> required "bpcLineNumber" int + +zipListLineDecoder : Decoder ZipListLine +zipListLineDecoder = + Decode.succeed ZipListLine + |> required "p1" (list lineDecoder) + |> required "p2" (list lineDecoder) + |> required "p3" (list lineDecoder) + +commentaryDecoder : Decoder Commentary +commentaryDecoder = + Decode.succeed Commentary + |> required "commentaryText" string + |> required "commentaryAuthorId" string + |> required "commentarySource" string + + +bookPageDecoder : Decoder BookPage +bookPageDecoder = + Decode.succeed BookPage + |> required "title" string + |> required "linesOfText" zipListLineDecoder + |> required "chapter" int + |> required "allBooks" (list bookDecoder) + + +lineDecoder : Decoder Line +lineDecoder = + Decode.succeed Line + |> required "lineText" string + |> required "lineLineNumber" int + + +bookDecoder : Decoder Book +bookDecoder = + Decode.succeed Book + |> required "bookTitle" string + |> required "bookId" int + |> required "numberOfChapters" int + + +decodeError : Model -> Http.Error -> Browser.Document Msg +decodeError model error = + case error of + Http.BadUrl string -> + { title = "Bad Url" + , body = [ Element.layout [] (Element.text ("Error: " ++ string)) ] + } + + Http.Timeout -> + { title = "Timeout" + , body = [ Element.layout [] (Element.text "timeout") ] + } + + Http.NetworkError -> + { title = "Network Error" + , body = [ Element.layout [] (Element.text "network error") ] + } + + Http.BadStatus int -> + { title = "Bad Status" + , body = [ Element.layout [] (Element.text ("Error: " ++ String.fromInt int)) ] + } + + Http.BadBody string -> + { title = "Bad Body" + , body = [ Element.layout [] (Element.text ("Error: " ++ string)) ] + } + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + FetchBookPage title chapter -> + ( model, fetchBookPageCmd title chapter ) + + FetchBookPageCommentary title chapter lineNumber -> + ( model, fetchBookPageCommentaryCmd title chapter lineNumber ) + + HandleBookPageResponse data -> + ( BookPage_ data, Cmd.none ) + + HandleBookPageCommentaryResponse data -> + ( BookPageCommentary_ data, Cmd.none ) + + +view : Model -> Browser.Document Msg +view model = + case model of + BookPage_ data -> + case data of + NotAsked -> + { title = "Not Asked" + , body = [ Element.layout [] (Element.text "Not Asked") ] + } + + Failure error -> + decodeError model error + + Loading -> + { title = "Loading" + , body = [ Element.layout [] (Element.text "Loading") ] + } + + Success bookPage -> + { title = + String.join " " + [ bookPage.title + , String.append "Chapter " (String.fromInt bookPage.chapter) + ] + , body = + [ viewPageComposition bookPage ] + } + + BookPageCommentary_ data -> + case data of + NotAsked -> + { title = "Not Asked" + , body = [ Element.layout [] (Element.text "Not Asked") ] + } + + Failure error -> + decodeError model error + + Loading -> + { title = "Loading" + , body = [ Element.layout [] (Element.text "Loading") ] + } + + Success page -> + { title = + String.join " " + [ page.title + , String.append "Chapter " (String.fromInt page.chapter) + ] + , body = + [ viewPageComposition page + ] + } + +viewPageComposition page = Element.layout [ spaceEvenly, Element.inFront viewTopNavigation , Element.width Element.fill] <| + Element.column [ padding 20 ] + [viewNavigationOffSet, + Element.row [ padding 10, spacing 20, Element.explain Debug.todo ] + ([ viewAllBooks page.allBooks + , Element.textColumn [ spacing 5 ] + [ Element.text + (String.join " " + [ page.title + , String.append "Chapter " (String.fromInt page.chapter) + ] + ) + , viewAllLines page.title page.chapter page.linesOfText page.commentary + ] + ] ) + ] + +viewBookPageCommentary bookPageCommentary = [Element.column [ spacing 5, alignTop ] + [ Element.el [Region.heading 1] (Element.text "Word Analysis") + , viewWordAnalysis (Array.get (bookPageCommentary.lineNumber-1) (Array.fromList bookPageCommentary.linesOfText)) + , Element.el [ Region.heading 1 ] (Element.text "Commentary") + , Element.column [] (List.map viewCommentary bookPageCommentary.commentary) + ]] + +viewWordAnalysis : Maybe Line -> Element.Element Msg +viewWordAnalysis maybe = + case maybe of + Just line -> + Element.column [] (List.map viewWord (String.split " " (line.text)) ) + Nothing -> + Element.text "Error: No text could be found" + +viewWord word = + Element.el [] (Element.text word) + +viewHomePage_ = + Element.text "Home Page" + + +viewAllBooks books = + Element.column [ spacing 5, alignTop ] (List.map viewBook books) + + +viewBook : Book -> Element.Element Msg +viewBook book = + Element.column [] + [ Element.text book.bookTitle + , Element.wrappedRow [] (List.map (viewChapter book) (List.range 1 book.numberOfChapters)) + ] + +viewChapter : Book -> Int -> Element.Element Msg +viewChapter book chapter = + Element.el [ padding 2, onClick (FetchBookPage book.bookTitle chapter) ] (Element.text (String.fromInt chapter)) + + +viewLine : String -> Int -> Line -> Element.Element Msg +viewLine title chapter line = + Element.row [] + [ Element.el [ alignLeft, width (px 50) ] (Element.text (String.fromInt line.lineNumber)) + , Element.el [ padding 15, onClick (FetchBookPageCommentary title chapter line.lineNumber) ] (Element.text line.text) + ] + + + +viewCommentaryLine : String -> Int ->List Line -> Commentary -> Element.Element Msg +viewCommentaryLine title chapter listLine commentary = + let res = List.head listLine + in + case res of + Just line -> + Element.row [] + [ Element.el [ alignLeft, width (px 50), Element.onRight (viewCommentary commentary )] (Element.text (String.fromInt line.lineNumber)) + , Element.el [ padding 15, onClick (FetchBookPageCommentary title chapter line.lineNumber) ] (Element.text line.text) + ] + Nothing -> + Element.none + +viewAllLines : String -> Int -> ZipListLine -> Commentary -> Element.Element Msg +viewAllLines title chapter zipListLine commentary= + Element.textColumn [] (List.concat [ + (List.map (viewLine title chapter) zipListLine.p1) + , [viewCommentaryLine title chapter zipListLine.p2 commentary] + , (List.map (viewLine title chapter) zipListLine.p3) + ]) + +navigationOffSet = {top=25,bottom=0,right=0,left=0} +viewNavigationOffSet= + Element.el [ Element.width Element.fill, Region.navigation, alignTop, Element.paddingEach navigationOffSet,spacing 20] Element.none + +viewTopNavigation = + Element.row [ Background.color navColorWhite, Element.width Element.fill, Region.navigation, Border.widthEach navBorders, alignTop, padding 10 , Element.height (Element.px 25) ] + [ Element.el [ alignLeft ] (Element.text "Logo") + , Element.el [ alignRight ] (Element.text "Settings") + ] + + +navBorders = + { bottom = 1 + , left = 0 + , right = 0 + , top = 0 + } +navColorWhite = Element.fromRgb255 { + red = 255, + green= 255, + blue= 255, + alpha= 255 + } + +viewCommentary : Commentary -> Element.Element Msg +viewCommentary commentary = + Element.paragraph [ padding 5, spacing 5 ] + [ Element.el [] (Element.text commentary.text) + , Element.el [] (Element.text commentary.source) + , Element.el [] (Element.text commentary.commentaryAuthorId) + ] + + + +main = + Browser.document + { init = init + , view = view + , subscriptions = subscriptions + , update = update + } + + +fetchBookPageCmd : String -> Int -> Cmd Msg +fetchBookPageCmd title chapter = + RemoteData.Http.getWithConfig RemoteData.Http.defaultConfig (crossOrigin "http://localhost:8080/books" [ title, String.fromInt chapter ] []) HandleBookPageResponse bookPageDecoder + + +fetchBookPageCommentaryCmd : String -> Int -> Int -> Cmd Msg +fetchBookPageCommentaryCmd title chapter lineNumber = + RemoteData.Http.getWithConfig RemoteData.Http.defaultConfig (crossOrigin "http://localhost:8080/books" [ title, String.fromInt chapter, String.fromInt lineNumber ] []) HandleBookPageCommentaryResponse bookPageCommentaryDecoder diff --git a/src/SharedTypes.elm b/src/SharedTypes.elm new file mode 100755 index 0000000..74e908a --- /dev/null +++ b/src/SharedTypes.elm @@ -0,0 +1,37 @@ +module SharedTypes exposing (..) + + +type alias BookPage = + { title : String + , linesOfText : List Line + , chapter : Int + , allBooks : List Book + } + + +type alias BookCommentaryPage = + { title : String + , linesOfText : List Line + , chapter : Int + , allBooks : List Book + , commentary : List Commentary + } + + +type alias Commentary = + { text : String + , author : String + , source : String + } + + +type alias Book = + { bookTitle : String + , bookId : Int + } + + +type alias Line = + { text : String + , lineNumber : Int + }