nanq 1.1.1 → 2.0.0

raw patch · 26 files changed

+545/−483 lines, 26 filesdep +aesondep +aeson-prettydep +extensible-effectsdep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, aeson-pretty, extensible-effects, microlens-aeson, optparse-applicative

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• Data/Kanji.hs +39/−153
• Data/Kanji/EighthQ.hs +0/−15
• Data/Kanji/FifthQ.hs +0/−15
• Data/Kanji/FourthQ.hs +0/−20
• Data/Kanji/Level/EighthQ.hs +15/−0
• Data/Kanji/Level/FifthQ.hs +15/−0
• Data/Kanji/Level/FourthQ.hs +20/−0
• Data/Kanji/Level/NinthQ.hs +13/−0
• Data/Kanji/Level/PreSecondQ.hs +21/−0
• Data/Kanji/Level/SecondQ.hs +14/−0
• Data/Kanji/Level/SeventhQ.hs +15/−0
• Data/Kanji/Level/SixthQ.hs +15/−0
• Data/Kanji/Level/TenthQ.hs +9/−0
• Data/Kanji/Level/ThirdQ.hs +20/−0
• Data/Kanji/NinthQ.hs +0/−13
• Data/Kanji/PreSecondQ.hs +0/−21
• Data/Kanji/SecondQ.hs +0/−14
• Data/Kanji/SeventhQ.hs +0/−15
• Data/Kanji/SixthQ.hs +0/−15
• Data/Kanji/TenthQ.hs +0/−9
• Data/Kanji/ThirdQ.hs +0/−20
• Data/Kanji/Types.hs +125/−0
• README.md +95/−0
• nanq.cabal +34/−25
• nanq.hs +91/−148

@@ -0,0 +1,4 @@+2.0.0+-----+- New JSON-only output+- Revamped, modernized backend

