feature(lib): Add a loadTrigraph function

app/gen-trigraph.hs

@@ -1,6 +1,6 @@
 module Main (main) where
 
-import Data.Gibberish.GenTrigraph (genTrigraph)
+import Data.Gibberish.Trigraph (genTrigraph)
 
 import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.ByteString.Lazy (ByteString ())

gibberish.cabal

@@ -98,13 +98,17 @@ library
     Data.Elocrypt.Trigraph,
     Data.Elocrypt.Utils,
     Data.Gibberish.Format,
-    Data.Gibberish.GenTrigraph,
     Data.Gibberish.MonadPass,
+    Data.Gibberish.Trigraph,
     Data.Gibberish.Types
+  other-modules:
+    Paths_gibberish
   build-depends:
     MonadRandom,
     aeson,
     deepseq,
+    directory,
+    filepath,
     random
   hs-source-dirs:  src
 
@@ -155,8 +159,9 @@ test-suite spec
     hspec-discover:hspec-discover
   other-modules:
     Data.Gibberish.FormatSpec
-    Data.Gibberish.GenTrigraphSpec
+    Data.Gibberish.TrigraphSpec
     Data.Gibberish.TypesSpec
+    Paths_gibberish
   other-extensions:
     OverloadedLists
 

src/Data/Gibberish/Trigraph.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE OverloadedLists #-}
+
+module Data.Gibberish.Trigraph
+  ( Language (..),
+    TrigraphConfig (..),
+    genTrigraph,
+    loadTrigraph,
+  ) where
+
+import Paths_gibberish (getDataFileName)
+
+import Control.Exception (throwIO)
+import Control.Monad (unless)
+import Data.Aeson qualified as Aeson
+import Data.Gibberish.Types
+import Data.Map.Strict (Map ())
+import Data.Map.Strict qualified as Map
+import Data.Maybe (fromJust)
+import Data.Text (Text ())
+import Data.Text qualified as Text
+import System.Directory (doesFileExist)
+import System.FilePath ((</>))
+
+data Language
+  = English
+  | CustomTrigraph TrigraphConfig
+  deriving stock (Eq, Show)
+
+newtype TrigraphConfig = TrigraphConfig
+  {unTrigraphConfig :: FilePath}
+  deriving stock (Eq, Show)
+
+-- | Generate trigraphs from a list of words
+genTrigraph :: [Text] -> Trigraph
+genTrigraph = Trigraph . foldr foldWord Map.empty
+  where
+    foldWord = Map.unionWith combine . mkTrigraph
+    combine (Frequencies f1) (Frequencies f2) = Frequencies $ Map.unionWith (+) f1 f2
+
+-- | Generate a trigraph from a single word
+mkTrigraph :: Text -> Map Digram Frequencies
+mkTrigraph word = foldr insert' Map.empty $ scanTrigrams word
+  where
+    insert' (Trigram a b c) =
+      Map.insertWith combineFrequencies (Digram a b) (mkFrequencies c)
+    combineFrequencies (Frequencies m1) (Frequencies m2) =
+      Frequencies (Map.unionWith (+) m1 m2)
+    mkFrequencies c = Frequencies $ Map.singleton (Unigram c) 1
+
+scanTrigrams :: Text -> [Trigram]
+scanTrigrams word = case Text.take 3 word of
+  [a, b, c] -> Trigram a b c : scanTrigrams (Text.tail word)
+  _ -> []
+
+loadTrigraph :: Language -> IO Trigraph
+loadTrigraph English = loadBuiltinTrigraph "wamerican.json"
+loadTrigraph (CustomTrigraph cfg) = loadTrigraphFromFile (unTrigraphConfig cfg)
+
+loadBuiltinTrigraph :: FilePath -> IO Trigraph
+loadBuiltinTrigraph file' = loadTrigraphFromFile =<< getBuiltinFilePath file'
+  where
+    getBuiltinFilePath basename = getDataFileName ("data" </> "trigraphs" </> basename)
+
+loadTrigraphFromFile :: FilePath -> IO Trigraph
+loadTrigraphFromFile file' = do
+  exists <- doesFileExist file'
+  unless exists $
+    throwIO (TrigraphNotFound file')
+
+  fromJust <$> Aeson.decodeFileStrict file'

src/Data/Gibberish/Types.hs

@@ -2,6 +2,7 @@
 
 module Data.Gibberish.Types
   ( GenPassOptions (..),
+    Error (..),
     Unigram (..),
     Digram (..),
     Trigram (..),
@@ -12,11 +13,13 @@ module Data.Gibberish.Types
   ) where
 
 import Control.DeepSeq (NFData)
+import Control.Exception (Exception ())
 import Data.Aeson (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))
 import Data.Aeson qualified as Aeson
 import Data.Aeson.Types (FromJSONKeyFunction (..), Parser (), toJSONKeyText)
 import Data.Map (Map ())
 import Data.Text (Text ())
