{-# LANGUAGE OverloadedStrings #-}
module Playground where

import Language.Lojban.Core
import Language.Lojban.Dictionaries (englishDictionary)
import Language.Lojban.Canonicalization (basicSentenceCanonicalizer)
import Language.Eberban.Parser.Mercury.Samples as EberbanParserSamples
import Control.Applicative ((<$>))
import Control.Monad (sequence_)
import Data.Maybe (mapMaybe)
import Data.List.Ordered (nubSort)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.Map as M
import qualified Data.Aeson as A
import System.Random (StdGen, mkStdGen)

-- See also: https://mw.lojban.org/papri/N-grams_of_Lojban_corpus

allGismu :: IO [Gismu]
allGismu :: IO [Gismu]
allGismu = [Gismu] -> IO [Gismu]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gismu] -> IO [Gismu]) -> [Gismu] -> IO [Gismu]
forall a b. (a -> b) -> a -> b
$ ((Text, Gismu) -> Gismu) -> [(Text, Gismu)] -> [Gismu]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Gismu) -> Gismu
forall a b. (a, b) -> b
snd ([(Text, Gismu)] -> [Gismu])
-> (Dictionary -> [(Text, Gismu)]) -> Dictionary -> [Gismu]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Gismu -> [(Text, Gismu)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Gismu -> [(Text, Gismu)])
-> (Dictionary -> Map Text Gismu) -> Dictionary -> [(Text, Gismu)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dictionary -> Map Text Gismu
dictGismu (Dictionary -> [Gismu]) -> Dictionary -> [Gismu]
forall a b. (a -> b) -> a -> b
$ Dictionary
englishDictionary

popularGismu :: IO [Gismu]
popularGismu :: IO [Gismu]
popularGismu = (Gismu -> Bool) -> [Gismu] -> [Gismu]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
200) (Int -> Bool) -> (Gismu -> Int) -> Gismu -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gismu -> Int
gismuIRCFrequencyCount) ([Gismu] -> [Gismu]) -> IO [Gismu] -> IO [Gismu]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Gismu]
allGismu

popularGismuWords :: IO [T.Text]
popularGismuWords :: IO [Text]
popularGismuWords = (Gismu -> Text) -> [Gismu] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Gismu -> Text
gismuText ([Gismu] -> [Text]) -> IO [Gismu] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Gismu]
popularGismu

loadGismuFromText :: Dictionary -> T.Text -> [Gismu]
loadGismuFromText :: Dictionary -> Text -> [Gismu]
loadGismuFromText Dictionary
dict Text
t = (Text -> Maybe Gismu) -> [Text] -> [Gismu]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Gismu
lookup [Text]
words where
    gismu :: Map Text Gismu
gismu = Dictionary -> Map Text Gismu
dictGismu Dictionary
dict
    lookup :: Text -> Maybe Gismu
lookup Text
word = Text -> Map Text Gismu -> Maybe Gismu
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
word Map Text Gismu
gismu
    words :: [Text]
words = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSort ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
" " (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\n" Text
" " (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
t

loadGismuFromFile :: FilePath -> IO [Gismu]
loadGismuFromFile :: FilePath -> IO [Gismu]
loadGismuFromFile FilePath
filePath = do
    Dictionary -> Text -> [Gismu]
loadGismuFromText Dictionary
englishDictionary (Text -> [Gismu]) -> IO Text -> IO [Gismu]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
TIO.readFile FilePath
filePath

terry :: IO [Gismu]
terry :: IO [Gismu]
terry = FilePath -> IO [Gismu]
loadGismuFromFile FilePath
"/home/john/Temp/lojban/texts/terry.txt"

terryWords :: IO [T.Text]
terryWords :: IO [Text]
terryWords = (Gismu -> Text) -> [Gismu] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Gismu -> Text
gismuText ([Gismu] -> [Text]) -> IO [Gismu] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Gismu]
terry

canonicalizeString :: String -> Either String T.Text
canonicalizeString :: FilePath -> Either FilePath Text
canonicalizeString =  SentenceCanonicalizer
basicSentenceCanonicalizer SentenceCanonicalizer
-> (FilePath -> Text) -> FilePath -> Either FilePath Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack

samplesFromGenerator :: (StdGen -> (a, StdGen)) -> [a]
samplesFromGenerator :: forall a. (StdGen -> (a, StdGen)) -> [a]
samplesFromGenerator StdGen -> (a, StdGen)
gen = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
applyGenerator [Int
1..Int
10000] where
    applyGenerator :: Int -> a
applyGenerator Int
x = (a, StdGen) -> a
forall a b. (a, b) -> a
fst ((a, StdGen) -> a) -> (a, StdGen) -> a
forall a b. (a -> b) -> a -> b
$ StdGen -> (a, StdGen)
gen (Int -> StdGen
mkStdGen Int
x)

showSamplesFromGenerator :: (Show a) => (StdGen -> (a, StdGen)) -> String
showSamplesFromGenerator :: forall a. Show a => (StdGen -> (a, StdGen)) -> FilePath
showSamplesFromGenerator = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> ((StdGen -> (a, StdGen)) -> [FilePath])
-> (StdGen -> (a, StdGen))
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubSort ([FilePath] -> [FilePath])
-> ((StdGen -> (a, StdGen)) -> [FilePath])
-> (StdGen -> (a, StdGen))
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> FilePath) -> [a] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map a -> FilePath
forall a. Show a => a -> FilePath
show) ([a] -> [FilePath])
-> ((StdGen -> (a, StdGen)) -> [a])
-> (StdGen -> (a, StdGen))
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StdGen -> (a, StdGen)) -> [a]
forall a. (StdGen -> (a, StdGen)) -> [a]
samplesFromGenerator

displaySamplesFromGenerator :: (Show a) => (StdGen -> (a, StdGen)) -> IO ()
displaySamplesFromGenerator :: forall a. Show a => (StdGen -> (a, StdGen)) -> IO ()
displaySamplesFromGenerator = FilePath -> IO ()
putStrLn (FilePath -> IO ())
-> ((StdGen -> (a, StdGen)) -> FilePath)
-> (StdGen -> (a, StdGen))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StdGen -> (a, StdGen)) -> FilePath
forall a. Show a => (StdGen -> (a, StdGen)) -> FilePath
showSamplesFromGenerator

saveDictionaries :: IO ()
saveDictionaries :: IO ()
saveDictionaries = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [FilePath -> Dictionary -> IO ()
saveDictionary FilePath
"static/scripts/dictionaries/english.js" Dictionary
englishDictionary]

saveDictionary :: FilePath -> Dictionary -> IO ()
saveDictionary :: FilePath -> Dictionary -> IO ()
saveDictionary FilePath
filePath Dictionary
dictionary = do
    let contents :: Text
contents = Text
"let dictionary=" Text -> Text -> Text
`T.append` Text -> Text
TL.toStrict (ByteString -> Text
TLE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Dictionary -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Dictionary
dictionary)
    FilePath -> Text -> IO ()
TIO.writeFile FilePath
filePath Text
contents

displayEberbanParseSamples :: IO ()
displayEberbanParseSamples :: IO ()
displayEberbanParseSamples = IO ()
EberbanParserSamples.displaySamples