@@ -1,8 +1,6 @@-{-# LANGUAGE FlexibleInstances #-}- -- | -- Module    : Data.Kanji--- Copyright : (c) Colin Woodbury, 2015+-- Copyright : (c) Colin Woodbury, 2015, 2016 -- License   : GPL3 -- Maintainer: Colin Woodbury <colingw@gmail.com> --@@ -15,7 +13,6 @@          -- * Kanji          AsKanji(..)        , Kanji(..)-       , kanji        , allKanji        , isKanji        , hasLevel@@ -24,8 +21,7 @@        , percentSpread          -- * Levels        , Level(..)-       , Rank-       , rankNums+       , Rank(..)        , level        , levels        , isKanjiInLevel@@ -34,123 +30,24 @@        , averageLevel        ) where -import qualified Data.ByteString.Char8 as SB-import qualified Data.ByteString.Lazy.Char8 as LB-import           Data.Char (ord) import           Data.List (sort, group) import qualified Data.Set as S-import qualified Data.Text as ST-import qualified Data.Text.Lazy as LT import           Lens.Micro -import           Data.Kanji.TenthQ-import           Data.Kanji.NinthQ-import           Data.Kanji.EighthQ-import           Data.Kanji.SeventhQ-import           Data.Kanji.SixthQ-import           Data.Kanji.FifthQ-import           Data.Kanji.FourthQ-import           Data.Kanji.ThirdQ-import           Data.Kanji.PreSecondQ-import           Data.Kanji.SecondQ+import           Data.Kanji.Level.EighthQ+import           Data.Kanji.Level.FifthQ+import           Data.Kanji.Level.FourthQ+import           Data.Kanji.Level.NinthQ+import           Data.Kanji.Level.PreSecondQ+import           Data.Kanji.Level.SecondQ+import           Data.Kanji.Level.SeventhQ+import           Data.Kanji.Level.SixthQ+import           Data.Kanji.Level.TenthQ+import           Data.Kanji.Level.ThirdQ+import           Data.Kanji.Types  --- --- | Anything that can be transformed in a list of Kanji.-class AsKanji a where--  -- | Traverse into this type to find 0 or more Kanji.-  ---  -- Despite what the Haddock documentation says, this is part of the-  -- minimal complete definition.-  _Kanji :: Traversal' a Kanji--  -- | How long is this input source?-  len :: Num b => a -> b--  -- | Transform this string type into a list of Kanji. The source string-  -- and the resulting list might not have the same length, if there-  -- were `Char` in the source that did not fall within the legal-  -- UTF8 range for Kanji.-  asKanji :: a -> [Kanji]-  asKanji a = a ^.. _Kanji--instance AsKanji Char where-  _Kanji f c = if isKanji c then _kanji <$> f (Kanji c) else pure c--  len = const 1--instance AsKanji [Char] where-  _Kanji = traverse . _Kanji--  len = fromIntegral . length--instance AsKanji ST.Text where-  _Kanji = packed . _Kanji-    where packed f b = ST.pack <$> f (ST.unpack b)--  len = fromIntegral . ST.length--instance AsKanji LT.Text where-  _Kanji = packed . _Kanji-    where packed f b = LT.pack <$> f (LT.unpack b)--  len = fromIntegral . LT.length--instance AsKanji SB.ByteString where-  _Kanji = packed . _Kanji-    where packed f b = SB.pack <$> f (SB.unpack b)--  len = fromIntegral . SB.length--instance AsKanji LB.ByteString where-  _Kanji = packed . _Kanji-    where packed f b = LB.pack <$> f (LB.unpack b)--  len = fromIntegral . LB.length          ---- | A single symbol of Kanji. Japanese Kanji were borrowed from China--- over several waves during the past millenium. Japan names 2136 of--- these as their standard set, with rarer characters being the domain--- of academia and esoteric writers.------ Japanese has several Japan-only Kanji, including:------ * 畑 (a type of rice field)--- * 峠 (a narrow mountain pass)--- * 働 (to do physical labour)-newtype Kanji = Kanji { _kanji :: Char } deriving (Eq, Ord, Show)--{-# DEPRECATED kanji "Use _Kanji instead" #-}-kanji :: Traversal' Char Kanji-kanji = _Kanji---- | A Level or "Kyuu" (級) of Japanese Kanji ranking. There are 12 of these,--- from 10 to 1, including intermediate levels between 3 and 2, and 2 and 1.------ Japanese students will typically have Level-5 ability by the time they--- finish elementary school. Level-5 accounts for 1006 characters.------ By the end of middle school, they would have covered up to Level-3--- (1607 Kanji) in their Japanese class curriculum.------ While Level-2 (2136 Kanji) is considered "standard adult" ability,--- many adults could not pass the Level-2, or even the Level-Pre2 (1940 Kanji)--- exam without considerable study.------ Level data for Kanji above Level-2 is currently not provided by--- this library.-data Level = Level { _allKanji :: S.Set Kanji-                   , _rank :: Rank-                   } deriving (Eq, Show)---- | A numeric representation of a `Level`.-type Rank = Float---- | Numerical representations of the 12 ranks.-rankNums :: [Rank]-rankNums = [10,9,8,7,6,5,4,3,2.5,2,1.5,1]- -- | All Kanji, grouped by their Level (級) in ascending order. -- Here, ascending order means from the lowest to the highest level, -- meaning from 10 to 1.@@ -159,70 +56,59 @@   where ks = [tenthQ, ninthQ, eighthQ, seventhQ, sixthQ,               fifthQ, fourthQ, thirdQ, preSecondQ, secondQ] --- | Legal Kanji appear between UTF8 characters 19968 and 40959.-isKanji :: Char -> Bool-isKanji c = lowLimit <= c' && c' <= highLimit-    where c' = ord c-          lowLimit  = 19968  -- This is `一`-          highLimit = 40959  -- I don't have the right fonts to display this.- -- | Is the `Level` of a given `Kanji` known?-hasLevel :: [Level] -> Kanji -> Bool-hasLevel qs k = has _Just $ level qs k+hasLevel :: Kanji -> Bool+hasLevel k = has _Just $ level k  -- | What is the density @d@ of Kanji characters in a given String-like -- type, where @0 <= d <= 1@?-kanjiDensity :: AsKanji a => a -> Float-kanjiDensity ks = length' (asKanji ks) / len ks-  where length' = fromIntegral . length+kanjiDensity :: AsKanji a => a -> [Kanji] -> Float+kanjiDensity orig ks = fromIntegral (length ks) / len orig  -- | As above, but only Kanji of the first 1006 are counted (those learned -- in elementary school in Japan).-elementaryKanjiDensity :: AsKanji a => a -> Float+elementaryKanjiDensity :: [Kanji] -> Float elementaryKanjiDensity ks = foldl (\acc (_,p) -> acc + p) 0 elementaryQs-  where elementaryQs  = filter (\(qn,_) -> qn `elem` [5..10]) distributions-        distributions = levelDist levels $ asKanji ks+  where elementaryQs  = filter (\(qn,_) -> qn `elem` [Five, Six ..]) dists+        dists = levelDist ks  makeLevel :: [Kanji] -> Rank -> Level makeLevel ks n = Level (S.fromDistinctAscList ks) n  -- | All `Level`s, with all their `Kanji`, ordered from Level-10 to Level-2. levels :: [Level]-levels = map f $ zip allKanji rankNums+levels = map f $ zip allKanji [Ten ..]   where f (ks,n) = makeLevel ks n  -- | What `Level` does a Kanji belong to?-level :: [Level] -> Kanji -> Maybe Level-level [] _     = Nothing-level (q:qs) k | isKanjiInLevel q k = Just q-               | otherwise = level qs k+level :: Kanji -> Maybe Level+level = level' levels+  where level' [] _     = Nothing+        level' (q:qs) k | isKanjiInLevel q k = Just q+                        | otherwise = level' qs k  -- | Does a given `Kanji` belong to the given `Level`? isKanjiInLevel :: Level -> Kanji -> Bool isKanjiInLevel q k = S.member k $ _allKanji q --- | Some Kanji may be outside the Level system. This means they are--- particularly difficult, and are given a rank of 0 here.--- This is used internally for averaging calculations.-rank :: [Level] -> Kanji -> Rank-rank qs k = maybe 0 _rank $ level qs k- -- | Is there a `Level` that corresponds with a given `Rank` value?-levelFromRank :: [Level] -> Rank -> Maybe Level-levelFromRank [] _      = Nothing-levelFromRank (q:qs) qn | _rank q == qn = Just q-                        | otherwise     = levelFromRank qs qn+levelFromRank :: Rank -> Maybe Level+levelFromRank = levelFromRank' levels+  where levelFromRank' [] _      = Nothing+        levelFromRank' (q:qs) qn | _rank q == qn = Just q+                                 | otherwise     = levelFromRank' qs qn  -- | Find the average `Level` of a given set of `Kanji`.-averageLevel :: [Level] -> [Kanji] -> Float-averageLevel qs ks = average $ map (rank qs) ks-  where average ns = (sum ns) / (fromIntegral $ length ns) +averageLevel :: [Kanji] -> Float+averageLevel ks = average ranks+  where ranks = ks ^.. each . to level . _Just . to _rank . to fromRank+        average ns = (sum ns) / (fromIntegral $ length ns)   -- | How much of each `Level` is represented by a group of Kanji?-levelDist :: [Level] -> [Kanji] -> [(Rank,Float)]-levelDist qs ks = map toNumPercentPair $ group sortedRanks-  where sortedRanks = sort $ map (rank qs) ks-        toNumPercentPair qns = (head qns, length' qns / length' sortedRanks)+levelDist :: [Kanji] -> [(Rank,Float)]+levelDist ks = map toNumPercentPair $ group sortedRanks+  where sortedRanks = sort $ ks ^.. each . to level . _Just . to _rank+        toNumPercentPair qns = (head qns, length' qns / length' ks)         length' n = fromIntegral $ length n  -- | The distribution of each `Kanji` in a set of them.

@@ -1,15 +0,0 @@-module Data.Kanji.EighthQ where ---- | The Kanji unique to Level-8, studied by the end of 3rd grade in--- Japanese elementary schools.-eighthQ :: [Char]-eighthQ = "丁世両主乗予事仕他代住使係倍全具写列助勉" ++-          "動勝化区医去反取受号向君味命和品員商問坂" ++-          "央始委守安定実客宮宿寒対局屋岸島州帳平幸" ++-          "度庫庭式役待急息悪悲想意感所打投拾持指放" ++-          "整旅族昔昭暑暗曲有服期板柱根植業様横橋次" ++-          "歯死氷決油波注泳洋流消深温港湖湯漢炭物球" ++-          "由申界畑病発登皮皿相県真着短研礼神祭福秒" ++-          "究章童笛第筆等箱級終緑練羊美習者育苦荷落" ++-          "葉薬血表詩調談豆負起路身転軽農返追送速進" ++-          "遊運部都配酒重鉄銀開院陽階集面題飲館駅鼻"

@@ -1,15 +0,0 @@-module Data.Kanji.FifthQ where ---- | The Kanji unique to Level-5, studied by the end of 6th grade in--- Japanese elementary schools.-fifthQ :: [Char]-fifthQ = "並乱乳亡仁供俳値傷優党冊処刻割創劇勤危卵" ++-         "厳収后否吸呼善困垂城域奏奮姿存孝宅宇宗宙" ++-         "宝宣密寸専射将尊就尺届展層己巻幕干幼庁座" ++-         "延律従忘忠憲我批担拝拡捨探推揮操敬映晩暖" ++-         "暮朗机枚染株棒模権樹欲段沿泉洗派済源潮激" ++-         "灰熟片班異疑痛皇盛盟看砂磁私秘穀穴窓筋策" ++-         "簡糖系紅納純絹縦縮署翌聖肺背胸脳腹臓臨至" ++-         "若著蒸蔵蚕衆裁装裏補視覧討訪訳詞誌認誕誠" ++-         "誤論諸警貴賃遺郵郷針鋼閉閣降陛除障難革頂" ++-         "骨"

@@ -1,20 +0,0 @@-module Data.Kanji.FourthQ where ---- | The Kanji unique to Level-4, studied during middle school in Japan.-fourthQ :: [Char]-fourthQ = "丈与丘丹乾互井介仰伺依侵俗倒偉傍傾僧儀兼" ++-          "冒凡凶刈到刺剣剤劣勧匹占即却及叫召吐含吹" ++-          "咲唐嘆噴圏坊執堅堤塔壁壊壱奇奥奴妙姓威娘" ++-          "婚寂寝尋尽尾屈峠峰巡巨帽幅幾床弐弾彩影彼" ++-          "征御微徴忙怒怖恋恐恒恥恵悩惑惨慎慢慮憶戒" ++-          "戯扇払扱抗抜抱抵押拍拓拠振捕掘描握援搬摘" ++-          "撃攻敏敷斜旨旬是普暇暦曇更替朱朽杯枯柄柔" ++-          "桃欄歓歳殖殿汗汚沈沖沢沼況泊浜浮浸涙淡添" ++-          "渡溶滴漫澄濁濃為烈煙煮燥爆狂狩狭猛獣獲玄" ++-          "珍環甘畳疲療皆盆盗監盤盾眠瞬矛砲祈秀称稲" ++-          "稿突端箇範粒紋紫紹絡継維網緯縁繁繰罰翼耐" ++-          "肩肪胴脂脚脱腐腕腰膚致舗舞舟般芋芝茂荒菓" ++-          "蓄薄薪被襲触訴詰詳誇誉謡豪販賦贈越趣距跡" ++-          "跳踊踏躍軒較載輝輩込迎迫逃透途遅違遣避郎" ++-          "釈鈍鉛鋭鎖鑑闘陣陰隠隣隷雄雅雌離雷需震霧" ++-          "露響項頼飾香駆騒驚髪鬼鮮麗黙鼓齢"

@@ -0,0 +1,15 @@+module Data.Kanji.Level.EighthQ where ++-- | The Kanji unique to Level-8, studied by the end of 3rd grade in+-- Japanese elementary schools.+eighthQ :: [Char]+eighthQ = "丁世両主乗予事仕他代住使係倍全具写列助勉" +++          "動勝化区医去反取受号向君味命和品員商問坂" +++          "央始委守安定実客宮宿寒対局屋岸島州帳平幸" +++          "度庫庭式役待急息悪悲想意感所打投拾持指放" +++          "整旅族昔昭暑暗曲有服期板柱根植業様横橋次" +++          "歯死氷決油波注泳洋流消深温港湖湯漢炭物球" +++          "由申界畑病発登皮皿相県真着短研礼神祭福秒" +++          "究章童笛第筆等箱級終緑練羊美習者育苦荷落" +++          "葉薬血表詩調談豆負起路身転軽農返追送速進" +++          "遊運部都配酒重鉄銀開院陽階集面題飲館駅鼻"

@@ -0,0 +1,15 @@+module Data.Kanji.Level.FifthQ where ++-- | The Kanji unique to Level-5, studied by the end of 6th grade in+-- Japanese elementary schools.+fifthQ :: [Char]+fifthQ = "並乱乳亡仁供俳値傷優党冊処刻割創劇勤危卵" +++         "厳収后否吸呼善困垂城域奏奮姿存孝宅宇宗宙" +++         "宝宣密寸専射将尊就尺届展層己巻幕干幼庁座" +++         "延律従忘忠憲我批担拝拡捨探推揮操敬映晩暖" +++         "暮朗机枚染株棒模権樹欲段沿泉洗派済源潮激" +++         "灰熟片班異疑痛皇盛盟看砂磁私秘穀穴窓筋策" +++         "簡糖系紅納純絹縦縮署翌聖肺背胸脳腹臓臨至" +++         "若著蒸蔵蚕衆裁装裏補視覧討訪訳詞誌認誕誠" +++         "誤論諸警貴賃遺郵郷針鋼閉閣降陛除障難革頂" +++         "骨"

@@ -0,0 +1,20 @@+module Data.Kanji.Level.FourthQ where ++-- | The Kanji unique to Level-4, studied during middle school in Japan.+fourthQ :: [Char]+fourthQ = "丈与丘丹乾互井介仰伺依侵俗倒偉傍傾僧儀兼" +++          "冒凡凶刈到刺剣剤劣勧匹占即却及叫召吐含吹" +++          "咲唐嘆噴圏坊執堅堤塔壁壊壱奇奥奴妙姓威娘" +++          "婚寂寝尋尽尾屈峠峰巡巨帽幅幾床弐弾彩影彼" +++          "征御微徴忙怒怖恋恐恒恥恵悩惑惨慎慢慮憶戒" +++          "戯扇払扱抗抜抱抵押拍拓拠振捕掘描握援搬摘" +++          "撃攻敏敷斜旨旬是普暇暦曇更替朱朽杯枯柄柔" +++          "桃欄歓歳殖殿汗汚沈沖沢沼況泊浜浮浸涙淡添" +++          "渡溶滴漫澄濁濃為烈煙煮燥爆狂狩狭猛獣獲玄" +++          "珍環甘畳疲療皆盆盗監盤盾眠瞬矛砲祈秀称稲" +++          "稿突端箇範粒紋紫紹絡継維網緯縁繁繰罰翼耐" +++          "肩肪胴脂脚脱腐腕腰膚致舗舞舟般芋芝茂荒菓" +++          "蓄薄薪被襲触訴詰詳誇誉謡豪販賦贈越趣距跡" +++          "跳踊踏躍軒較載輝輩込迎迫逃透途遅違遣避郎" +++          "釈鈍鉛鋭鎖鑑闘陣陰隠隣隷雄雅雌離雷需震霧" +++          "露響項頼飾香駆騒驚髪鬼鮮麗黙鼓齢"

@@ -0,0 +1,13 @@+module Data.Kanji.Level.NinthQ where ++-- | The Kanji unique to Level-9, studied by the end of 2nd grade in+-- Japanese elementary schools.+ninthQ :: [Char]+ninthQ = "万丸交京今会体何作元兄光公内冬刀分切前北" +++         "午半南原友古台合同回図国園地場声売夏外多" +++         "夜太妹姉室家寺少岩工市帰広店弓引弟弱強当" +++         "形後心思戸才教数新方明星春昼時晴曜書朝来" +++         "東楽歌止歩母毎毛池汽活海点父牛理用画番直" +++         "矢知社秋科答算米紙細組絵線羽考聞肉自船色" +++         "茶行西親角言計記話語読谷買走近通週道遠里" +++         "野長門間雪雲電頭顔風食首馬高魚鳥鳴麦黄黒"

@@ -0,0 +1,21 @@+module Data.Kanji.Level.PreSecondQ where ++-- | The Kanji unique to Level-Pre2, considerend "mid high school" level.+preSecondQ :: [Char]+preSecondQ = "且丙亜享亭仙伯但佐併侮侯俊俸倫偏偵偽傑傘" +++             "僕僚儒償充准凸凹刃剖剛剰劾勅勲升厄叔叙吟" +++             "呈呉唆唇唯喝喪嗣嚇囚坪垣培堀堕堪塀塁塑塚" +++             "塾壌壮奔奨妃妄妊妥姻娠媒嫌嫡宜宰宵寛寡寧" +++             "寮尉尚尼履屯岬崇崎帥幣庶庸廃廷弊弔弦彰循" +++             "徹忍恭悠患悼惰愁愉慶憤憾懇懐懲懸戻扉扶抄" +++             "把披抹拐拒拙括拷挑挟挿捜据搭摩撤撲擬斉斎" +++             "旋昆暁曹朕朴杉析枠枢柳栓核栽桟棚棟棺槽款" +++             "殉殻汁江沸泡泥泰洞津洪浄浦涯涼淑渇渉渋渓" +++             "渦溝滋漆漠漬漸潟濯煩爵猫献猶猿珠琴璽瓶甚" +++             "畝疎疫症痢痴癒盲眺睡督矯砕硝硫碁磨礁祥禅" +++             "禍租秩稼窃窮窯竜筒粛粧糾紡索累紳緒縄繊繭" +++             "缶罷羅翁耗肌肖肢肯臭舶艇艦茎荘菌薦薫藻虜" +++             "虞蚊蛇蛍融衡衷裕褐褒襟覇訟診詐詔誓諭謁謄" +++             "謙謹譜貞貢賄賓賜賠購践軟轄迅迭逐逓逝逸遍" +++             "遮遷還邸酌酢酪酬酷醜醸釣鈴鉢銃銘閑閥附陥" +++             "隅雰霜靴韻頑頒頻顕飢駄騰麻"

@@ -0,0 +1,14 @@+module Data.Kanji.Level.SecondQ where ++-- | The Kanji unique to Level-2, considered "standard adult" level.+secondQ :: [Char]+secondQ = "串丼乞亀伎侶俺傲僅冥冶凄刹剥勃勾匂叱呂呪" +++          "咽哺唄唾喉喩嗅嘲埼堆塞填奈妖妬媛嫉宛尻岡" +++          "崖嵐巾弄弥彙怨恣惧慄憧憬戚戴拉拭拳拶挨挫" +++          "捉捗捻摯斑斬旦旺昧曖曽枕柵柿栃桁梗梨椅椎" +++          "楷毀氾汎汰沃沙淫湧溺潰煎熊爪爽牙狙玩瑠璃" +++          "璧瓦畏畿痕痩瘍眉睦瞭瞳稽窟箋箸籠綻緻罵羞" +++          "羨肘股脇脊腎腫腺膝膳臆臼舷艶芯苛茨萎葛蓋" +++          "蔑蔽藍藤虎虹蜂蜜袖裾訃詣詮誰諦諧謎貌貪貼" +++          "賂賭踪蹴辣遜遡那酎醒采釜錦錮鍋鍵鎌闇阜阪" +++          "隙韓頃須頓頬顎餅餌駒骸鬱鶴鹿麓麺"

@@ -0,0 +1,15 @@+module Data.Kanji.Level.SeventhQ where ++-- | The Kanji unique to Level-7, studied by the end of 4th grade in+-- Japanese elementary schools.+seventhQ :: [Char]+seventhQ = "不争付令以仲伝位低例便信倉候借停健側働億" +++           "兆児共兵典冷初別利刷副功加努労勇包卒協単" +++           "博印参史司各告周唱喜器囲固型堂塩士変夫失" +++           "好季孫完官害察巣差希席帯底府康建径徒得必" +++           "念愛成戦折挙改救敗散料旗昨景最望未末札材" +++           "束松果栄案梅械極標機欠歴残殺毒氏民求治法" +++           "泣浅浴清満漁灯無然焼照熱牧特産的省祝票種" +++           "積競笑管節粉紀約結給続置老胃脈腸臣航良芸" +++           "芽英菜街衣要覚観訓試説課議象貨貯費賞軍輪" +++           "辞辺連達選郡量録鏡関陸隊静順願類飛飯養験"

@@ -0,0 +1,15 @@+module Data.Kanji.Level.SixthQ where ++-- | The Kanji unique to Level-6, studied by the end of 5th grade in+-- Japanese elementary schools.+sixthQ :: [Char]+sixthQ = "久仏仮件任似余価保修俵個備像再刊判制券則" +++         "効務勢厚句可営因団圧在均基報境墓増夢妻婦" +++         "容寄富導居属布師常幹序弁張往復徳志応快性" +++         "恩情態慣承技招授採接提損支政故敵断旧易暴" +++         "条枝査格桜検構武比永河液混減測準演潔災燃" +++         "版犯状独率現留略益眼破確示祖禁移程税築精" +++         "素経統絶綿総編績織罪群義耕職肥能興舌舎術" +++         "衛製複規解設許証評講謝識護豊財貧責貸貿賀" +++         "資賛質輸述迷退逆造過適酸鉱銅銭防限険際雑" +++         "非預領額飼"

@@ -0,0 +1,9 @@+module Data.Kanji.Level.TenthQ where ++-- | The Kanji unique to Level-10, studied by the end of 1st grade in+-- Japanese elementary schools.+tenthQ :: [Char]+tenthQ = "一七三上下中九二五人休先入八六円出力十千" +++         "口右名四土夕大天女子字学小山川左年手文日" +++         "早月木本村林校森正気水火犬玉王生田男町白" +++         "百目石空立竹糸耳花草虫見貝赤足車金雨青音"

@@ -0,0 +1,20 @@+module Data.Kanji.Level.ThirdQ where ++-- | The Kanji unique to Level-3, studied by the end of middle school+-- in Japan.+thirdQ :: [Char]+thirdQ = "乏乙了企伏伐伴伸佳侍促倣倹偶催債克免冗冠" +++         "凍凝刑削励勘募匠匿卑卓卸厘又双吉吏哀哲啓" +++         "喚喫嘱坑埋塊塗墜墨墳墾壇奉契奪如妨姫娯婆" +++         "婿嫁嬢孔孤宴審寿封尿岐岳峡崩巧帆帝幻幽廉" +++         "廊弧彫徐忌怠怪恨悔悟悦惜愚慈慌慕慨慰憂憎" +++         "憩房抑択抽拘掃掌排掛控措掲揚換揺携搾摂撮" +++         "擁擦敢斗斤斥施既昇晶暫架某桑棄棋楼概欧欺" +++         "殊殴没泌浪湾湿滅滑滝滞漂漏潜潤濫瀬炉炊炎" +++         "焦牲犠猟獄甲畔畜疾痘癖硬碑礎祉稚穂穏穫窒" +++         "符篤簿籍粋粗粘糧紛紺絞綱緊締緩縛縫繕翻聴" +++         "肝胆胎胞脅膜膨芳苗菊華葬藩虐虚蛮衝衰袋裂" +++         "裸覆訂託詠該誘請諮諾謀譲豚貫賊賢赦赴超軌" +++         "軸辛辱逮遂遇遭遵邦邪郊郭酔酵鋳錠錬錯鍛鎮" +++         "鐘閲阻陪陳陵陶隆随隔隻雇零霊顧飽餓駐騎髄" +++         "魂魅魔鯨鶏"

@@ -1,13 +0,0 @@-module Data.Kanji.NinthQ where ---- | The Kanji unique to Level-9, studied by the end of 2nd grade in--- Japanese elementary schools.-ninthQ :: [Char]-ninthQ = "万丸交京今会体何作元兄光公内冬刀分切前北" ++-         "午半南原友古台合同回図国園地場声売夏外多" ++-         "夜太妹姉室家寺少岩工市帰広店弓引弟弱強当" ++-         "形後心思戸才教数新方明星春昼時晴曜書朝来" ++-         "東楽歌止歩母毎毛池汽活海点父牛理用画番直" ++-         "矢知社秋科答算米紙細組絵線羽考聞肉自船色" ++-         "茶行西親角言計記話語読谷買走近通週道遠里" ++-         "野長門間雪雲電頭顔風食首馬高魚鳥鳴麦黄黒"

@@ -1,21 +0,0 @@-module Data.Kanji.PreSecondQ where ---- | The Kanji unique to Level-Pre2, considerend "mid high school" level.-preSecondQ :: [Char]-preSecondQ = "且丙亜享亭仙伯但佐併侮侯俊俸倫偏偵偽傑傘" ++-             "僕僚儒償充准凸凹刃剖剛剰劾勅勲升厄叔叙吟" ++-             "呈呉唆唇唯喝喪嗣嚇囚坪垣培堀堕堪塀塁塑塚" ++-             "塾壌壮奔奨妃妄妊妥姻娠媒嫌嫡宜宰宵寛寡寧" ++-             "寮尉尚尼履屯岬崇崎帥幣庶庸廃廷弊弔弦彰循" ++-             "徹忍恭悠患悼惰愁愉慶憤憾懇懐懲懸戻扉扶抄" ++-             "把披抹拐拒拙括拷挑挟挿捜据搭摩撤撲擬斉斎" ++-             "旋昆暁曹朕朴杉析枠枢柳栓核栽桟棚棟棺槽款" ++-             "殉殻汁江沸泡泥泰洞津洪浄浦涯涼淑渇渉渋渓" ++-             "渦溝滋漆漠漬漸潟濯煩爵猫献猶猿珠琴璽瓶甚" ++-             "畝疎疫症痢痴癒盲眺睡督矯砕硝硫碁磨礁祥禅" ++-             "禍租秩稼窃窮窯竜筒粛粧糾紡索累紳緒縄繊繭" ++-             "缶罷羅翁耗肌肖肢肯臭舶艇艦茎荘菌薦薫藻虜" ++-             "虞蚊蛇蛍融衡衷裕褐褒襟覇訟診詐詔誓諭謁謄" ++-             "謙謹譜貞貢賄賓賜賠購践軟轄迅迭逐逓逝逸遍" ++-             "遮遷還邸酌酢酪酬酷醜醸釣鈴鉢銃銘閑閥附陥" ++-             "隅雰霜靴韻頑頒頻顕飢駄騰麻"

@@ -1,14 +0,0 @@-module Data.Kanji.SecondQ where ---- | The Kanji unique to Level-2, considered "standard adult" level.-secondQ :: [Char]-secondQ = "串丼乞亀伎侶俺傲僅冥冶凄刹剥勃勾匂叱呂呪" ++-          "咽哺唄唾喉喩嗅嘲埼堆塞填奈妖妬媛嫉宛尻岡" ++-          "崖嵐巾弄弥彙怨恣惧慄憧憬戚戴拉拭拳拶挨挫" ++-          "捉捗捻摯斑斬旦旺昧曖曽枕柵柿栃桁梗梨椅椎" ++-          "楷毀氾汎汰沃沙淫湧溺潰煎熊爪爽牙狙玩瑠璃" ++-          "璧瓦畏畿痕痩瘍眉睦瞭瞳稽窟箋箸籠綻緻罵羞" ++-          "羨肘股脇脊腎腫腺膝膳臆臼舷艶芯苛茨萎葛蓋" ++-          "蔑蔽藍藤虎虹蜂蜜袖裾訃詣詮誰諦諧謎貌貪貼" ++-          "賂賭踪蹴辣遜遡那酎醒采釜錦錮鍋鍵鎌闇阜阪" ++-          "隙韓頃須頓頬顎餅餌駒骸鬱鶴鹿麓麺"

@@ -1,15 +0,0 @@-module Data.Kanji.SeventhQ where ---- | The Kanji unique to Level-7, studied by the end of 4th grade in--- Japanese elementary schools.-seventhQ :: [Char]-seventhQ = "不争付令以仲伝位低例便信倉候借停健側働億" ++-           "兆児共兵典冷初別利刷副功加努労勇包卒協単" ++-           "博印参史司各告周唱喜器囲固型堂塩士変夫失" ++-           "好季孫完官害察巣差希席帯底府康建径徒得必" ++-           "念愛成戦折挙改救敗散料旗昨景最望未末札材" ++-           "束松果栄案梅械極標機欠歴残殺毒氏民求治法" ++-           "泣浅浴清満漁灯無然焼照熱牧特産的省祝票種" ++-           "積競笑管節粉紀約結給続置老胃脈腸臣航良芸" ++-           "芽英菜街衣要覚観訓試説課議象貨貯費賞軍輪" ++-           "辞辺連達選郡量録鏡関陸隊静順願類飛飯養験"

@@ -1,15 +0,0 @@-module Data.Kanji.SixthQ where ---- | The Kanji unique to Level-6, studied by the end of 5th grade in--- Japanese elementary schools.-sixthQ :: [Char]-sixthQ = "久仏仮件任似余価保修俵個備像再刊判制券則" ++-         "効務勢厚句可営因団圧在均基報境墓増夢妻婦" ++-         "容寄富導居属布師常幹序弁張往復徳志応快性" ++-         "恩情態慣承技招授採接提損支政故敵断旧易暴" ++-         "条枝査格桜検構武比永河液混減測準演潔災燃" ++-         "版犯状独率現留略益眼破確示祖禁移程税築精" ++-         "素経統絶綿総編績織罪群義耕職肥能興舌舎術" ++-         "衛製複規解設許証評講謝識護豊財貧責貸貿賀" ++-         "資賛質輸述迷退逆造過適酸鉱銅銭防限険際雑" ++-         "非預領額飼"

@@ -1,9 +0,0 @@-module Data.Kanji.TenthQ where ---- | The Kanji unique to Level-10, studied by the end of 1st grade in--- Japanese elementary schools.-tenthQ :: [Char]-tenthQ = "一七三上下中九二五人休先入八六円出力十千" ++-         "口右名四土夕大天女子字学小山川左年手文日" ++-         "早月木本村林校森正気水火犬玉王生田男町白" ++-         "百目石空立竹糸耳花草虫見貝赤足車金雨青音"

@@ -1,20 +0,0 @@-module Data.Kanji.ThirdQ where ---- | The Kanji unique to Level-3, studied by the end of middle school--- in Japan.-thirdQ :: [Char]-thirdQ = "乏乙了企伏伐伴伸佳侍促倣倹偶催債克免冗冠" ++-         "凍凝刑削励勘募匠匿卑卓卸厘又双吉吏哀哲啓" ++-         "喚喫嘱坑埋塊塗墜墨墳墾壇奉契奪如妨姫娯婆" ++-         "婿嫁嬢孔孤宴審寿封尿岐岳峡崩巧帆帝幻幽廉" ++-         "廊弧彫徐忌怠怪恨悔悟悦惜愚慈慌慕慨慰憂憎" ++-         "憩房抑択抽拘掃掌排掛控措掲揚換揺携搾摂撮" ++-         "擁擦敢斗斤斥施既昇晶暫架某桑棄棋楼概欧欺" ++-         "殊殴没泌浪湾湿滅滑滝滞漂漏潜潤濫瀬炉炊炎" ++-         "焦牲犠猟獄甲畔畜疾痘癖硬碑礎祉稚穂穏穫窒" ++-         "符篤簿籍粋粗粘糧紛紺絞綱緊締緩縛縫繕翻聴" ++-         "肝胆胎胞脅膜膨芳苗菊華葬藩虐虚蛮衝衰袋裂" ++-         "裸覆訂託詠該誘請諮諾謀譲豚貫賊賢赦赴超軌" ++-         "軸辛辱逮遂遇遭遵邦邪郊郭酔酵鋳錠錬錯鍛鎮" ++-         "鐘閲阻陪陳陵陶隆随隔隻雇零霊顧飽餓駐騎髄" ++-         "魂魅魔鯨鶏"

@@ -0,0 +1,125 @@+{-# LANGUAGE FlexibleInstances #-}++-- |+-- Module    : Data.Kanji.Types+-- Copyright : (c) Colin Woodbury, 2015, 2016+-- License   : GPL3+-- Maintainer: Colin Woodbury <colingw@gmail.com>+--+-- Types for this library.++module Data.Kanji.Types where++import qualified Data.ByteString.Char8 as SB+import qualified Data.ByteString.Lazy.Char8 as LB+import           Data.Char (ord)+import           Data.Maybe (fromJust)+import qualified Data.Set as S+import qualified Data.Text as ST+import qualified Data.Text.Lazy as LT+import           Lens.Micro++---++-- | Anything that can be transformed into a list of Kanji.+class AsKanji a where++  -- | Traverse into this type to find 0 or more Kanji.+  --+  -- Despite what the Haddock documentation says, this is part of the+  -- minimal complete definition.+  _Kanji :: Traversal' a Kanji++  -- | How long is this input source?+  len :: Num b => a -> b++  -- | Transform this string type into a list of Kanji. The source string+  -- and the resulting list might not have the same length, if there+  -- were `Char` in the source that did not fall within the legal+  -- UTF8 range for Kanji.+  asKanji :: a -> [Kanji]+  asKanji a = a ^.. _Kanji++instance AsKanji Char where+  _Kanji f c = if isKanji c then _kanji <$> f (Kanji c) else pure c++  len = const 1++instance AsKanji [Char] where+  _Kanji = traverse . _Kanji++  len = fromIntegral . length++instance AsKanji ST.Text where+  _Kanji = packed . _Kanji+    where packed f b = ST.pack <$> f (ST.unpack b)++  len = fromIntegral . ST.length++instance AsKanji LT.Text where+  _Kanji = packed . _Kanji+    where packed f b = LT.pack <$> f (LT.unpack b)++  len = fromIntegral . LT.length++instance AsKanji SB.ByteString where+  _Kanji = packed . _Kanji+    where packed f b = SB.pack <$> f (SB.unpack b)++  len = fromIntegral . SB.length++instance AsKanji LB.ByteString where+  _Kanji = packed . _Kanji+    where packed f b = LB.pack <$> f (LB.unpack b)++  len = fromIntegral . LB.length          ++-- | A single symbol of Kanji. Japanese Kanji were borrowed from China+-- over several waves during the past millenium. Japan names 2136 of+-- these as their standard set, with rarer characters being the domain+-- of academia and esoteric writers.+--+-- Japanese has several Japan-only Kanji, including:+--+-- * 畑 (a type of rice field)+-- * 峠 (a narrow mountain pass)+-- * 働 (to do physical labour)+newtype Kanji = Kanji { _kanji :: Char } deriving (Eq, Ord, Show)++-- | A Level or "Kyuu" (級) of Japanese Kanji ranking. There are 12 of these,+-- from 10 to 1, including intermediate levels between 3 and 2, and 2 and 1.+--+-- Japanese students will typically have Level-5 ability by the time they+-- finish elementary school. Level-5 accounts for 1006 characters.+--+-- By the end of middle school, they would have covered up to Level-3+-- (1607 Kanji) in their Japanese class curriculum.+--+-- While Level-2 (2136 Kanji) is considered "standard adult" ability,+-- many adults could not pass the Level-2, or even the Level-Pre2 (1940 Kanji)+-- exam without considerable study.+--+-- Level data for Kanji above Level-2 is currently not provided by+-- this library.+data Level = Level { _allKanji :: S.Set Kanji+                   , _rank :: Rank+                   } deriving (Eq, Show)++-- | A numeric representation of a `Level`.+data Rank = Ten | Nine | Eight | Seven | Six | Five | Four | Three | PreTwo+  | Two | PreOne | One deriving (Eq, Ord, Enum, Read, Show)++-- | Discover a Rank's numeric representation, as a `Float`.+fromRank :: Rank -> Float+fromRank = fromJust . flip lookup rankMap++-- | A mapping of Ranks to their numeric representation.+rankMap :: [(Rank,Float)]+rankMap = zip [Ten ..] [10,9,8,7,6,5,4,3,2.5,2,1.5,1]++-- | Legal Kanji appear between UTF8 characters 19968 and 40959.+isKanji :: Char -> Bool+isKanji c = lowLimit <= c' && c' <= highLimit+    where c' = ord c+          lowLimit  = 19968  -- This is `一`+          highLimit = 40959  -- I don't have the right fonts to display this.

@@ -0,0 +1,95 @@+NANQ+====+Author:  Colin Woodbury <colingw@gmail.com>++NanQ is a Japanese Kanji analysation program written in Haskell. Its main+function is to tell what Kanji belong to what Level of the Japanese National+Kanji Examination (漢字検定).++NanQ can be used to:+ - determine what Level individual Kanji belong to+ - determine the average Level (difficulty, in other words)+   of a group of Kanji+ - apply the above to whole files of Japanese++INSTALLING NANQ+---------------+First, get the source files from:++https://github.com/fosskers/nanq++NanQ is written in Haskell and uses the+[stack](http://docs.haskellstack.org/en/stable/README.html) tool. Once+`stack` is installed, move to the source directory and perform:++    stack build+    stack install++USAGE+-----+Assuming you've made it so that you can run the executable, the following+command-line options are available:++#### ANALYSIS OPTIONS+ Short  | Long   | Description+ -----  | ------ | -----------+ -a | --average  | Given Japanese input, finds the average Level of all Kanji present+ -u | --unknowns | Reports Kanji whose Level could not be determined+ -h | --help     | Prints a message explaining these options+ -l | --leveldist | Find the % distribution of Levels in given Japanese+ -s | --splits   | Show what Level each Kanji belongs to+ -d | --density  | Determines how much of the input is made up of Kanji+ -e | --elementary | Determines how much of the input is made up of Kanji learned in Japanese Elementary School++#### INPUT SOURCE OPTIONS+ Short  | Long   | Description+ -----  | ------ | -----------+ *none* | *none* | Analyse a String of Japanese given from the command line+ -f     | --file | Get input from a given file++#### NOTES ON CLOs+ * All options above can be mixed to include their analysis result+ in the output JSON.+ * `-h` will over-ride any other options or arguments, discarding them and+   printing a help message.++#### Examples+*Single Kanji*+```+$> nanq -s 日+{+  "levelSplit": {+    "Ten": "日"+  }+}+```++*A Japanese sentence*+```+$> nanq -s これは日本語+{+    "levelSplit": {+      "Nine": "語",+      "Ten": "本日"+    }+}+```++*All options*+```+$> nanq -leadus これは日本語+{+    "levelSplit": {+      "Nine": "語",+      "Ten": "本日"+    },+    "elementary": 1,+    "average": 9.666667,+    "density": 0.5,+    "unknowns": "",+    "distributions": {+      "Nine": 0.33333334,+      "Ten": 0.6666667+    }+}+```

@@ -2,7 +2,7 @@  category:            Natural Language Processing -version:             1.1.1+version:             2.0.0  synopsis:            Performs 漢字検定 (National Kanji Exam) level analysis on given Kanji. @@ -26,42 +26,51 @@  cabal-version:       >=1.8 +extra-source-files: README.md+                    CHANGELOG.md+ executable nanq     main-is:  	     nanq.hs        other-modules:	Data.Kanji,-                        Data.Kanji.TenthQ,-                        Data.Kanji.NinthQ,-                        Data.Kanji.EighthQ,-                        Data.Kanji.SeventhQ,-                        Data.Kanji.SixthQ,-                        Data.Kanji.FifthQ,-                        Data.Kanji.FourthQ,-                        Data.Kanji.ThirdQ,-                        Data.Kanji.PreSecondQ,-                        Data.Kanji.SecondQ+                        Data.Kanji.Level.TenthQ,+                        Data.Kanji.Level.NinthQ,+                        Data.Kanji.Level.EighthQ,+                        Data.Kanji.Level.SeventhQ,+                        Data.Kanji.Level.SixthQ,+                        Data.Kanji.Level.FifthQ,+                        Data.Kanji.Level.FourthQ,+                        Data.Kanji.Level.ThirdQ,+                        Data.Kanji.Level.PreSecondQ,+                        Data.Kanji.Level.SecondQ   -    build-depends:       base < 5+    build-depends:       aeson >= 0.9.0.1+                       , aeson-pretty >= 0.7.2+                       , base < 5                        , bytestring >= 0.10.6.0                        , containers >= 0.4.0.0+                       , extensible-effects >= 1.11.0.0                        , microlens >= 0.3.5.0-                       , text-  +                       , microlens-aeson >= 2.1.0+                       , optparse-applicative >= 0.12.0.0+                       , text >= 1.2.2.0+ library     build-depends: base < 5                  , bytestring >= 0.10.6.0                  , containers >= 0.4.0.0                  , microlens >= 0.3.5.0-                 , text+                 , text >= 1.2.2.0      exposed-modules: Data.Kanji,-                     Data.Kanji.TenthQ,-                     Data.Kanji.NinthQ,-                     Data.Kanji.EighthQ,-                     Data.Kanji.SeventhQ,-                     Data.Kanji.SixthQ,-                     Data.Kanji.FifthQ,-                     Data.Kanji.FourthQ,-                     Data.Kanji.ThirdQ,-                     Data.Kanji.PreSecondQ,-                     Data.Kanji.SecondQ+                     Data.Kanji.Types,+                     Data.Kanji.Level.TenthQ,+                     Data.Kanji.Level.NinthQ,+                     Data.Kanji.Level.EighthQ,+                     Data.Kanji.Level.SeventhQ,+                     Data.Kanji.Level.SixthQ,+                     Data.Kanji.Level.FifthQ,+                     Data.Kanji.Level.FourthQ,+                     Data.Kanji.Level.ThirdQ,+                     Data.Kanji.Level.PreSecondQ,+                     Data.Kanji.Level.SecondQ

@@ -1,168 +1,111 @@-import Data.Kanji-import Data.List (delete, nub)-import Data.Maybe (fromJust)-import System.Console.GetOpt-import System.Environment (getArgs)-import System.IO (hGetContents, stdin)-import Text.Printf (printf)+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-} +import           Control.Eff+import           Control.Eff.Reader.Lazy+import           Data.Aeson+import           Data.Aeson.Encode.Pretty+import           Data.Kanji+import qualified Data.Map.Lazy as M+import qualified Data.Set as S+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL+import           Data.Text.Lazy.Builder (toLazyText)+import qualified Data.Text.Lazy.IO as TIO+import           Lens.Micro+import           Lens.Micro.Aeson+import           Options.Applicative+ --- -data Language = Jap | Eng deriving (Show,Eq)+data Flags = Flags [Operation] (Either FilePath TL.Text) deriving (Eq) -data Flag = FileInput | PipeInput | Help      | Average    |-            Unknowns  | LevelDist | KDensity  | Elementary |-            Text      | JapOutput | AllFromQ Rank deriving (Show,Eq)+data Operation = Unknowns | Density | Elementary+  | Distribution | Average | Splits deriving (Eq) -options :: [OptDescr Flag]-options = [ Option ['f'] ["file"]       (NoArg FileInput)  fDesc-          , Option ['p'] ["pipe"]       (NoArg PipeInput)  pDesc-          , Option ['h'] ["help"]       (NoArg Help)       hDesc-          , Option ['a'] ["average"]    (NoArg Average)    aDesc-          , Option ['u'] ["unknowns"]   (NoArg Unknowns)   uDesc-          , Option ['d'] ["leveldist"]  (NoArg LevelDist)  lDesc-          , Option ['k'] ["density"]    (NoArg KDensity)   kDesc-          , Option ['e'] ["elementary"] (NoArg Elementary) eDesc-          , Option ['t'] ["text"]       (NoArg Text)       tDesc-          , Option ['j'] ["japanese"]   (NoArg JapOutput)  jDesc -          , Option ['q'] ["fromq"]-            (ReqArg (\s -> AllFromQ (read s :: Rank)) "Rank") qDesc-          ]-    where fDesc = "Takes input from a given file." ++-                  "\n入力は指定のファイルから"-          pDesc = "Takes input from a pipe (stdin)." ++-                  "\n入力はpipe (つまりstdin)から"-          hDesc = "Shows this help message." ++-                  "\nこのメッセージから出力"-          aDesc = "Find the average level of some given line of Japanese." ++-                  "\n日本語の文の平均的な級を求める"-          uDesc = "Report Kanji whose Level could not be determined." ++-                  "\n級を明確にできなかった漢字を報告"-          lDesc = "Find the % distribution of levels in given Japanese." ++-                  "\nどの級の漢字がどれ程出ているか、パーセントで出力"-          kDesc = "Determines how much of the input is made of Kanji." ++-                  "\n入力は何パーセント漢字でできているか出力"-          eDesc = "Determines how much of the input is made of Kanji" ++-                  "\nlearnt in Elementary School in Japan." ++-                  "\n入力は何パーセント小学校で習う漢字でできているか出力"-          tDesc = "Applies -k -e and -d all at once to analyse some text." ++-                  "\n-k、-e、-dを連続に使って入力を分析"-          jDesc = "Output is given in Japanese instead of English." ++-                  "\n出力の際は日本語"-          qDesc = "Filters out all but Kanji from the requested Level." ++-                  "\n指定された級の漢字だけ出力"          -          -usageMsg :: String-usageMsg = "Usage : nanq [OPTION] (kanji / file)"+data Env = Env { _allKs :: [Kanji]+               , _original :: TL.Text } deriving Eq -japQNames :: [(Rank,String)]-japQNames = zip rankNums ["10級","9級","8級","7級","6級","5級","4級",-                          "3級", "準2級","2級","準1級","1級"]+-- | Long, Short, Help+lsh l s h = long l <> short s <> help h -engQNames :: [(Rank,String)]-engQNames = zip rankNums ["Tenth Level","Ninth Level","Eighth Level",-                          "Seventh Level","Sixth Level","Fifth Level",-                          "Forth Level","Third Level", "Pre-Second Level",-                          "Second Level","Pre-First Level","First Level"]-                          -findAverageQ :: Language -> [Char] -> String-findAverageQ lang ks = -  printf (getMsg lang ++ "%.2f") . averageLevel levels . asKanji $ ks-      where getMsg Eng = "Average Level: "-            getMsg Jap = "平均の級："+flags :: Parser Flags+flags = Flags <$> operations <*> (file <|> japanese)+  where file = Left <$> strOption (lsh "file" 'f' "Take input from a file")+        japanese = (Right . TL.pack) <$> argument str (metavar "JAPANESE") -findQs :: Language -> [Char] -> [String]-findQs lang ks = map (nanQ lang) $ asKanji ks+operations :: Parser [Operation]+operations = (^.. each . _Just) <$> ops+  where ops = sequenceA $ map optional+          [ flag' Unknowns $+            lsh "unknowns" 'u' "Find Kanji whose Level couldn't be determined"+          , flag' Density $+            lsh "density" 'd' "Find how much of the input is made of Kanji"+          , flag' Elementary $+            lsh "elementary" 'e' "Find density of Kanji learnt in elementary school"+          , flag' Distribution $+            lsh "leveldist" 'l' "Find the distribution of Kanji levels"+          , flag' Average $+            lsh "average" 'a' "Find the average Level of all Kanji present"+          , flag' Splits $+            lsh "splits" 's' "Show which Level each Kanji belongs to" ] -nanQ :: Language -> Kanji -> String-nanQ lang k = maybe (bad lang) (good lang . _rank) $ level levels k-  where -    good Eng n = (show k) ++ " is " ++ (articledQName n) ++ " Kanji."-    good Jap n = "「" ++ (show k) ++ "」は" ++ (jQName n) ++ "の漢字"-    bad Eng    = (show k) ++ " is not in any level."-    bad Jap    = "「" ++ (show k) ++ "」はどの級の漢字でもない"-    articledQName n = getArticle (eQName n) ++ " " ++ eQName n-    getArticle name = if head name `elem` "AEIOU" then "an" else "a"-    eQName n = getQName n engQNames-    jQName n = getQName n japQNames-    getQName n names = fromJust $ n `lookup` names+-- | Shortcut for singleton objects+ob :: ToJSON v => TS.Text -> v -> Value+ob k v = object [ k .= v ] -findUnknowns :: Language -> String -> [String]-findUnknowns lang ks = case unknowns of-                         [] -> [bad lang]-                         _  -> good lang : map show unknowns-  where unknowns = nub . filter (not . hasLevel levels) . asKanji $ ks-        bad Eng  = "No Kanji of unknown Level found."-        bad Jap  = "級を明確にできない漢字は見つからなかった"-        good Eng = "The following Kanji of unknown Level were found:"-        good Jap = "級を明確にできなかった漢字は："+averageLev :: Member (Reader Env) r => Eff r Value+averageLev = ob "average" . averageLevel <$> reader _allKs -findDistribution :: Language -> String -> [String]-findDistribution lang ks =-  map (\(name,per) -> printf "%4s: %05.2f%%" name per) namePercentPairs-  where namePercentPairs     = map rawToPretty distributions-        distributions        = levelDist levels $ asKanji ks-        rawToPretty (qn,p)   = (getQName lang qn, p * 100)-        getQName Eng qn      = getName engQNames "Above Second Level" qn-        getQName Jap qn      = getName japQNames "2級以上" qn-        getName names msg qn = maybe msg id $ qn `lookup` names+splits :: Member (Reader Env) r => Eff r Value+splits = do+  ks <- map g . M.toList . S.foldl f M.empty . S.fromList <$> reader _allKs+  pure $ object [ "levelSplit" .= object ks ]+    where f a k = maybe a (\l -> M.insertWith (++) (_rank l) [k] a) $ level k+          g (r,ks) = TS.pack (show r) .= map _kanji ks -howMuchIsKanji :: Language -> String -> String-howMuchIsKanji lang ks = printf "%s: %.2f%%" (getMsg lang) percent-  where percent = 100 * kanjiDensity ks-        getMsg Eng = "Kanji Density"-        getMsg Jap = "漢字率"+unknowns :: Member (Reader Env) r => Eff r Value+unknowns = do+  ks <- S.filter (not . hasLevel) . S.fromList <$> reader _allKs+  pure $ object [ "unknowns" .= map _kanji (S.toList ks) ] -howMuchIsElementaryKanji :: Language -> String -> String-howMuchIsElementaryKanji lang ks = printf (getMsg lang) percent-  where percent    = 100 * elementaryKanjiDensity ks-        getMsg Eng = "Input Kanji is %.2f%% Elementary School Kanji."-        getMsg Jap = "入力した漢字は「%.2f%%」小学校で習う漢字。"+distribution :: Member (Reader Env) r => Eff r Value+distribution = ob "distributions" . object . map f . levelDist <$> reader _allKs+    where f (r,v) = TS.pack (show r) .= v -getAllFromLevel :: Rank -> [Char] -> [Kanji]-getAllFromLevel qn ks = maybe [] f $ levelFromRank levels qn-  where f q = nub . filter (isKanjiInLevel q) . asKanji $ ks+density :: Member (Reader Env) r => Eff r Value+density = do+  d <- kanjiDensity <$> reader _original <*> reader _allKs+  pure $ object [ "density" .= d ] -parseOpts :: [String] -> IO ([Flag],[String])-parseOpts args = case getOpt Permute options args of-                   (opts,nonopts,[]) -> return (opts,nonopts)-                   (_,_,_)           -> argError "Bad flag used."+elementaryDensity :: Member (Reader Env) r => Eff r Value+elementaryDensity = ob "elementary" . elementaryKanjiDensity <$> reader _allKs --- Determine input source and output language.-cleanOpts :: ([Flag],[String]) -> IO ([Flag],Language,String)-cleanOpts (opts,nonopts) = clean opts nonopts Eng  -- English by default.-    where clean opts nonopts lang -            | JapOutput `elem` opts = clean (without JapOutput) nonopts Jap-            | Help `elem` opts      = return ([Help],lang,"")-            | PipeInput `elem` opts = do input <- hGetContents stdin-                                         return (without PipeInput,lang,input)-            | null nonopts          = argError "No Kanji / file given!"-            | FileInput `elem` opts = do input <- readFile $ head nonopts-                                         return (without FileInput,lang,input)-            | otherwise             = return (opts,lang,head nonopts)-            where without x = delete x opts+-- | All operations return JSON, to be aggregated into a master Object.+execOp :: Member (Reader Env) r => Operation -> Eff r Value+execOp Unknowns = unknowns+execOp Density = density+execOp Elementary = elementaryDensity+execOp Distribution = distribution+execOp Average = averageLev+execOp Splits = splits -executeOpts :: ([Flag],Language,String) -> IO ()-executeOpts (flags,lang,input) =-  case flags of-    [Help]        -> putStr $ usageInfo usageMsg options-    [Average]     -> putStrLn $ findAverageQ lang input-    []            -> mapM_ putStrLn $ findQs lang input-    [Unknowns]    -> mapM_ putStrLn $ findUnknowns lang input-    [LevelDist]   -> mapM_ putStrLn $ findDistribution lang input-    [KDensity]    -> putStrLn $ howMuchIsKanji lang input-    [Elementary]  -> putStrLn $ howMuchIsElementaryKanji lang input-    [Text]        -> mapM_ execAll [KDensity,Elementary,LevelDist]-    [AllFromQ qn] -> mapM_ print $ getAllFromLevel qn input-    _             -> argError "Conflicting flags given."-    where execAll flag = executeOpts ([flag],lang,input) >> putStrLn ""+output :: Value -> IO ()+output = TIO.putStrLn . toLazyText . encodePrettyToTextBuilder -argError :: String -> a-argError msg = error $ usageInfo (msg ++ "\n" ++ usageMsg) options+-- | Dispatch on each `Operation` given. Aggregates the resulting JSON.+work :: (Env, [Operation]) -> Value+work (e,os) = Object $ vals ^. each . _Object+  where vals = run $ runReader (mapM execOp os) e +env :: Flags -> IO (Env, [Operation])+env (Flags os (Right t)) = pure (Env (asKanji t) t, os)+env (Flags os (Left f)) = do+  t <- TIO.readFile f+  pure (Env (asKanji t) t, os)+ main :: IO ()-main = do-  args <- getArgs-  opts <- parseOpts args-  cleanedOpts <- cleanOpts opts-  executeOpts cleanedOpts+main = execParser opts >>= env >>= output . work+  where opts = info (helper <*> flags)+          (fullDesc <> header "nanq - Kanji analysis of Japanese text")