+import Data.Typeable (Typeable ())
 import GHC.Generics (Generic ())
 import TextShow (TextShow (..), fromString)
 import Prelude hiding (Word ())
@@ -34,6 +37,12 @@ data GenPassOptions = GenPassOptions
   }
   deriving stock (Eq, Show)
 
+-- | Exceptions that can occur at runtime
+data Error
+  = TrigraphNotFound FilePath
+  | ImpossibleError
+  deriving stock (Eq, Typeable)
+
 -- | A unigram is a single letter
 newtype Unigram = Unigram {unUnigram :: Char}
   deriving stock (Eq, Ord, Show)
@@ -70,6 +79,12 @@ newtype Trigraph = Trigraph {unTrigraph :: Map Digram Frequencies}
 newtype Word = Word {unWord :: Text}
   deriving stock (Eq, Show)
 
+instance Exception Error
+
+instance Show Error where
+  show (TrigraphNotFound path) = "Trigraph file " <> show path <> " does not exist!"
+  show ImpossibleError = "The impossible happened! Please file a bug report."
+
 instance TextShow Digram where
   showb (Digram c1 c2) = fromString [c1, c2]
 

test/Data/Gibberish/GenTrigraphSpec.hs → test/Data/Gibberish/TrigraphSpec.hs

@@ -1,18 +1,21 @@
 {-# LANGUAGE OverloadedLists #-}
 
-module Data.Gibberish.GenTrigraphSpec (spec) where
+module Data.Gibberish.TrigraphSpec (spec) where
 
-import Data.Gibberish.GenTrigraph
+import Data.Gibberish.Trigraph
 import Data.Gibberish.Types
+import Paths_gibberish (getDataFileName)
 import Test.Gibberish.Gen qualified as Gen
 
+import Control.Monad (void)
 import Data.List qualified as List
 import Data.Map qualified as Map
 import Data.Text (Text ())
 import Data.Text qualified as Text
 import Hedgehog
 import Hedgehog.Gen qualified as Gen hiding (word)
 import Hedgehog.Range qualified as Range
+import System.FilePath ((</>))
 import Test.Hspec
 import Test.Hspec.Hedgehog
 
@@ -55,6 +58,20 @@ spec = do
 
       concatNub trigrams' === List.sort (allTrigrams trigraphs)
 
+  describe "loadTrigraph" $ do
+    it "loads english" $
+      void $
+        loadTrigraph English
+
+    it "loads custom" $ do
+      tri <- getDataFileName ("data" </> "trigraphs" </> "wamerican.json")
+      void $
+        loadTrigraph (CustomTrigraph $ TrigraphConfig tri)
+
+    it "handles load failure" $ do
+      loadTrigraph (CustomTrigraph $ TrigraphConfig "doesnotexist.json")
+        `shouldThrow` (== TrigraphNotFound "doesnotexist.json")
+
 trigrams :: Text -> [Trigram]
 trigrams ts = case Text.take 3 ts of
   [a, b, c] -> Trigram a b c : trigrams (Text.tail ts)

test/Golden.hs

@@ -1,6 +1,6 @@
 module Main (main) where
 
-import Data.Gibberish.GenTrigraph (genTrigraph)
+import Data.Gibberish.Trigraph (genTrigraph)
 
 import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.ByteString.Lazy (ByteString ())